asp-classic-unified-framework/core/lib.crypto.helper.asp

<%
'=======================================================================================================================
' Password hashing
'
' Pure VBScript SHA-256 - no external process, no shell-out, no COM crypto
' dependency. The previous implementation shelled out to a PowerShell script
' (hash_sha256.ps1, which did not exist anywhere in this repo) via
' WScript.Shell.Exec with the raw password concatenated directly into the
' command line. That was both non-functional (missing script) and a command
' injection vulnerability (a password containing ", `, ; etc. could execute
' arbitrary PowerShell, and the password was visible in the process command
' line to anything that could list processes).
'
' NOTE: This hashes without a per-user salt, matching the single-argument
' HashPassword(password) contract these functions already had. Unsalted
' hashes are vulnerable to precomputed/rainbow-table attacks. If a real
' Users table is introduced, prefer storing a random per-user salt alongside
' the hash and hashing (salt & password) - that is a schema change, so it is
' intentionally not done here.
'=======================================================================================================================

Private Function Sha256_U32(n)
    If n < 0 Then
        Sha256_U32 = n + 4294967296.0
    Else
        Sha256_U32 = CDbl(n)
    End If
End Function

Private Function Sha256_S32(d)
    Do While d >= 4294967296.0
        d = d - 4294967296.0
    Loop
    Do While d < 0
        d = d + 4294967296.0
    Loop
    If d >= 2147483648.0 Then
        Sha256_S32 = CLng(d - 4294967296.0)
    Else
        Sha256_S32 = CLng(d)
    End If
End Function

Private Function Sha256_Mod(x, y)
    Sha256_Mod = x - Int(x / y) * y
End Function

Private Function Sha256_Add32(a, b)
    Sha256_Add32 = Sha256_S32(Sha256_U32(a) + Sha256_U32(b))
End Function

Private Function Sha256_Add32_5(a, b, c, d, e)
    Sha256_Add32_5 = Sha256_S32(Sha256_U32(a) + Sha256_U32(b) + Sha256_U32(c) + Sha256_U32(d) + Sha256_U32(e))
End Function

Private Function Sha256_RotR32(x, n)
    Dim u, partA, keepBits, partB
    If n = 0 Then
        Sha256_RotR32 = x
        Exit Function
    End If
    u = Sha256_U32(x)
    partA = Int(u / (2 ^ n))
    keepBits = Sha256_Mod(u, 2 ^ n)
    partB = keepBits * (2 ^ (32 - n))
    Sha256_RotR32 = Sha256_S32(partA + partB)
End Function

Private Function Sha256_ShR32(x, n)
    Dim u
    u = Sha256_U32(x)
    Sha256_ShR32 = Sha256_S32(Int(u / (2 ^ n)))
End Function

Private Function Sha256_BytesToWord(b0, b1, b2, b3)
    Sha256_BytesToWord = Sha256_S32(b0 * 16777216.0 + b1 * 65536.0 + b2 * 256.0 + b3)
End Function

Private Function Sha256_HexWord(x)
    Dim u, h
    u = Sha256_U32(x)
    h = ""
    Do While u > 0
        h = Mid("0123456789abcdef", Sha256_Mod(u, 16) + 1, 1) & h
        u = Int(u / 16)
    Loop
    Sha256_HexWord = Right("00000000" & h, 8)
End Function

' Converts a VBScript string (UTF-16) to a UTF-8 byte array (Long values 0-255).
' Pure VBScript - avoids ADODB.Stream, which returns a Byte SafeArray that is
' not reliably indexable from VBScript on every 32/64-bit IIS configuration.
Private Function Sha256_StringToUtf8Bytes(s)
    Dim arr(), count, i, code, lenS
    lenS = Len(s)
    If lenS = 0 Then
        ReDim arr(-1)
        Sha256_StringToUtf8Bytes = arr
        Exit Function
    End If
    ReDim arr(lenS * 3)
    count = -1
    For i = 1 To lenS
        code = AscW(Mid(s, i, 1))
        If code < 0 Then code = code + 65536
        If code <= 127 Then
            count = count + 1 : arr(count) = code
        ElseIf code <= 2047 Then
            count = count + 1 : arr(count) = 192 Or Int(code / 64)
            count = count + 1 : arr(count) = 128 Or (code And 63)
        Else
            count = count + 1 : arr(count) = 224 Or Int(code / 4096)
            count = count + 1 : arr(count) = 128 Or (Int(code / 64) And 63)
            count = count + 1 : arr(count) = 128 Or (code And 63)
        End If
    Next
    ReDim Preserve arr(count)
    Sha256_StringToUtf8Bytes = arr
End Function

' Returns the SHA-256 hash of inputString (UTF-8 encoded) as a 64-character
' lowercase hex string. Verified against NIST/RFC test vectors (empty string,
' "abc", the 56-byte two-block vector, and non-ASCII input) plus .NET's
' System.Security.Cryptography.SHA256 as a cross-check.
Function Sha256Hex(inputString)
    Dim msg, msgLen, bitLen, i, t
    Dim numBlocks, blockIdx, base
    Dim hs(7)
    Dim k(63)
    Dim w(63)
    Dim a, b, c, d, e, f, g, h
    Dim s0, s1, ch, maj, temp1, temp2, bigS0, bigS1
    Dim padded()
    Dim padLen, totalLen, lenPos, hi32, lo32
    Dim kHex, result

    hs(0) = &h6a09e667 : hs(1) = &hbb67ae85 : hs(2) = &h3c6ef372 : hs(3) = &ha54ff53a
    hs(4) = &h510e527f : hs(5) = &h9b05688c : hs(6) = &h1f83d9ab : hs(7) = &h5be0cd19

    kHex = Array( _
        "428a2f98","71374491","b5c0fbcf","e9b5dba5","3956c25b","59f111f1","923f82a4","ab1c5ed5", _
        "d807aa98","12835b01","243185be","550c7dc3","72be5d74","80deb1fe","9bdc06a7","c19bf174", _
        "e49b69c1","efbe4786","0fc19dc6","240ca1cc","2de92c6f","4a7484aa","5cb0a9dc","76f988da", _
        "983e5152","a831c66d","b00327c8","bf597fc7","c6e00bf3","d5a79147","06ca6351","14292967", _
        "27b70a85","2e1b2138","4d2c6dfc","53380d13","650a7354","766a0abb","81c2c92e","92722c85", _
        "a2bfe8a1","a81a664b","c24b8b70","c76c51a3","d192e819","d6990624","f40e3585","106aa070", _
        "19a4c116","1e376c08","2748774c","34b0bcb5","391c0cb3","4ed8aa4a","5b9cca4f","682e6ff3", _
        "748f82ee","78a5636f","84c87814","8cc70208","90befffa","a4506ceb","bef9a3f7","c67178f2")
    For i = 0 To 63
        k(i) = Sha256_S32(CDbl("&h" & kHex(i)))
    Next

    msg = Sha256_StringToUtf8Bytes(inputString)
    If UBound(msg) < LBound(msg) Then
        msgLen = 0
    Else
        msgLen = UBound(msg) - LBound(msg) + 1
    End If
    bitLen = msgLen * 8.0

    ' Padding: msg + 0x80 + zero bytes so length % 64 = 56, then an 8-byte
    ' big-endian bit length.
    padLen = 56 - Sha256_Mod(msgLen + 1, 64)
    If padLen < 0 Then padLen = padLen + 64
    totalLen = msgLen + 1 + padLen + 8

    ReDim padded(totalLen - 1)
    For i = 0 To msgLen - 1
        padded(i) = msg(i)
    Next
    padded(msgLen) = 128
    For i = msgLen + 1 To msgLen + padLen
        padded(i) = 0
    Next

    lenPos = msgLen + 1 + padLen
    hi32 = Int(bitLen / 4294967296.0)
    lo32 = bitLen - hi32 * 4294967296.0
    padded(lenPos + 0) = Sha256_Mod(Int(hi32 / 16777216), 256)
    padded(lenPos + 1) = Sha256_Mod(Int(hi32 / 65536), 256)
    padded(lenPos + 2) = Sha256_Mod(Int(hi32 / 256), 256)
    padded(lenPos + 3) = Sha256_Mod(hi32, 256)
    padded(lenPos + 4) = Int(lo32 / 16777216)
    padded(lenPos + 5) = Sha256_Mod(Int(lo32 / 65536), 256)
    padded(lenPos + 6) = Sha256_Mod(Int(lo32 / 256), 256)
    padded(lenPos + 7) = Sha256_Mod(lo32, 256)

    numBlocks = totalLen / 64

    For blockIdx = 0 To numBlocks - 1
        base = blockIdx * 64
        For t = 0 To 15
            w(t) = Sha256_BytesToWord(padded(base + t*4), padded(base + t*4 + 1), padded(base + t*4 + 2), padded(base + t*4 + 3))
        Next
        For t = 16 To 63
            s0 = Sha256_RotR32(w(t-15), 7) Xor Sha256_RotR32(w(t-15), 18) Xor Sha256_ShR32(w(t-15), 3)
            s1 = Sha256_RotR32(w(t-2), 17) Xor Sha256_RotR32(w(t-2), 19) Xor Sha256_ShR32(w(t-2), 10)
            w(t) = Sha256_Add32_5(w(t-16), s0, w(t-7), s1, 0)
        Next

        a = hs(0) : b = hs(1) : c = hs(2) : d = hs(3)
        e = hs(4) : f = hs(5) : g = hs(6) : h = hs(7)

        For t = 0 To 63
            bigS1 = Sha256_RotR32(e,6) Xor Sha256_RotR32(e,11) Xor Sha256_RotR32(e,25)
            ch = (e And f) Xor ((Not e) And g)
            temp1 = Sha256_Add32_5(h, bigS1, ch, k(t), w(t))
            bigS0 = Sha256_RotR32(a,2) Xor Sha256_RotR32(a,13) Xor Sha256_RotR32(a,22)
            maj = (a And b) Xor (a And c) Xor (b And c)
            temp2 = Sha256_Add32(bigS0, maj)

            h = g
            g = f
            f = e
            e = Sha256_Add32(d, temp1)
            d = c
            c = b
            b = a
            a = Sha256_Add32(temp1, temp2)
        Next

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

    result = ""
    For i = 0 To 7
        result = result & Sha256_HexWord(hs(i))
    Next
    Sha256Hex = result
End Function

Function HashPassword(password)
    HashPassword = Sha256Hex(password)
End Function

'=======================================================================================================================
' CheckPassword
'
' The original implementation called CreateRepository(conn, "Users", "UserId")
' and Array("UserName", user) - "conn" and "CreateRepository" are not defined
' anywhere in this framework (no global "conn", no CreateRepository factory),
' and it searched using the not-yet-assigned "user" variable instead of the
' "username" parameter, so this function has never been callable. Nothing in
' this codebase calls it yet, and there is no Users table/migration either -
' this remains example/scaffold code. Rewritten here to use the framework's
' actual data-access primitive (DAL().Query with a parameterized command) and
' the correct lookup value, so it will work once a Users table exists with
' UserName and PasswordHash columns.
'=======================================================================================================================
Function CheckPassword(username, password)
    Dim rs
    Set rs = DAL().Query("SELECT PasswordHash FROM Users WHERE UserName = ?", Array(username))

    If rs.EOF Then
        CheckPassword = False
    Else
        CheckPassword = (HashPassword(password) = rs("PasswordHash"))
    End If

    rs.Close
    Set rs = Nothing
End Function
%>