HMACSHA1 function using the ABL SHA1-DIGEST

Cecil

19+ years progress programming and still learning.
Hi all.

Does anybody knows how to write a HMACSHA1 function using the SHA1-DIGEST function in the ABL???

I am using OE 10.1A and I want to write a HMACSHA1 function using the SHA1-DIGEST Function. I have seen a C++ function but I can't read C++. :(

Currently I am shelling out to Linux and calling a HMAC command. This work's well but I want to make the code portable accross OS Platforms without dependances.

Here is the C++ code maybe somebody is willing to help me out.

#include <hmac.h>

#include <fstream>

#include <string>

using name space std;

typedef basic_string<unsigned char> Ustring;

int main(int argc, unsigned char*argv[]){

char WBXMLchar;

Ustring WBXMLS;

ifstream inputWBXML;

//Put the PIN in a string

Ustring keyS(argv[2]);

//Open the file pointed out by "filename"

//and reads it into WBXMLS

string WBXMLfile(reinterpret_cast <char*> (argv[1]));

input WBXML.open(WBXMLfile.data(), ios::binary);

while (inputWBXML.get(WBXMLchar)){

WBXMLS +=(unsignedchar)WBXMLchar;

}

//Initialize and calculate the HMAC bytes

HMAC_CTX* hmac_ctx = new HMAC_CTX;

unsigned char md[20];

unsignedint*md_len=newunsignedint;

HMAC_Init(hmac_ctx,argv[2], keyS.length(), EVP_sha1());

unsigned char*hmac = HMAC(EVP_sha1(), argv[2],

keyS.length(), const_cast <unsignedchar*>(WBXMLS.data()),

WBXMLS.length(), md, md_len);


//hmac is the HMAC bytes to use

//Translate from binary to an ASCII string and print

intn=0;

charbuffer[41];

for(intk=0;k<20;k++){

n+=sprintf(buffer+n,"%02x",hmac[k]);

}

buffer[n+1]=0x00;

printf(buffer);

return0;

}
 

Cecil

19+ years progress programming and still learning.
Ok I have got some more information that might help.

HMAC is a hash based MAC algorithm defined in RFC 2104. It can use any hash function (such as MD5, SHA1 etc) which we will call H. HMAC also requires a user supplied secret key, which is a string of bytes of any length.

The hash algorithm H has two important properties which feed into the algorithm. The first is the hash size, L. For example MD5 has a hash size of 128 bits (16 bytes). The second quantity is slightly less obvious - it is the block size B of the iterated hash. In general B is greater than L.

Normalising the Key Length

The first stage of the algorithm is to convert the key to be exactly B bytes long. If the key length is less than B bytes, this is done by adding zero bytes to the end of the key, to form K of exactly B bytes.

However, if the key has more than B bytes to start with, first hash it using H. Then pad the hash value with zeros to make K (again, exactly B bytes).

Creating the Inner and Outer Keys

Now create 2 variants of K, by a simple XOR procedure:

The inner key, Ki is formed from K by XORing each byte with 0x36.

The outer key, Ko is formed from K by XORing each byte with 0x5C.

Calculating the MAC

We use the notation H(x) to represent the hash of byte sequence x. We use H(x, y) to represent the hash of the concatenation of byte sequence x followed by y. Then the MAC of message m is:

H(Ko, H(Ki, m))

In other words concatenate the inner key with the message, and calculate the hash. Then concatenate the outer key with the hash value and calculate the hash of that.

This method creates a MAC of length L (the hash size of H). It is possible to create a shorter MAC, if required, by truncating the MAC to t bits. To do this simply use the leftmost t bits and discard the remainder. The HMAC specification recommends that t should not be less than half of L, and in any case should never be less than 80, otherwise the MAC might not be secure.

Choosing a Key

The initial key can be any byte sequence of any length. Ideally it should be a random sequence, generated by a cryptographically strong random number generator. For the sake of security, it should not be less than L bytes. However, there is probably not a great deal to be gained by making the key larger than L, and certainly there is no point making it larger than B because then it will simply be hashed back down to L bytes.

If you are using password or passphrase, the situation is different because an L character password is much less random. There is an advantage in using larger passwords, even phrases which are larger than B (even though this will be hashed down to L bytes, a longer the pass phrase will create more randomness in the final L bytes). Of course in practical terms a password of 32 characters or more can start to become cumbersome.

Explanation of the Algorithm

As discussed in the general description of [MAC’s|macalg], a hash based MAC can be formed by adding a key at the start of a message before calculating the hash. It is necessary to also protect the end of the message with a key, to avoid an attacker being able to add blocks to the end of a message and recalculate the hash incrementally. HMAC does both these things, and its form is believed to be secure.

Of course, one factor which requires explanantion is - where does B fit into this? Why do we go to the trouble of forcing the key length to match B, which is after all just an internal parameter of the chosen hash algorithm?

Essentially it allows for a clever optimisation. Most hash algorithms contain a compression function with a block size of B bytes. The compression function starts off with an initial value IV. Every time it has processed B bytes, it returns to its initial state, but with a new value in the compression function.

Since Ki is exactly B bytes long, we can precalculate what the compression function will contain after processing it, and create a variant of H which is initialised to this state. That is, Hi (x) is equivalent to H(Ki, x). If we do the same for the outer hash we get a new MAC calculation:

Ho(Hi(m))

Remember that the variant hashes are identical to H, just with a different IV. So we have completely eliminated the cost of hashing the 2 keys, simply by a small modification to the hash algorithm. If you need to MAC a lot of small messages with the same key, this is a significant efficiency.

Of course this optimisation is entirely optional, and in most applications you will simply use the unmodified hash to calculate the MAC normally.
 

Cecil

19+ years progress programming and still learning.
I see there has been lots of interest in this Thread, but nobody has come up with a solution. After many days of head banging I have finally written my own ABL code to generate a HMAC using both SHA1 and MD5. :D

I have been validating my results from a 3rd party tool called HASHCALC from slavasoft.

So here it is. Please feel free to code review it and find bugs with it. I can't be bothered to do all the colour coding.

Code:
[COLOR=SeaGreen]/* Simple HMAC function [/COLOR][COLOR=SeaGreen]Overview                                                */
/* Developer: James Bowell                                                      */
/* Date:      09/06/2006                                                        */
/* Procedure: hmac-function.p                                                   */
/* References: http://www.ietf.org/rfc/rfc2104.txt                              */
/*             http://the.jhu.edu/upe/member_sites/zarfoss/HMAC-big.jpg         */
/*             http://en.wikipedia.org/wiki/HMAC                                */
/*             http://www.cryptostuff.com/crypto/index.php?title=hmac           */
/* HMAC is a hash based MAC algorithm defined in RFC 2104. It can use any       */
/* hash function (such as MD5, SHA1 etc). HMAC also requires a user             */
/* supplied secret key, which is a string of bytes of any length upto 64 bytes. */


[/COLOR]
[COLOR=RoyalBlue] FUNCTION [/COLOR]BinaryXOR [COLOR=RoyalBlue]RETURNS INTEGER[/COLOR]
  ([COLOR=RoyalBlue]INPUT[/COLOR] intOperand1 [COLOR=RoyalBlue]AS INTEGER[/COLOR],
   [COLOR=RoyalBlue]INPUT[/COLOR] intOperand2 [COLOR=RoyalBlue]AS INTEGER[/COLOR]):

    [COLOR=RoyalBlue]DEFINE VARIABLE[/COLOR] iByteLoop  [COLOR=Blue]AS INTEGER NO-UNDO.[/COLOR]
    [COLOR=Blue]DEFINE VARIABLE[/COLOR] iXOResult  [COLOR=Blue]AS INTEGER NO-UNDO.[/COLOR]
    [COLOR=Blue]DEFINE VARIABLE[/COLOR] lFirstBit  [COLOR=Blue]AS LOGICAL NO-UNDO.[/COLOR]
    [COLOR=Blue]DEFINE VARIABLE[/COLOR] lSecondBit [COLOR=Blue]AS LOGICAL NO-UNDO.[/COLOR]

    iXOResult = [COLOR=Red]0[/COLOR].

    [COLOR=SeaGreen]/*spin through each byte of each char*/[/COLOR]
    [COLOR=Blue]DO[/COLOR] iByteLoop = [COLOR=Red]0[/COLOR] [COLOR=Blue]TO[/COLOR] [COLOR=Red]7[/COLOR]: [COLOR=SeaGreen]/* as processing a single byte character */[/COLOR]

        [COLOR=SeaGreen]/*find state (true / false) of each integer's byte*/[/COLOR]
        [COLOR=Blue]ASSIGN[/COLOR]
            lFirstBit  [COLOR=Black]=[/COLOR] _cbit([COLOR=Blue]CHR[/COLOR](intOperand1), iByteLoop)
            lSecondBit [COLOR=Black]=[/COLOR] _cbit([COLOR=Blue]CHR[/COLOR](intOperand2), iByteLoop).

            [COLOR=SeaGreen]/* XOR each bit*/[/COLOR]
            [COLOR=Blue]IF[/COLOR] (lFirstBit [COLOR=Blue]AND NOT[/COLOR] lSecondBit) [COLOR=Blue]OR[/COLOR]
               (lSecondBit [COLOR=Blue]AND NOT [/COLOR]lFirstBit) [COLOR=Blue]THEN[/COLOR]
              iXOResult [COLOR=Black]=[/COLOR] iXOResult [COLOR=Blue]+[/COLOR] [COLOR=Blue]EXP[/COLOR]([COLOR=Red]2[/COLOR], iByteLoop).
    [COLOR=Blue]END.
[/COLOR] 
    [COLOR=Blue]RETURN[/COLOR] iXOResult.

[COLOR=Blue] END FUNCTION.[/COLOR] [COLOR=SeaGreen]/*End function of BinaryXOR */[/COLOR]

DEFINE VARIABLE mKeyOpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKeyIpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mData             AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKey              AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mInnerCombined    AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mOuterCombined    AS MEMPTR     NO-UNDO.

DEFINE VARIABLE iBytePos          AS INTEGER    NO-UNDO.
DEFINE VARIABLE iOpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iIpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iKey              AS INTEGER    NO-UNDO.
DEFINE VARIABLE iTimeTaken        AS INTEGER    NO-UNDO.

DEFINE VARIABLE rRawDataSHA1      AS RAW        NO-UNDO.
DEFINE VARIABLE rRawDataMD5       AS RAW        NO-UNDO.

DEFINE VARIABLE cKey              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cHMACSHA1         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cHMACMD5          AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cDataFileName     AS CHARACTER  NO-UNDO.

&SCOPED-DEFINE xiBlockSize  64

ASSIGN
  cKey          = "1234":U
  cDataFileName = "F:\tmp\syncml.wbxml":U.

UPDATE 
  cKey          FORMAT "x(50)" LABEL "HMAC KEY":R10         
  cDataFileName FORMAT "x(50)" LABEL "Filename":R10
  WITH SIDE-LABELS.

IF SEARCH(cDataFileName) = ? THEN
DO:
  MESSAGE 
    SUBSTITUTE("File [&1] was not found!",
               cDataFileName).

  RETURN. 
END.  /* IF SEARCH(cDataFileName) = ? THEN...*/
ELSE
DO:
  FILE-INFO:FILE-NAME = cDataFileName.

  IF FILE-INFO:FILE-TYPE BEGINS "FR*":U THEN
  DO:
    MESSAGE 
      SUBSTITUTE("File [&1] was is not readable.",
                 cDataFileName).

    RETURN. 
  END.
END.  /* IF NOT SEARCH(cDataFileName) = ? THEN... */

iTimeTaken = ETIME.

SET-SIZE(mKey)     = {&xiBlockSize}.
SET-SIZE(mKeyOpad) = {&xiBlockSize}.
SET-SIZE(mKeyIpad) = {&xiBlockSize}.

DO iBytePos = 1 TO {&xiBlockSize}:
  PUT-BYTES(mKey,     iBytePos) = HEX-DECODE("00":U).  /* 64 bytes of zeros 0x00*/
  PUT-BYTES(mKeyOpad, iBytePos) = HEX-DECODE("5C":U).  /* 64 bytes of 0x5C (92 dec,  "/" ascii) */
  PUT-BYTES(mKeyIpad, iBytePos) = HEX-DECODE("36":U).  /* 64 bytes of 0x36 (54 dec, "6" ascii)*/
END.


PUT-STRING(mKey, 1, LENGTH(ckey))  = cKey.

DO iBytePos = 1 TO {&xiBlockSize}:
  
  ASSIGN
    iKey  = GET-BYTE(mKey,     iBytePos)
    iOpad = GET-BYTE(mKeyOpad, iBytePos)
    iIpad = GET-BYTE(mKeyIpad, iBytePos).
  
  /* The inner key, mKeyIpad is formed from mKey by XORing each byte with 0x36.. */
  PUT-BYTE(mKeyIpad, iBytePos) = BinaryXOR(INPUT iKey, 
                                           INPUT iIpad).

  /* The inner key, mKeyOpad is formed from mKey by XORing each byte with 0x5C. */
  PUT-BYTE(mKeyOpad, iBytePos) = BinaryXOR(INPUT iKey, 
                                           INPUT iOpad).

END.

SET-SIZE(mKey) = 0.

/* Get the data from the file and shove it into a memmory.*/
COPY-LOB FROM FILE cDataFileName TO OBJECT mData.

/* Inner Loop*/
SET-SIZE(mInnerCombined)      = GET-SIZE(mKeyIpad) + GET-SIZE(mData).

PUT-BYTES(mInnerCombined, 1)  = mKeyIpad.
SET-SIZE(mKeyIpad) = 0.

/*Append the data the end of the block size.*/
PUT-BYTES(mInnerCombined, {&xiBlockSize} + 1) = mData.

/* Deallocates any memory. */
SET-SIZE(mData) = 0.

/* Get the results of the SHA1 & MD5 Digest.*/
ASSIGN
  rRawDataSHA1           = SHA1-DIGEST(mInnerCombined)
  rRawDataMD5            = MD5-DIGEST(mInnerCombined).

/* Deallocates any memory. */
SET-SIZE(mInnerCombined) = 0.

/* Outer Loop calculation for SHA1*/
SET-SIZE(mOuterCombined)                      = 0.
SET-SIZE(mOuterCombined)                      = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA1).
PUT-BYTES(mOuterCombined, 1)                  = mKeyOpad.
PUT-BYTES(mOuterCombined, {&xiBlockSize} + 1) = rRawDataSHA1.

/* SHA1*/
rRawDataSHA1 = SHA1-DIGEST(mOuterCombined).

/* Outer Loop calculation for MD5*/
SET-SIZE(mOuterCombined)                      = 0.
SET-SIZE(mOuterCombined)                      = GET-SIZE(mKeyOpad) + LENGTH(rRawDataMD5).
PUT-BYTES(mOuterCombined, 1)                  = mKeyOpad.
PUT-BYTES(mOuterCombined, {&xiBlockSize} + 1) = rRawDataMD5.

/* Get the HMAC results from the MD5 */
rRawDataMD5  = MD5-DIGEST(mOuterCombined).

/* Deallocates any memory. */
SET-SIZE(mKeyOpad)       = 0.
SET-SIZE(mOuterCombined) = 0.

/* Convert the raw binary results into a human readable HEX values.*/
cHMACSHA1 = HEX-ENCODE(rRawDataSHA1).
cHMACMD5  = HEX-ENCODE(rRawDataMD5).
                                                                             
DISPLAY
  DATETIME(TODAY,(ETIME - iTimeTaken) ) LABEL "Time Taken"
  WITH SIDE-LABELS.

/* Display the final results to the user.*/
UPDATE 
  cHMACMD5  FORMAT "x(50)" LABEL "MD5":R10
  cHMACSHA1 FORMAT "x(50)" LABEL "SHA1":R10
  WITH SIDE-LABELS.

&UNDEFINE xiBlockSize
 

joey.jeremiah

ProgressTalk Moderator
Staff member
WOW !!! Now that's a program

Wouldn't it be great if we had place right here @progresstalk.com for posting code ? :)
 

CyrixInstead

New Member
Many thanks for this, I used it recently and it works well. However, the Binary XOR function mentioned uses an internal, undocumented PROGRESS function which should never be used if there is an alternative available (in case they ever remove or change it).

It looks like the original BinaryXOR function was created and posted to the PEG in 2001 (http://www.oehive.org/amduus/Misc/LXOR.i) and the _cbit function was discussed before that in 2000 (http://www.peg.com/forums/peg/200012/msg00151.html). Somebody in the original discussion thread on the PEG suggested using a PROGRESS function called GET-BITS(). This worked for me, adapting the BinaryXOR as so:

Code:
FUNCTION BinaryXOR RETURNS INTEGER
    (INPUT intOperand1 AS INTEGER,
    INPUT intOperand2 AS INTEGER):

    DEFINE VARIABLE iByteLoop  AS INTEGER NO-UNDO.
    DEFINE VARIABLE iXOResult  AS INTEGER NO-UNDO.
    DEFINE VARIABLE lFirstBit  AS LOGICAL NO-UNDO.
    DEFINE VARIABLE lSecondBit AS LOGICAL NO-UNDO.

    iXOResult = 0.

    /*spin through each byte of each char*/
    DO iByteLoop = 0 TO 7: /* as processing a single byte character */

        /*find state (true / false) of each integer's byte*/
        ASSIGN
            lFirstBit  = GET-BITS(intOperand1,iByteLoop + 1,1) = 1
            lSecondBit = GET-BITS(intOperand2,iByteLoop + 1,1) = 1.

        /* XOR each bit*/
        IF (lFirstBit AND NOT lSecondBit) OR
            (lSecondBit AND NOT lFirstBit) THEN
            iXOResult = iXOResult + EXP(2, iByteLoop).
    END.

    RETURN iXOResult.
END FUNCTION. /*End function of BinaryXOR */

I hope that helps anyone wanting to use a binary XOR in their code.

~Cyrix[/code]
 
Last edited:

redsuitee

Member
I do some modications on cecil's code to conform with my needs.

Here is my code :
Code:
FUNCTION BinaryXOR RETURNS INTEGER (INPUT intOperand1 AS INTEGER,INPUT intOperand2 AS INTEGER):
    DEFINE VARIABLE iByteLoop  AS INTEGER NO-UNDO.
    DEFINE VARIABLE iXOResult  AS INTEGER NO-UNDO.
    DEFINE VARIABLE lFirstBit  AS LOGICAL NO-UNDO.
    DEFINE VARIABLE lSecondBit AS LOGICAL NO-UNDO.

    iXOResult = 0.

    /*spin through each byte of each char*/
    DO iByteLoop = 0 TO 7: /* as processing a single byte character */
        /*find state (true / false) of each integer's byte*/
        ASSIGN
            lFirstBit  = _cbit(CHR(intOperand1), iByteLoop)
            lSecondBit = _cbit(CHR(intOperand2), iByteLoop).

            /* XOR each bit*/
            IF (lFirstBit AND NOT lSecondBit) 
                OR (lSecondBit AND NOT lFirstBit) THEN
                iXOResult = iXOResult + EXP(2, iByteLoop).
    END.                                                  
    RETURN iXOResult.
END FUNCTION. /*End function of BinaryXOR */

/******************************* WIDGETS *************************************/
DEFINE VARIABLE mKeyOpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKeyIpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKey              AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mInnerCombined    AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mOuterCombined    AS MEMPTR     NO-UNDO.

DEFINE VARIABLE iBytePos          AS INTEGER    NO-UNDO.
DEFINE VARIABLE iOpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iIpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iKey              AS INTEGER    NO-UNDO.
DEFINE VARIABLE iTimeTaken        AS INTEGER    NO-UNDO.

DEFINE VARIABLE rRawDataSHA1      AS RAW        NO-UNDO.

DEFINE VARIABLE cKey              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cHMACSHA1         AS CHARACTER  NO-UNDO.

&SCOPED-DEFINE xiBlockSize  64

/***************************** MAIN LOGIC *********************************/
ASSIGN cKey = "":U.
UPDATE cKey FORMAT "x(50)" LABEL "HMAC KEY":R10 WITH SIDE-LABELS.
iTimeTaken = ETIME.

SET-SIZE(mKey)     = {&xiBlockSize}.
SET-SIZE(mKeyOpad) = {&xiBlockSize}.
SET-SIZE(mKeyIpad) = {&xiBlockSize}.

DO iBytePos = 1 TO {&xiBlockSize}:
    PUT-BYTES(mKey,     iBytePos) = HEX-DECODE("00":U).  /* 64 bytes of zeros 0x00*/
    PUT-BYTES(mKeyOpad, iBytePos) = HEX-DECODE("5C":U).  /* 64 bytes of 0x5C (92 dec,  "/" ascii) */
    PUT-BYTES(mKeyIpad, iBytePos) = HEX-DECODE("36":U).  /* 64 bytes of 0x36 (54 dec, "6" ascii)*/
END.

PUT-STRING(mKey, 1, LENGTH(ckey))  = cKey.

DO iBytePos = 1 TO {&xiBlockSize}:
    ASSIGN
        iKey  = GET-BYTE(mKey,     iBytePos)
        iOpad = GET-BYTE(mKeyOpad, iBytePos)
        iIpad = GET-BYTE(mKeyIpad, iBytePos).

    /* The inner key, mKeyIpad is formed from mKey by XORing each byte with 0x36.. */
    PUT-BYTE(mKeyIpad, iBytePos) = BinaryXOR(INPUT iKey, INPUT iIpad).

    /* The inner key, mKeyOpad is formed from mKey by XORing each byte with 0x5C. */
    PUT-BYTE(mKeyOpad, iBytePos) = BinaryXOR(INPUT iKey, INPUT iOpad).
END.
SET-SIZE(mKey) = 0.

/* Inner Loop*/
SET-SIZE(mInnerCombined)      = GET-SIZE(mKeyIpad).
PUT-BYTES(mInnerCombined, 1)  = mKeyIpad.
SET-SIZE(mKeyIpad) = 0.

ASSIGN rRawDataSHA1           = SHA1-DIGEST(mInnerCombined). /* Get the results of the SHA1.*/
SET-SIZE(mInnerCombined) = 0. /* Deallocates any memory. */

/* Outer Loop calculation for SHA1*/
SET-SIZE(mOuterCombined)                      = 0.
SET-SIZE(mOuterCombined)                      = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA1).
PUT-BYTES(mOuterCombined, 1)                  = mKeyOpad.
PUT-BYTES(mOuterCombined, {&xiBlockSize} + 1) = rRawDataSHA1.
rRawDataSHA1 = SHA1-DIGEST(mOuterCombined). /* SHA1*/
/* Deallocates any memory. */
SET-SIZE(mKeyOpad)       = 0.
SET-SIZE(mOuterCombined) = 0.

/* Convert the raw binary results into a human readable HEX values.*/
cHMACSHA1 = HEX-ENCODE(rRawDataSHA1).

DISPLAY DATETIME(TODAY,(ETIME - iTimeTaken) ) LABEL "Time Taken" SKIP 
    STRING(rRawDataSHA1) FORMAT "x(50)" LABEL "Result of SHA1-DIGEST" SKIP 
    LENGTH(STRING(rRawDataSHA1)) LABEL "Length of SHA1-DIGEST" SKIP WITH SIDE-LABELS.

/* Display the final results to the user.*/
UPDATE cHMACSHA1 FORMAT "x(50)" LABEL "SHA1":R10 WITH SIDE-LABELS.
&UNDEFINE xiBlockSize
But when I implemented the hmac-sha1 result to the 3rd parties application, it shows an error >> "The request signature we calculated does not match the signature you provided."

Can anybody tells me where is the problem of my code?
Thank you in advance.
 

Cecil

19+ years progress programming and still learning.
Just looking at the code now, and converting it into a function. Now when I created originally I needed to encode the raw results into hexadecimal value. Do you need to supply the the raw hash value as hex or base64. What does the documentation say about the web services API?
 

redsuitee

Member
Here is some information from the documentation :
To calculate the signature

  1. Concatenate the values of the Action and Timestamp request parameters, in that order.
    The string you've just created is the string you'll use when generating the signature.
  2. Calculate an RFC 2104-compliant HMAC-SHA1 signature, using the string you just created and your Secret Access Key as the key.
  3. Convert the resulting value to base64.
  4. Pass this final value in the Signature parameter of the SOAP request.
 

Cecil

19+ years progress programming and still learning.
Here is the code converted into a function the returning result is hex value. See screenshot as proof that it's working correctly:HMACSHA1 validation check.PNG

It won't take me long to convert it so the output result is encoded into BASE64


Code:
                                            /* Simple HMAC function Overview                                                */
/* Developer: James Bowell                                                      */
/* Date:      09/06/2006                                                        */
/* Procedure: hmac-function.p                                                   */
/* References: http://www.ietf.org/rfc/rfc2104.txt                              */
/*             http://the.jhu.edu/upe/member_sites/zarfoss/HMAC-big.jpg         */
/*             http://en.wikipedia.org/wiki/HMAC                                */
/*             http://www.cryptostuff.com/crypto/index.php?title=hmac           */
/* HMAC is a hash based MAC algorithm defined in RFC 2104. It can use any       */
/* hash function (such as MD5, SHA1 etc). HMAC also requires a user             */
/* supplied secret key, which is a string of bytes of any length upto 64 bytes. */



FUNCTION BinaryXOR RETURNS INTEGER
  (INPUT intOperand1 AS INTEGER,
   INPUT intOperand2 AS INTEGER):

    DEFINE VARIABLE iByteLoop  AS INTEGER NO-UNDO.
    DEFINE VARIABLE iXOResult  AS INTEGER NO-UNDO.
    DEFINE VARIABLE lFirstBit  AS LOGICAL NO-UNDO.
    DEFINE VARIABLE lSecondBit AS LOGICAL NO-UNDO.

    iXOResult = 0.

    /*spin through each byte of each char*/
    DO iByteLoop = 0 TO 7: /* as processing a single byte character */

        /*find state (true / false) of each integer's byte*/
        ASSIGN
            lFirstBit  = GET-BITS(intOperand1,iByteLoop + 1,1) = 1
            lSecondBit = GET-BITS(intOperand2,iByteLoop + 1,1) = 1.

            /* XOR each bit*/
            IF (lFirstBit AND NOT lSecondBit) OR
               (lSecondBit AND NOT lFirstBit) THEN
              iXOResult = iXOResult + EXP(2, iByteLoop).
    END.
 
    RETURN iXOResult.

 END FUNCTION. /*End function of BinaryXOR */

FUNCTION HMACSHA1 RETURN CHARACTER 
    (INPUT pcKey AS CHARACTER, 
     INPUT pcData AS CHARACTER):

DEFINE VARIABLE mKeyOpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKeyIpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mData             AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKey              AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mInnerCombined    AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mOuterCombined    AS MEMPTR     NO-UNDO.

DEFINE VARIABLE iBytePos          AS INTEGER    NO-UNDO.
DEFINE VARIABLE iOpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iIpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iKey              AS INTEGER    NO-UNDO.
DEFINE VARIABLE iTimeTaken        AS INTEGER    NO-UNDO.

DEFINE VARIABLE rRawDataSHA1      AS RAW        NO-UNDO.


DEFINE VARIABLE cHMACSHA1         AS CHARACTER  NO-UNDO.


&SCOPED-DEFINE xiBlockSize  64

SET-SIZE(mKey)     = 0.
SET-SIZE(mKeyOpad) = 0.
SET-SIZE(mKeyIpad) = 0.
SET-SIZE(mKey)     = {&xiBlockSize}.
SET-SIZE(mKeyOpad) = {&xiBlockSize}.
SET-SIZE(mKeyIpad) = {&xiBlockSize}.

DO iBytePos = 1 TO {&xiBlockSize}:
  PUT-BYTES(mKey,     iBytePos) = HEX-DECODE("00":U).  /* 64 bytes of zeros 0x00*/
  PUT-BYTES(mKeyOpad, iBytePos) = HEX-DECODE("5C":U).  /* 64 bytes of 0x5C (92 dec,  "/" ascii) */
  PUT-BYTES(mKeyIpad, iBytePos) = HEX-DECODE("36":U).  /* 64 bytes of 0x36 (54 dec, "6" ascii)*/
END.


PUT-STRING(mKey, 1, LENGTH(pckey))  = pcKey.

DO iBytePos = 1 TO {&xiBlockSize}:
  
  ASSIGN
    iKey  = GET-BYTE(mKey,     iBytePos)
    iOpad = GET-BYTE(mKeyOpad, iBytePos)
    iIpad = GET-BYTE(mKeyIpad, iBytePos).
  
  /* The inner key, mKeyIpad is formed from mKey by XORing each byte with 0x36.. */
  PUT-BYTE(mKeyIpad, iBytePos) = BinaryXOR(INPUT iKey, 
                                           INPUT iIpad).

  /* The inner key, mKeyOpad is formed from mKey by XORing each byte with 0x5C. */
  PUT-BYTE(mKeyOpad, iBytePos) = BinaryXOR(INPUT iKey, 
                                           INPUT iOpad).

END.

SET-SIZE(mKey)  = 0.
SET-SIZE(mData) = 0.
SET-SIZE(mData) = LENGTH(pcData).
PUT-STRING(mData,1,LENGTH(pcData)) = pcData.


/* Inner Loop*/
SET-SIZE(mInnerCombined)      = GET-SIZE(mKeyIpad) + GET-SIZE(mData).

PUT-BYTES(mInnerCombined, 1)  = mKeyIpad.
SET-SIZE(mKeyIpad) = 0.

/*Append the data the end of the block size.*/
PUT-BYTES(mInnerCombined, {&xiBlockSize} + 1) = mData.

/* Deallocates any memory. */
SET-SIZE(mData) = 0.

/* Get the results of the SHA1 & MD5 Digest.*/
ASSIGN
  rRawDataSHA1           = SHA1-DIGEST(mInnerCombined).
                                                       
/* Deallocates any memory. */
SET-SIZE(mInnerCombined) = 0.

/* Outer Loop calculation for SHA1*/
SET-SIZE(mOuterCombined)                      = 0.
SET-SIZE(mOuterCombined)                      = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA1).
PUT-BYTES(mOuterCombined, 1)                  = mKeyOpad.
PUT-BYTES(mOuterCombined, {&xiBlockSize} + 1) = rRawDataSHA1.

/* SHA1*/
rRawDataSHA1 = SHA1-DIGEST(mOuterCombined).

/* Deallocates any memory. */
SET-SIZE(mKeyOpad)       = 0.
SET-SIZE(mOuterCombined) = 0.

/* Convert the raw binary results into a human readable HEX values.*/
cHMACSHA1 = HEX-ENCODE(rRawDataSHA1).

&UNDEFINE xiBlockSize
    RETURN cHMACSHA1.
 END FUNCTION. /** End Of Function HMACSHA1 */


 DEFINE VARIABLE chKey AS CHARACTER   NO-UNDO.
 DEFINE VARIABLE chData AS CHARACTER   NO-UNDO.

 ASSIGN
     chKey = '1234'
     chData = 'ABCD'.

 MESSAGE 'KEY:' chKey SKIP
         'DATA: ' chData SKIP  
         'SHA1:' HMACSHA1(chKey,chData)
     VIEW-AS ALERT-BOX INFO TITLE 'ABL HMACSHA1 Function Unit Test'.
 

Cecil

19+ years progress programming and still learning.
The function now returns a Base64 encoded value rather than the hexadecimal encoded value.

Code:
                                            /* Simple HMAC function Overview                                                */
/* Developer: James Bowen                                                      */
/* Date:      13/06/2011                                                        */
/* References: http://www.ietf.org/rfc/rfc2104.txt                              */
/*             http://the.jhu.edu/upe/member_sites/zarfoss/HMAC-big.jpg         */
/*             http://en.wikipedia.org/wiki/HMAC                                */
/*             http://www.cryptostuff.com/crypto/index.php?title=hmac           */
/* HMAC is a hash based MAC algorithm defined in RFC 2104. It can use any       */
/* hash function (such as MD5, SHA1 etc). HMAC also requires a user             */
/* supplied secret key, which is a string of bytes of any length upto 64 bytes. */



FUNCTION BinaryXOR RETURNS INTEGER
  (INPUT intOperand1 AS INTEGER,
   INPUT intOperand2 AS INTEGER):

    DEFINE VARIABLE iByteLoop  AS INTEGER NO-UNDO.
    DEFINE VARIABLE iXOResult  AS INTEGER NO-UNDO.
    DEFINE VARIABLE lFirstBit  AS LOGICAL NO-UNDO.
    DEFINE VARIABLE lSecondBit AS LOGICAL NO-UNDO.

    iXOResult = 0.

    /*spin through each byte of each char*/
    DO iByteLoop = 0 TO 7: /* as processing a single byte character */

        /*find state (true / false) of each integer's byte*/
        ASSIGN
            lFirstBit  = GET-BITS(intOperand1,iByteLoop + 1,1) = 1
            lSecondBit = GET-BITS(intOperand2,iByteLoop + 1,1) = 1.

            /* XOR each bit*/
            IF (lFirstBit AND NOT lSecondBit) OR
               (lSecondBit AND NOT lFirstBit) THEN
              iXOResult = iXOResult + EXP(2, iByteLoop).
    END.
 
    RETURN iXOResult.

 END FUNCTION. /*End function of BinaryXOR */

FUNCTION HMACSHA1-BASE64 RETURN CHARACTER 
    (INPUT pcKey AS CHARACTER, 
     INPUT pcData AS CHARACTER):

DEFINE VARIABLE mKeyOpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKeyIpad          AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mData             AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mKey              AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mInnerCombined    AS MEMPTR     NO-UNDO.
DEFINE VARIABLE mOuterCombined    AS MEMPTR     NO-UNDO.

DEFINE VARIABLE iBytePos          AS INTEGER    NO-UNDO.
DEFINE VARIABLE iOpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iIpad             AS INTEGER    NO-UNDO.
DEFINE VARIABLE iKey              AS INTEGER    NO-UNDO.
DEFINE VARIABLE iTimeTaken        AS INTEGER    NO-UNDO.

DEFINE VARIABLE rRawDataSHA1      AS RAW        NO-UNDO.


DEFINE VARIABLE cHMACSHA1         AS CHARACTER  NO-UNDO.


&SCOPED-DEFINE xiBlockSize  64

SET-SIZE(mKey)     = 0.
SET-SIZE(mKeyOpad) = 0.
SET-SIZE(mKeyIpad) = 0.
SET-SIZE(mKey)     = {&xiBlockSize}.
SET-SIZE(mKeyOpad) = {&xiBlockSize}.
SET-SIZE(mKeyIpad) = {&xiBlockSize}.

DO iBytePos = 1 TO {&xiBlockSize}:
  PUT-BYTES(mKey,     iBytePos) = HEX-DECODE("00":U).  /* 64 bytes of zeros 0x00*/
  PUT-BYTES(mKeyOpad, iBytePos) = HEX-DECODE("5C":U).  /* 64 bytes of 0x5C (92 dec,  "/" ascii) */
  PUT-BYTES(mKeyIpad, iBytePos) = HEX-DECODE("36":U).  /* 64 bytes of 0x36 (54 dec, "6" ascii)*/
END.


PUT-STRING(mKey, 1, LENGTH(pckey))  = pcKey.

DO iBytePos = 1 TO {&xiBlockSize}:
  
  ASSIGN
    iKey  = GET-BYTE(mKey,     iBytePos)
    iOpad = GET-BYTE(mKeyOpad, iBytePos)
    iIpad = GET-BYTE(mKeyIpad, iBytePos).
  
  /* The inner key, mKeyIpad is formed from mKey by XORing each byte with 0x36.. */
  PUT-BYTE(mKeyIpad, iBytePos) = BinaryXOR(INPUT iKey, 
                                           INPUT iIpad).

  /* The inner key, mKeyOpad is formed from mKey by XORing each byte with 0x5C. */
  PUT-BYTE(mKeyOpad, iBytePos) = BinaryXOR(INPUT iKey, 
                                           INPUT iOpad).

END.

SET-SIZE(mKey)  = 0.
SET-SIZE(mData) = 0.
SET-SIZE(mData) = LENGTH(pcData).
PUT-STRING(mData,1,LENGTH(pcData)) = pcData.


/* Inner Loop*/
SET-SIZE(mInnerCombined)      = GET-SIZE(mKeyIpad) + GET-SIZE(mData).

PUT-BYTES(mInnerCombined, 1)  = mKeyIpad.
SET-SIZE(mKeyIpad) = 0.

/*Append the data the end of the block size.*/
PUT-BYTES(mInnerCombined, {&xiBlockSize} + 1) = mData.

/* Deallocates any memory. */
SET-SIZE(mData) = 0.

/* Get the results of the SHA1 Digest.*/
ASSIGN
  rRawDataSHA1           = SHA1-DIGEST(mInnerCombined).
                                                       
/* Deallocates any memory. */
SET-SIZE(mInnerCombined) = 0.

/* Outer Loop calculation for SHA1*/
SET-SIZE(mOuterCombined)                      = 0.
SET-SIZE(mOuterCombined)                      = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA1).
PUT-BYTES(mOuterCombined, 1)                  = mKeyOpad.
PUT-BYTES(mOuterCombined, {&xiBlockSize} + 1) = rRawDataSHA1.

/* SHA1*/
rRawDataSHA1 = SHA1-DIGEST(mOuterCombined).

/* Deallocates any memory. */
SET-SIZE(mKeyOpad)       = 0.
SET-SIZE(mOuterCombined) = 0.

/* Convert the raw binary results into a human readable BASE-64 value.*/
cHMACSHA1 = BASE64-ENCODE(rRawDataSHA1).

&UNDEFINE xiBlockSize
    RETURN cHMACSHA1.
 END FUNCTION. /** End Of Function HMACSHA1-BASE64 */


 DEFINE VARIABLE chKey AS CHARACTER   NO-UNDO.
 DEFINE VARIABLE chData AS CHARACTER   NO-UNDO.

 ASSIGN
     chKey = '1234'
     chData = 'IAMACTIONMANHEARMYROAR' + STRING(NOW).

 MESSAGE 'KEY:' chKey SKIP
         'DATA: ' chData SKIP  
         'SHA1 (BASE64):' HMACSHA1-BASE64(chKey,chData)
     VIEW-AS ALERT-BOX INFO TITLE 'ABL HMACSHA1-BASE64 Function Unit Test'.
 

redsuitee

Member
Cecil,
Can you explain to me, what should I pass into HMACSHA1-BASE64 function (for pcKey and pcData)?
As far as I understand, I only have one input parameter which is in the documentation called with secret access key.
Where is the secret access key should be used?
Thank you in advance
 

Cecil

19+ years progress programming and still learning.
From using the information/documentation you gave me (I'm guessing it something to do with Amazon's Web Services). You need to pass the "Secret access key" the first input parameter (see step 2 of the documentation) and the concatenation of the values of the "Action" and "Timestamp" this would be the second input parameter(see step 1 of the documentation).
Example:

HMACSHA1-BASE64(INPUT 'YourSecrectKey':U, INPUT 'Action' + '14/06/2011T21:02:00.000':U).

The signature generated by the function is the hash sum of both the [FONT=Tahoma, Calibri, Verdana, Geneva, sans-serif]Secret access key and Action + Time[/FONT]Stamp.

[FONT=Tahoma, Calibri, Verdana, Geneva, sans-serif]I don't know how else I can explain it any other way. Read the your API documentation again it's explains it all. There needs to be two parameter not just one.[/FONT]
 

ve2

New Member
To Cecil:

You HMACSHA1-BASE64 function is good, but if key (pcKey string) greater than sha1 block size (64 bytes) it's work incorrect.
To improve this function you shoul'd add something like

/* correction by Valery A.Eliseev */
if length(pcKey) > {&xiBlockSize} then do:
set-size(mData) = length(pcKey).
put-string(mData, 1, length(pcKey)) = pcKey.
rRawDataSHA1 = SHA1-DIGEST(mData).
PUT-BYTES(mKey, 1) = rRawDataSHA1.
end.
else
/* end of correction */

before line
PUT-STRING(mKey, 1, LENGTH(pckey)) = pcKey.
 

Cecil

19+ years progress programming and still learning.
Cool. As I was only using it for OTA messaging and the pin number (pckey) was only ever 4 digit long this was never going to be a problem for me. Thanks for the update. it's worth considering. Hope this helps others using this function.
 

Cecil

19+ years progress programming and still learning.
Small Bug found:

Replace the line:
SET-SIZE(mOuterCombined) = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA1).
with
SET-SIZE(mOuterCombined) = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA1,'RAW':U).

The RAW parameter is required when the the session code page is of double-byte i.e. UTF-8. Without this you get a ABL/Progress error message saying "Can't put past the end of the mempointer."
 

CyrixInstead

New Member
Progress have used this version of the HMAC algorithm to answer a question on the Knowledge Base. There appears to be a correction in the hash calc procedure (see the bit with the comment "correction by Valery A.Eliseev"). Here is the official unofficial Progress version. Their version allows you to use SHA-1 or SHA-256. I've added this comment to the thread in case anyone comes across this thread and implements it, as it's still high in the Google results list for Progress-related HMAC searches.

Code:
FUNCTION HMAC-BASE64 RETURN CHARACTER 
    (INPUT pcSHA AS CHARACTER,
    INPUT pcKey AS CHARACTER, 
    INPUT pcData AS CHARACTER):

    DEFINE VARIABLE mKeyOpad       AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE mKeyIpad       AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE mData          AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE mKey           AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE mInnerCombined AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE mOuterCombined AS MEMPTR    NO-UNDO.
    DEFINE VARIABLE iBytePos       AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iOpad          AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iIpad          AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iKey           AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iTimeTaken     AS INTEGER   NO-UNDO.
    DEFINE VARIABLE rRawDataSHA    AS RAW       NO-UNDO.
    DEFINE VARIABLE cHMACSHA       AS CHARACTER NO-UNDO.
   
    &SCOPED-DEFINE xiBlockSize  64
   
    SET-SIZE(mKey)     = 0.
    SET-SIZE(mKeyOpad) = 0.
    SET-SIZE(mKeyIpad) = 0.
    SET-SIZE(mKey)     = {&xiBlockSize}.
    SET-SIZE(mKeyOpad) = {&xiBlockSize}.
    SET-SIZE(mKeyIpad) = {&xiBlockSize}.
   
    DO iBytePos = 1 TO {&xiBlockSize}:
        PUT-BYTES(mKey,     iBytePos) = HEX-DECODE("00":U).  /* 64 bytes of zeros 0x00*/
        PUT-BYTES(mKeyOpad, iBytePos) = HEX-DECODE("5C":U).  /* 64 bytes of 0x5C (92 dec,  "/" ascii) */
        PUT-BYTES(mKeyIpad, iBytePos) = HEX-DECODE("36":U).  /* 64 bytes of 0x36 (54 dec, "6" ascii)*/
    END.
   
    /* correction by Valery A.Eliseev */
    IF LENGTH(pcKey) > {&xiBlockSize} THEN 
    DO:
        set-size(mData) = LENGTH(pcKey).
        put-string(mData, 1, LENGTH(pcKey)) = pcKey.
        rRawDataSHA = SHA1-DIGEST(mData).
        PUT-BYTES(mKey, 1) = rRawDataSHA.
    END.
    ELSE
        /* end of correction */
   
        PUT-STRING(mKey, 1, LENGTH(pckey))  = pcKey. 
   
    DO iBytePos = 1 TO {&xiBlockSize}:
     
        ASSIGN
            iKey  = GET-BYTE(mKey,     iBytePos)
            iOpad = GET-BYTE(mKeyOpad, iBytePos)
            iIpad = GET-BYTE(mKeyIpad, iBytePos).
     
        /* The inner key, mKeyIpad is formed from mKey by XORing each byte with 0x36.. */
        PUT-BYTE(mKeyIpad, iBytePos) = BinaryXOR(INPUT iKey, 
            INPUT iIpad).
   
        /* The inner key, mKeyOpad is formed from mKey by XORing each byte with 0x5C. */
        PUT-BYTE(mKeyOpad, iBytePos) = BinaryXOR(INPUT iKey, 
            INPUT iOpad).
   
    END.
   
    SET-SIZE(mKey)  = 0.
    SET-SIZE(mData) = 0.
    SET-SIZE(mData) = LENGTH(pcData).
    PUT-STRING(mData,1,LENGTH(pcData)) = pcData.
   
   
    /* Inner Loop*/
    SET-SIZE(mInnerCombined)      = GET-SIZE(mKeyIpad) + GET-SIZE(mData).
   
    PUT-BYTES(mInnerCombined, 1)  = mKeyIpad.
    SET-SIZE(mKeyIpad) = 0.
   
    /*Append the data the end of the block size.*/
    PUT-BYTES(mInnerCombined, {&xiBlockSize} + 1) = mData.
   
    /* Deallocates any memory. */
    SET-SIZE(mData) = 0.
   
    /* Get the results of the SHA Digest.*/
    CASE pcSHA:
        WHEN 'SHA1' THEN
            ASSIGN
                rRawDataSHA = SHA1-DIGEST(mInnerCombined).
        WHEN 'SHA-256' THEN
            ASSIGN
                rRawDataSHA = MESSAGE-DIGEST('SHA-256', mInnerCombined).
        OTHERWISE 
        ASSIGN
            rRawDataSHA = SHA1-DIGEST(mInnerCombined).
    END CASE.
                                     
    /* Deallocates any memory. */
    SET-SIZE(mInnerCombined) = 0.
   
    /* Outer Loop calculation for SHA*/
    SET-SIZE(mOuterCombined)                      = 0.
    SET-SIZE(mOuterCombined)                      = GET-SIZE(mKeyOpad) + LENGTH(rRawDataSHA,'RAW':U).
    PUT-BYTES(mOuterCombined, 1)                  = mKeyOpad.
    PUT-BYTES(mOuterCombined, {&xiBlockSize} + 1) = rRawDataSHA.
   
    /* SHA*/
    CASE pcSHA:
        WHEN 'SHA1' THEN
            ASSIGN
                rRawDataSHA = SHA1-DIGEST(mOuterCombined).
        WHEN 'SHA-256' THEN
            ASSIGN
                rRawDataSHA = MESSAGE-DIGEST('SHA-256', mOuterCombined).
        OTHERWISE 
        ASSIGN
            rRawDataSHA = SHA1-DIGEST(mOuterCombined).
    END CASE.
   
    /* Deallocates any memory. */
    SET-SIZE(mKeyOpad)       = 0.
    SET-SIZE(mOuterCombined) = 0.
   
    /* Convert the raw binary results into a human readable BASE-64 value.*/
    /* cHMACSHA = BASE64-ENCODE(rRawDataSHA).*/
    cHMACSHA = HEX-ENCODE(rRawDataSHA).
   
   
    &UNDEFINE xiBlockSize
    RETURN cHMACSHA.
END FUNCTION. /** End Of Function HMACSHA1-BASE64 */
 

Cecil

19+ years progress programming and still learning.
May be I should post something on GitHub of the update code and inform progress to update there kbbase artical to the GitHub repository.

Just out of curiosity I would like to know what others use the Hmac function for. I.e. Which we services or api requires Hmac
 
Top