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 Wiki

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 "
" & s_prefix & a_data(n_index) & " - " & getHex(a_data(n_index)) & "
" & 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