Google TOTP Authenticator in REXX

google_totp.rexx

     /*               Rexx                     */
    /* z/OS Google Authenticator TOTP POC     */
   /* Argument: base32 secret key            */
  /*  Output: TOTP Token                    */
 /* Q License                              */
/* Author Phil 'Soldier of FORTRAN' Young */

NUMERIC DIGITS 10
parse ARG secretkey

address syscall 'time'
interval_no = floor(retval/30)
out_hmac = get_HMAC(secretkey, interval_no)
token = Get_HOTP_Token(out_hmac)
say 'Google Authenticator:' token

exit


Get_HOTP_Token: procedure
    /******************************/
   /* Arguments:                 */
  /* HMAC: Output from Get_HMAC */
 /* Returns TOTP Token         */
/******************************/
parse arg inHMAC
x = right(inHMAC,1)
o = bitand(x, 'f'x)
y = SUBSTR(inHMAC,c2d(o)+1,4)
z = bitand(y, '7fffffff'x)
m = c2d(z) // 1000000
return right(m,6, '0')

Get_HMAC: procedure
     /****************************************/
    /* Arguments:                           */
   /*   Secret:   Base32 encoded secret    */
  /*    Intervol: Intervol number         */
 /* Returns HMAC string                  */
/****************************************/
parse arg b32_Secret, intervol_no
Secret           = b32decode(b32_Secret)
SecretLength     = int(length(Secret))
SecretBitLength  = int(length(Secret) * 8)

  /***********************/
 /* Generate empty key  */
/***********************/

RetCode        = 'FFFFFFFF'x
Reason         = 'FFFFFFFF'x
ExitLength     = int(0)
ExitData       = ''
RuleArrayCount = int(4)
RuleArray      = 'Internal' ||,
                 'HMAC    ' ||,
                 'MAC     ' ||,
                 'GENERATE'
KeyBitLength   = int(0)
KeyValue       = ''
KeyNameLength  = int(0)
KeyName        = ''
UADLength      = int(0)
UADData        = ''
TokenLength    = int(0)
TokenData      = ''
ServiceLength  = int(0)
ServiceData    = ''
TargetKeyLength= int(725) /* Max */
TargetKey      = copies('00'x, 725)
address linkpgm 'CSNBKTB2'                     ,
                'RetCode'         'Reason'     ,
                'ExitLength'      'ExitData'   ,
                'RuleArrayCount'  'RuleArray'  ,
                'KeyBitLength'    'KeyValue'   ,
                'KeyNameLength'   'KeyName'    ,
                'UADLength'       'UADData'    ,
                'TokenLength'     'TokenData'  ,
                'ServiceLength'   'ServiceData',
                'TargetKeyLength' 'TargetKey'

call Check_RC

  /**************************/
 /* Fill in Key with Parts */
/**************************/

  /**********/
 /* Part 1 */
/**********/
RetCode        = 'FFFFFFFF'x
Reason         = 'FFFFFFFF'x
ExitLength     = int(0)
ExitData       = ''
RuleArrayCount       = int(3)
RuleArray       = 'HMAC    ' ||,
                  'FIRST   ' ||,
                  'MIN1PART'
KeyPartBitLength = SecretBitLength
KeyPart          = Secret
KeyIDLength     = '000002D5'x ;   /* max = 725     */
KeyID           = TargetKey;     /* From CSNBKTB2 */

address linkpgm 'CSNBKPI2'                     ,
                'RetCode'          'Reason'    ,
                'ExitLength'       'ExitData'  ,
                'RuleArrayCount'   'RuleArray' ,
                'KeyPartBitLength' 'KeyPart'   ,
                'KeyIDLength'      'KeyID'

call Check_RC

  /**********/
 /* Part 2 */
/**********/
RetCode        = 'FFFFFFFF'x
Reason         = 'FFFFFFFF'x
ExitLength     = int(0)
ExitData       = ''
RuleArrayCount = int(2)
RuleArray      = 'HMAC    ' ||,
                 'COMPLETE';
KeyPartBitLength = int(0)
KeyPart          = '';

address linkpgm 'CSNBKPI2'                     ,
                'RetCode'          'Reason'    ,
                'ExitLength'       'ExitData'  ,
                'RuleArrayCount'   'RuleArray' ,
                'KeyPartBitLength' 'KeyPart'   ,
                'KeyIDLength'      'KeyID'


call Check_RC

  /*****************/
 /* Generate HMAC */
/*****************/

text = "Hello World"
text_len = '0000000B'x;

text = long(intervol_no)
text_len = int(length(text))

RetCode           = 'FFFFFFFF'x
Reason            = 'FFFFFFFF'x

ExitLength        = int(0)
ExitData          = ''

RuleArrayCount = int(2)
RuleArray      = 'HMAC    ' ||,
                 'SHA-1   '

/* This part is so extra but needed so you can understand */
/* that the keyid is reused                               */
KeyIDLength = KeyIDLength
KeyID       = KeyID

MessageLength  = text_len;
Message        = text;

ChainVectorLength = int(128)
ChainVector       = copies('00'x,128)

HMACLength  = int(20)     /* 20 bytes for SHA-1 */
HMAC        = copies('00'x,c2d(HMACLength));


address linkpgm 'CSNBHMG'                         ,
                'RetCode'           'Reason'      ,
                'ExitLength'        'ExitData'    ,
                'RuleArrayCount'    'RuleArray'   ,
                'KeyIDLength'       'KeyID'       ,
                'MessageLength'     'Message'     ,
                'ChainVectorLength' 'ChainVector' ,
                'HMACLength'        'HMAC'

call Check_RC

return HMAC

Check_RC:
    /****************************/
   /* Arguments: Return Code   */
  /* Displays error and exits */
 /* If return code > 0       */
/****************************/
if (RetCode /= int(0)) Then
  do;
    say 'CSNBKTB2 Failed'
    say 'Return Code rc='c2x(RetCode)
    say 'Reason      RSN='c2x(Reason)
    Exit
  end;
Return;

int:
   /******************************/
  /* Returns 8 byte long string */
 /* left padded with zeros     */
/******************************/
return x2c(right(d2x(arg(1)),8,0))

long:
   /*******************************/
  /* Returns 16 byte long string */
 /* left padded with zeros      */
/*******************************/
return x2c(right(d2x(arg(1)),16,0))

b32decode: procedure
    /******************************/
   /* Arguments:                 */
  /* b32: base32 encoded string */
 /* Returns decoded string     */
/******************************/
    parse arg b32
    trace off
    chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567'
    b32d = ''
    do i=1 to length(b32);
        c = SUBSTR(b32,i,1)
        p = pos(c, chars)-1
        binary = x2b(d2x(p))
        b32d = b32d || right(binary,5,0)
    end
return x2c(b2x(b32d))
floor: procedure
  parse arg x
  y = x % 1
  return y - (x < 0) * (x \= y)
exit