HMAC Algorithm (SHA256) in Classic ASP VBScript

Question

I'm trying to write an HMAC function in Classic ASP using SHA256 as the hash. I thought I got it right, but the results aren't the same for the examples listed on the Wikipedia page. I've seen several examples of people using HMAC SHA256 in Classic ASP by including a WSC. This is not what I want to do.

Here's the function:

Public Function HMAC_SHA256(prmKey, prmData)
    Dim theKey : theKey = prmKey
    Dim Block_Size, O_Pad, I_Pad
    Block_Size = 64
    O_Pad = 92 'HEX: 5c'
    I_Pad = 54 'HEX: 36'

    Dim iter, iter2
    If Len(theKey) < Block_Size Then
        For iter = 1 to Block_Size - Len(theKey)
            theKey = theKey & chr(0)
        Next
    ElseIf Len(theKey) > Block_Size Then
        theKey = SHA256(theKey)
    End If

    Dim o_key_pad : o_key_pad = ""
    Dim i_key_pad : i_key_pad = ""
    For iter = 1 to Block_Size
        o_key_pad = o_key_pad & Chr(Asc(Mid(theKey,iter,1)) xor O_Pad)
        i_key_pad = i_key_pad & Chr(Asc(Mid(theKey,iter,1)) xor I_Pad)
    Next

    HMAC_SHA256 = SHA256(o_key_pad & SHA256(i_key_pad & prmData))
End Function

And here's the pseudocode from Wikipedia's HMAC:

function hmac (key, message)
    if (length(key) > blocksize) then
        key = hash(key) // keys longer than blocksize are shortened
    end if
    if (length(key) < blocksize) then
        key = key ∥ [0x00 * (blocksize - length(key))] // keys shorter than blocksize are zero-padded (where ∥ is concatenation)
    end if

    o_key_pad = [0x5c * blocksize] ⊕ key // Where blocksize is that of the underlying hash function
    i_key_pad = [0x36 * blocksize] ⊕ key // Where ⊕ is exclusive or (XOR)

    return hash(o_key_pad ∥ hash(i_key_pad ∥ message)) // Where ∥ is concatenation
end function

I can't for the life of me determine what's wrong here. I imagine someone's going to tell me it's impossible in ASP and that's why there are so many suggestions to use the WSC. If this is the case, can someone explain why it's impossible? I don't see anything that should make this impossible.

Thanks!

EDIT: I've made sure the SHA256 function I use is giving the correct hashes, so it's nothing to do with that. I've also tried UCase'ing the results of the SHA256 function, and no dice.

EDIT2: Added example from wiki page.

Answer 1

Well, I once implemented TEA (tiny encryption algorithm) in classic ASP and had similar problems. In my case, the root cause was, that ASP saves the strings you are concatenating (& char) again as UTF-16 and so the offsets did not always match up where I expected them.

I don't know if this applies to your use case, since I had to work with UTF-8 special characters.

My solution was to work with an array of longs, that I could target properly with my binary functions. Here are the functions to work with this array, hoping they are helpful for you.

    '*******************************************************************************
    ' getArrayFromInputString (FUNCTION)
    '
    ' PARAMETERS:
    ' (In) - s_source - Source string (format is defined by n_options)
    ' (In) - n_blocksize - Blocksize, which is corrected by padding
    ' (In) - n_options - Options using follobing bits:
    '        1: string is in HEX format (e.g. DFD14DAFD9C555C07FEB8F3DA90DEA27)

    ' RETURN VALUE:
    ' long array
    '
    ' DESCRIPTION:
    ' allows to import strings in various formats for all input functions
    '*******************************************************************************
    private function getArrayFromInputString(s_source, n_blocksize, n_options)
        ' n_options:

        dim a_out, s_padded_string

        if (n_options AND 1) = 1 then
            s_padded_string = padString(s_source, n_blocksize * 2, "0")
            a_out = convertHexStringToArray(s_padded_string)
        else
            if b_unicode_ then
                s_padded_string = padString(s_source, int(n_blocksize / 2), " ")
                a_out = convertStringToArray_Unicode(s_padded_string)
            else    
                s_padded_string = padString(s_source, n_blocksize, " ")
                a_out = convertStringToArray(s_padded_string)
            end if
        end if

        getArrayFromInputString = a_out
    end function


    '*******************************************************************************
    ' convertStringToArray (FUNCTION)
    '
    ' PARAMETERS:
    ' (In) - s_source - Source string to build the array from
    '                   length MUST be in multiples of 4!
    '
    ' RETURN VALUE:
    ' Array of type Long - Length is 4 times smaller than the string length
    '
    ' DESCRIPTION:
    ' Blocks of four characters are calculated into one Long entry of the result array
    '*******************************************************************************
    private function convertStringToArray(s_source) ' returns long array
        dim a_out, n_index, n_length, n_temp
        dim n_array_index, n_nibble

        n_length = len(s_source)
        redim a_out(int(n_length / 4))

        for n_index=0 to n_length - 1
            n_temp = asc(mid(s_source, n_index + 1, 1))
            n_array_index = int(n_index / 4)
            n_nibble = n_index MOD 4

            a_out(n_array_index) = AddUnsigned(a_out(n_array_index), LShift(n_temp, (3 - n_nibble) * 8))
        next
        convertStringToArray = a_out
    end function

    '*******************************************************************************
    ' convertHexStringToArray (unicode version)
    private function convertStringToArray_Unicode(s_source) ' returns long array
        dim a_out, n_index, n_length, n_temp
        dim n_array_index, n_nibble

        n_length = len(s_source)
        redim a_out(int(n_length / 2))

        for n_index=0 to n_length - 1
            n_temp = ascw(mid(s_source, n_index + 1, 1))

            n_array_index = int(n_index / 2)
            n_nibble = (n_index MOD 2)

            a_out(n_array_index) = AddUnsigned(a_out(n_array_index), LShift(n_temp, (1 - n_nibble) * 16))
        next
        convertStringToArray_Unicode = a_out
    end function

    '*******************************************************************************
    ' convertHexStringToArray (FUNCTION)
    '
    ' PARAMETERS:
    ' (In) - s_source - Source string in hex format, e.g. "EFCE016503CDDB53"
    '                   length MUST be in multiples of 8!
    '
    ' RETURN VALUE:
    ' Array of type Long - Length is 8 times smaller than the string length
    '
    ' DESCRIPTION:
    ' Blocks of eight characters are calculated into one Long entry of the result array
    '*******************************************************************************
    private function convertHexStringToArray(s_source) ' returns long array
        dim a_out, n_index, n_length, n_temp
        dim n_array_index, n_nibble

        n_length = len(s_source)
        redim a_out(int(n_length / 8))

        for n_index=0 to n_length - 1 step 2
            n_temp = CInt("&H" & mid(s_source, n_index + 1, 2))
            n_array_index = int(n_index / 8)
            n_nibble = int((n_index MOD 8) / 2)

            a_out(n_array_index) = AddUnsigned(a_out(n_array_index), LShift(n_temp, (3 - n_nibble) * 8))
        next
        convertHexStringToArray = a_out
    end function


    '*******************************************************************************
    ' padString (FUNCTION)
    '
    ' PARAMETERS:
    ' (In) - s_source
    ' (In) - n_blocksize
    ' (In) - s_padding_char
    '
    ' RETURN VALUE:
    ' String - padded source string
    '
    ' DESCRIPTION:
    ' ensure, that the plaintext is multiples of n_blocksize bytes long, the needed amount of s_padding_char is applied
    '*******************************************************************************
    private function padString(s_source, n_blocksize, s_padding_char)
        dim s_out, n_length, n_padding, n_index

        s_out = s_source
        n_length = len(s_source)
        if n_length MOD n_blocksize>0 then
            n_padding = n_blocksize - n_length MOD n_blocksize
            for n_index=1 to n_padding
                s_out = s_out & left(s_padding_char, 1)
            next
        end if

        padString = s_out
    end function

    '*******************************************************************************
    ' printArray (FUNCTION)
    '
    ' PARAMETERS:
    ' (In) - s_prefix - just a string to be written in front for distinction of multiple arrays
    ' (In) - a_data - long array to print out
    '
    ' RETURN VALUE:
    ' none
    '
    ' DESCRIPTION:
    ' debug output function
    '*******************************************************************************
    private function printArray(s_prefix, a_data)
        dim n_index
        for n_index=0 to UBound(a_data) - 1
            Response.Write "<p>" & s_prefix & a_data(n_index) & " - " & getHex(a_data(n_index)) & "</p>" & vbNewline
        next
    end function

    '*******************************************************************************
    ' Some more little helper functions
    '*******************************************************************************
    private function getHex(n_value)
        getHex = Right("00000000" & Hex(n_value), 8)
    end function

    private function getStringFromLong(n_value)
        getStringFromLong = _
            Chr(RShift(n_value, 24) AND &HFF) & _
            Chr(RShift(n_value, 16) AND &HFF) & _
            Chr(RShift(n_value, 8) AND &HFF) & _
            Chr(n_value AND &HFF)
    end function

    private function getStringFromLong_Unicode(n_value)
        dim s_temp

        s_temp = getHex(n_value)
        getStringFromLong_Unicode = _
            ChrW(int("&H" & mid(s_temp, 1, 4))) & _
            ChrW(int("&H" & mid(s_temp, 5, 4)))
    end function

Answer 2

A long time ago I used this SHA256 construction. I think you can still use it in your classic asp pages, save code as asp file and do a virtual include in your page. You can use SHA256(string) to encrypt given string to a 64 char length like this: 6eea044931e914308aab890967338b2fe7e88de181a27e704c284d2b39580284.

To make it more robust you could add the rowid or timestamp plus password when you insert it into the database. This way it also needs to compare RowID+PASS or RowID+TimeStamp+PASS to the hash.

I have used this for many years without any problem. It is not the fastest and best written script but it works.

Private m_lOnBits(30)
Private m_l2Power(30)
Private K(63)

Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)

m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)

K(0) = &H428A2F98
K(1) = &H71374491
K(2) = &HB5C0FBCF
K(3) = &HE9B5DBA5
K(4) = &H3956C25B
K(5) = &H59F111F1
K(6) = &H923F82A4
K(7) = &HAB1C5ED5
K(8) = &HD807AA98
K(9) = &H12835B01
K(10) = &H243185BE
K(11) = &H550C7DC3
K(12) = &H72BE5D74
K(13) = &H80DEB1FE
K(14) = &H9BDC06A7
K(15) = &HC19BF174
K(16) = &HE49B69C1
K(17) = &HEFBE4786
K(18) = &HFC19DC6
K(19) = &H240CA1CC
K(20) = &H2DE92C6F
K(21) = &H4A7484AA
K(22) = &H5CB0A9DC
K(23) = &H76F988DA
K(24) = &H983E5152
K(25) = &HA831C66D
K(26) = &HB00327C8
K(27) = &HBF597FC7
K(28) = &HC6E00BF3
K(29) = &HD5A79147
K(30) = &H6CA6351
K(31) = &H14292967
K(32) = &H27B70A85
K(33) = &H2E1B2138
K(34) = &H4D2C6DFC
K(35) = &H53380D13
K(36) = &H650A7354
K(37) = &H766A0ABB
K(38) = &H81C2C92E
K(39) = &H92722C85
K(40) = &HA2BFE8A1
K(41) = &HA81A664B
K(42) = &HC24B8B70
K(43) = &HC76C51A3
K(44) = &HD192E819
K(45) = &HD6990624
K(46) = &HF40E3585
K(47) = &H106AA070
K(48) = &H19A4C116
K(49) = &H1E376C08
K(50) = &H2748774C
K(51) = &H34B0BCB5
K(52) = &H391C0CB3
K(53) = &H4ED8AA4A
K(54) = &H5B9CCA4F
K(55) = &H682E6FF3
K(56) = &H748F82EE
K(57) = &H78A5636F
K(58) = &H84C87814
K(59) = &H8CC70208
K(60) = &H90BEFFFA
K(61) = &HA4506CEB
K(62) = &HBEF9A3F7
K(63) = &HC67178F2

Private Function LShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
       LShift = lValue
       Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If

    If (lValue And m_l2Power(31 - iShiftBits)) Then
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) *    m_l2Power(iShiftBits)) Or &H80000000
    Else
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    End If
End Function

Private Function RShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If

    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then
        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function

Private Function AddUnsigned(lX, lY)
    Dim lX4, lY4, lX8, lY8, lResult

    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If

    AddUnsigned = lResult
End Function

Private Function Ch(x, y, z)
    Ch = ((x And y) Xor ((Not x) And z))
End Function

Private Function Maj(x, y, z)
    Maj = ((x And y) Xor (x And z) Xor (y And z))
End Function

Private Function S(x, n)
    S = (RShift(x, (n And m_lOnBits(4))) Or LShift(x, (32 - (n And   m_lOnBits(4)))))
End Function

Private Function R(x, n)
    R = RShift(x, cLng(n And m_lOnBits(4)))
End Function

Private Function Sigma0(x)
    Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))
End Function

Private Function Sigma1(x)
    Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))
End Function

Private Function Gamma0(x)
    Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))
End Function

Private Function Gamma1(x)
    Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))
End Function

Private Function ConvertToWordArray(sMessage)
    Dim lMessageLength, lNumberOfWords, lWordArray(), lBytePosition, lByteCount, lWordCount, lByte

    Const MODULUS_BITS = 512
    Const CONGRUENT_BITS = 448

    lMessageLength = Len(sMessage)

    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)

    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
        lWordCount = lByteCount \ BYTES_TO_A_WORD

        lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE

        lByte = AscB(Mid(sMessage, lByteCount + 1, 1))

        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
        lByteCount = lByteCount + 1
    Loop

    lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

    lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)

    ConvertToWordArray = lWordArray
End Function

Public Function SHA256(sMessage)
    Dim HASH(7), M, W(63), a, b, c, d, e, f, g, h, i, j, T1, T2

    HASH(0) = &H6A09E667
    HASH(1) = &HBB67AE85
    HASH(2) = &H3C6EF372
    HASH(3) = &HA54FF53A
    HASH(4) = &H510E527F
    HASH(5) = &H9B05688C
    HASH(6) = &H1F83D9AB
    HASH(7) = &H5BE0CD19

    M = ConvertToWordArray(sMessage)

    For i = 0 To UBound(M) Step 16
        a = HASH(0)
        b = HASH(1)
        c = HASH(2)
        d = HASH(3)
        e = HASH(4)
        f = HASH(5)
        g = HASH(6)
        h = HASH(7)

        For j = 0 To 63
           If j < 16 Then
              W(j) = M(j + i)
           Else
               W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))
           End If

           T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), Ch(e, f, g)), K(j)), W(j))
           T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))

           h = g
           g = f
           f = e
           e = AddUnsigned(d, T1)
           d = c
           c = b
           b = a
           a = AddUnsigned(T1, T2)
        Next

        HASH(0) = AddUnsigned(a, HASH(0))
        HASH(1) = AddUnsigned(b, HASH(1))
        HASH(2) = AddUnsigned(c, HASH(2))
        HASH(3) = AddUnsigned(d, HASH(3))
        HASH(4) = AddUnsigned(e, HASH(4))
        HASH(5) = AddUnsigned(f, HASH(5))
        HASH(6) = AddUnsigned(g, HASH(6))
        HASH(7) = AddUnsigned(h, HASH(7))
     Next

     SHA256 = LCase(Right("00000000" & Hex(HASH(0)), 8) & Right("00000000" & Hex(HASH(1)), 8) & Right("00000000" & Hex(HASH(2)), 8) & Right("00000000" & Hex(HASH(3)), 8) & Right("00000000" & Hex(HASH(4)), 8) & Right("00000000" & Hex(HASH(5)), 8) & Right("00000000" & Hex(HASH(6)), 8) & Right("00000000" & Hex(HASH(7)), 8))
End Function

Answer 3

The issue is because VBScript String is not a bytearray, so when you concat chr(0) you are adding 2 0 bytes to string.

Anyway VBScript is a nighmare for managing bytes and words, so I suggest you use a crypt javascript API that we have wrapped for ASP VBScript use.

You could get more details, and our contact info in this repository: https://github.com/ictmanagement/redsysHMAC256_API_ASP

A complete example:

<!-- #include file="./dvim_brix_crypto-js-master_VB.asp" -->

'/******  MAC Function ******/
'Input String|WordArray , Returns WordArray
Function mac256(ent, key) 
    Dim encWA
    Set encWA = ConvertUtf8StrToWordArray(ent)
    Dim keyWA
    Set keyWA = ConvertUtf8StrToWordArray(key)
    Dim resWA
    Set resWA = CryptoJS.HmacSHA256(encWA, keyWA)
    Set mac256 = resWA
End Function

'Input (Utf8)String|WordArray Returns WordArray
Function ConvertUtf8StrToWordArray(data)
    If (typename(data) = "String") Then
        Set ConvertUtf8StrToWordArray = CryptoJS.enc.Utf8.parse(data)
    Elseif (typename(data) = "JScriptTypeInfo") Then
        On error resume next
        'Set ConvertUtf8StrToWordArray = CryptoJS.enc.Utf8.parse(data.toString(CryptoJS.enc.Utf8)) 
        Set ConvertUtf8StrToWordArray = CryptoJS.lib.WordArray.create().concat(data) 'Just assert that data is WordArray
        If Err.number>0 Then
            Set ConvertUtf8StrToWordArray = Nothing
        End if
        On error goto 0
    Else
        Set ConvertUtf8StrToWordArray = Nothing
    End if
End Function

Dim test
test = "Hi guys"
key = "guyb u oisd qiu dqid qew" 'You could create a WordArray from Hex String, Utf8 String, etc.
Dim res
res = mac256(test,key) 'Result is a WordArray, so
Response.Write res.toString(CryptoJS.enc.Hex)