Results 1 to 1 of 1

Thread: [VB6/VBA] X25519 for ECDH key exchange and Ed25519 for EdDSA signatures

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    [VB6/VBA] X25519 for ECDH key exchange and Ed25519 for EdDSA signatures

    This mdCurve25519.bas module implements X25519 key exchange and Ed25519 signatures in pure VB6.

    EdDSA signatures use SHA-512 hashes internally so you'll need mdSha512.bas from this thread included in your project and CRYPT_HAS_SHA512 = 1 declared in conditional compilation for the CryptoEd25519Sign and CryptoEd25519Open functions to use CryptoSha512 routine from there.

    Code:
    '--- mdCurve25519.bas
    Option Explicit
    DefObj A-Z
    
    #Const HasPtrSafe = (VBA7 <> 0) Or (TWINBASIC <> 0)
    #Const HasSha512 = (CRYPT_HAS_SHA512 <> 0)
    
    #If HasPtrSafe Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function RtlGenRandom Lib "advapi32" Alias "SystemFunction036" (RandomBuffer As Any, ByVal RandomBufferLength As Long) As Long
    #Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function VariantChangeType Lib "oleaut32" (Dest As Variant, Src As Variant, ByVal wFlags As Integer, ByVal vt As VbVarType) As Long
    Private Declare Function RtlGenRandom Lib "advapi32" Alias "SystemFunction036" (RandomBuffer As Any, ByVal RandomBufferLength As Long) As Long
    #End If
    
    Private Const LNG_ELEMSZ            As Long = 16
    Private Const LNG_KEYSZ             As Long = 32
    Private Const LNG_HASHSZ            As Long = 64 '--- SHA-512
    Private Const LNG_HALFHASHSZ        As Long = LNG_HASHSZ \ 2
    Private Const LNG_POW16             As Long = 2 ^ 16
    
    #If HasPtrSafe Then
        Private m_lZero             As LongLong
    #Else
        Private m_lZero             As Variant
    #End If
    Private LNG_POW2(0 To 7)        As Long
    Private EmptyByteArray()        As Byte
    Private m_gf0                   As GF25519Element
    Private m_gf1                   As GF25519Element
    Private m_gfD                   As GF25519Element
    Private m_gfD2                  As GF25519Element
    Private m_gfX                   As GF25519Element
    Private m_gfY                   As GF25519Element
    Private m_gfI                   As GF25519Element
    Private m_aL                    As ArrayLong64
    
    Private Type GF25519Element
    #If HasPtrSafe Then
        Item(0 To LNG_ELEMSZ - 1) As LongLong
    #Else
        Item(0 To LNG_ELEMSZ - 1) As Variant
    #End If
    End Type
    
    Private Type XyztPoint
        gfX                     As GF25519Element
        gfY                     As GF25519Element
        gfZ                     As GF25519Element
        gfT                     As GF25519Element
    End Type
    
    Private Type ArrayLong64
    #If HasPtrSafe Then
        Item(0 To 63)           As LongLong
    #Else
        Item(0 To 63)           As Variant
    #End If
    End Type
    
    #If Not HasPtrSafe Then
        Private Function CLngLng(vValue As Variant) As Variant
            Const VT_I8 As Long = &H14
            Call VariantChangeType(CLngLng, vValue, 0, VT_I8)
        End Function
    #End If
    
    Private Sub pvInit(Optional ByVal Extended As Boolean)
        Dim lIdx            As Long
        Dim vElem           As Variant
        
        If LNG_POW2(0) = 0 Then
            LNG_POW2(0) = 1
            For lIdx = 1 To UBound(LNG_POW2)
                LNG_POW2(lIdx) = LNG_POW2(lIdx - 1) * 2
            Next
            EmptyByteArray = vbNullString
            m_lZero = CLngLng(0)
        End If
        If m_gf1.Item(0) = 0 And Extended Then
            pvGF25519Assign m_gf0, "0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0"
            pvGF25519Assign m_gf1, "1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0"
            pvGF25519Assign m_gfD, "78A3 1359 4DCA 75EB D8AB 4141 0A4D 0070 E898 7779 4079 8CC7 FE73 2B6F 6CEE 5203"
            pvGF25519Assign m_gfD2, "F159 26B2 9B94 EBD6 B156 8283 149A 00E0 D130 EEF3 80F2 198E FCE7 56DF D9DC 2406"
            pvGF25519Assign m_gfX, "D51A 8F25 2D60 C956 A7B2 9525 C760 692C DC5C FDD6 E231 C0A4 53FE CD6E 36D3 2169"
            pvGF25519Assign m_gfY, "6658 6666 6666 6666 6666 6666 6666 6666 6666 6666 6666 6666 6666 6666 6666 6666"
            pvGF25519Assign m_gfI, "A0B0 4A0E 1B27 C4EE E478 AD2F 1806 2F43 D7A7 3DFB 0099 2B4D DF0B 4FC1 2480 2B83"
            lIdx = 0
            For Each vElem In Split("ED D3 F5 5C 1A 63 12 58 D6 9C F7 A2 DE F9 DE 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10")
                m_aL.Item(lIdx) = CLngLng(CStr("&H" & vElem))
                lIdx = lIdx + 1
            Next
        End If
    End Sub
    
    Private Sub pvGF25519Sel(uA As GF25519Element, uB As GF25519Element, ByVal bSwap As Boolean)
        Dim lIdx            As Long
    #If HasPtrSafe Then
        Dim lTemp           As LongLong
    #Else
        Dim lTemp           As Variant
    #End If
        
        For lIdx = 0 To LNG_ELEMSZ - 1
            lTemp = (uA.Item(lIdx) Xor uB.Item(lIdx)) And bSwap
            uA.Item(lIdx) = uA.Item(lIdx) Xor lTemp
            uB.Item(lIdx) = uB.Item(lIdx) Xor lTemp
        Next
    End Sub
    
    Private Sub pvGF25519Car(uRetVal As GF25519Element)
        Dim lIdx            As Long
        Dim lNext           As Long
    #If HasPtrSafe Then
        Dim lCarry          As LongLong
    #Else
        Dim lCarry          As Variant
    #End If
        
        For lIdx = 0 To LNG_ELEMSZ - 1
            uRetVal.Item(lIdx) = uRetVal.Item(lIdx) + LNG_POW16
            lCarry = (uRetVal.Item(lIdx) And -LNG_POW16) \ LNG_POW16
            uRetVal.Item(lIdx) = uRetVal.Item(lIdx) - lCarry * LNG_POW16
            If lIdx = LNG_ELEMSZ - 1 Then
                lCarry = 38 * (lCarry - 1)
            Else
                lCarry = lCarry - 1
            End If
            lNext = (lIdx + 1) Mod LNG_ELEMSZ
            uRetVal.Item(lNext) = uRetVal.Item(lNext) + lCarry
        Next
    End Sub
    
    Private Sub pvGF25519Add(uRetVal As GF25519Element, uA As GF25519Element, uB As GF25519Element)
        Dim lIdx            As Long
        
        For lIdx = 0 To LNG_ELEMSZ - 1
            uRetVal.Item(lIdx) = uA.Item(lIdx) + uB.Item(lIdx)
        Next
    End Sub
    
    Private Sub pvGF25519Sub(uRetVal As GF25519Element, uA As GF25519Element, uB As GF25519Element)
        Dim lIdx            As Long
        
        For lIdx = 0 To LNG_ELEMSZ - 1
            uRetVal.Item(lIdx) = uA.Item(lIdx) - uB.Item(lIdx)
        Next
    End Sub
    
    Private Sub pvGF25519Mul(uRetVal As GF25519Element, uA As GF25519Element, uB As GF25519Element)
    #If HasPtrSafe Then
        Static aTemp(0 To LNG_ELEMSZ * 2 - 1) As LongLong
    #Else
        Static aTemp(0 To LNG_ELEMSZ * 2 - 1) As Variant
    #End If
        Dim lIdx            As Long
        Dim lJdx            As Long
        
        For lIdx = 0 To UBound(aTemp)
            aTemp(lIdx) = CLng(0)
        Next
        For lIdx = 0 To LNG_ELEMSZ - 1
            For lJdx = 0 To LNG_ELEMSZ - 1
                aTemp(lIdx + lJdx) = aTemp(lIdx + lJdx) + uA.Item(lIdx) * uB.Item(lJdx)
            Next
        Next
        For lIdx = 0 To LNG_ELEMSZ - 1
            If lIdx < LNG_ELEMSZ - 1 Then
                uRetVal.Item(lIdx) = aTemp(lIdx) + 38 * aTemp(lIdx + LNG_ELEMSZ)
            Else
                uRetVal.Item(lIdx) = aTemp(lIdx)
            End If
        Next
        pvGF25519Car uRetVal
        pvGF25519Car uRetVal
    End Sub
    
    Private Sub pvGF25519Sqr(uRetVal As GF25519Element, uA As GF25519Element)
        pvGF25519Mul uRetVal, uA, uA
    End Sub
    
    Private Sub pvGF25519Inv(uRetVal As GF25519Element, uA As GF25519Element)
        Dim uTemp           As GF25519Element
        Dim lIdx            As Long
        
        uTemp = uA
        For lIdx = 253 To 0 Step -1
            pvGF25519Mul uTemp, uTemp, uTemp
            If lIdx <> 2 And lIdx <> 4 Then
                pvGF25519Mul uTemp, uTemp, uA
            End If
        Next
        uRetVal = uTemp
    End Sub
    
    Private Sub pvGF25519Pow2523(uRetVal As GF25519Element, uA As GF25519Element)
        Dim uTemp           As GF25519Element
        Dim lIdx            As Long
        
        uTemp = uA
        For lIdx = 250 To 0 Step -1
            pvGF25519Sqr uTemp, uTemp
            If lIdx <> 1 Then
                pvGF25519Mul uTemp, uTemp, uA
            End If
        Next
        uRetVal = uTemp
    End Sub
    
    Private Function pvGF25519Neq(uA As GF25519Element, uB As GF25519Element) As Boolean
        Dim baA()           As Byte
        Dim baB()           As Byte
        Dim lIdx            As Long
        Dim lAccum            As Long
        
        pvGF25519Pack baA, uA
        pvGF25519Pack baB, uB
        For lIdx = 0 To UBound(baA)
            lAccum = lAccum Or (baA(lIdx) Xor baB(lIdx))
        Next
        pvGF25519Neq = lAccum <> 0
    End Function
    
    Private Sub pvGF25519Unpack(uRetVal As GF25519Element, baInput() As Byte)
        Dim aTemp(0 To LNG_ELEMSZ - 1) As Integer
        Dim lIdx            As Long
    
        If UBound(baInput) >= 0 Then
            Debug.Assert (UBound(aTemp) + 1) * 2 >= UBound(baInput) + 1
            Call CopyMemory(aTemp(0), baInput(0), UBound(baInput) + 1)
        End If
        For lIdx = 0 To LNG_ELEMSZ - 1
            If aTemp(lIdx) < 0 Then
                uRetVal.Item(lIdx) = m_lZero + LNG_POW16 + aTemp(lIdx)
            Else
                uRetVal.Item(lIdx) = m_lZero + aTemp(lIdx)
            End If
        Next
    End Sub
    
    Private Sub pvGF25519Pack(baRetVal() As Byte, uA As GF25519Element)
        Dim lRetry          As Long
        Dim lIdx            As Long
        Dim uTemp           As GF25519Element
        Dim lFlag           As Long
        
        ReDim baRetVal(0 To LNG_KEYSZ - 1) As Byte
        For lRetry = 0 To 1
            uTemp.Item(0) = uA.Item(0) - &HFFED&
            For lIdx = 1 To LNG_ELEMSZ - 1
                lFlag = -((uTemp.Item(lIdx - 1) And LNG_POW16) <> 0)
                If lIdx = LNG_ELEMSZ - 1 Then
                    lFlag = &H7FFF& + lFlag
                Else
                    lFlag = &HFFFF& + lFlag
                End If
                uTemp.Item(lIdx) = uA.Item(lIdx) - lFlag
                uTemp.Item(lIdx - 1) = uTemp.Item(lIdx - 1) And &HFFFF&
            Next
            lFlag = -((uTemp.Item(LNG_ELEMSZ - 1) And LNG_POW16) <> 0)
            pvGF25519Sel uA, uTemp, lFlag = 0
        Next
        For lIdx = 0 To LNG_ELEMSZ - 1
            lFlag = CLng(uA.Item(lIdx) And LNG_POW16 - 1)
            Call CopyMemory(baRetVal(2 * lIdx), lFlag, 2)
        Next
    End Sub
    
    Private Sub pvGF25519Clamp(baPriv() As Byte)
        baPriv(0) = baPriv(0) And &HF8
        baPriv(31) = baPriv(31) And &H7F Or &H40
    End Sub
    
    Private Sub pvGF25519Assign(uRetVal As GF25519Element, sText As String)
        Dim vElem           As Variant
        Dim lIdx            As Long
    
        For Each vElem In Split(sText)
            uRetVal.Item(lIdx) = CLngLng(CStr("&H" & vElem))
            lIdx = lIdx + 1
        Next
    End Sub
    
    Private Sub pvGF25519ScalarMult(baRetVal() As Byte, baPriv() As Byte, baPub() As Byte)
        Dim baKey()         As Byte
        Dim uX              As GF25519Element
        Dim uA              As GF25519Element
        Dim uB              As GF25519Element
        Dim uC              As GF25519Element
        Dim uD              As GF25519Element
        Dim uE              As GF25519Element
        Dim uF              As GF25519Element
        Dim uG              As GF25519Element
        Dim lIdx            As Long
        Dim lFlag           As Long
        Dim lPrev           As Long
        
        baKey = baPriv
        pvGF25519Clamp baKey
        pvGF25519Unpack uA, EmptyByteArray
        pvGF25519Unpack uX, baPub
        uB = uX
        uC = uA
        uD = uA
        uG = uA
        uG.Item(0) = uG.Item(0) + &HDB41&
        uG.Item(1) = uG.Item(1) + 1
        uA.Item(0) = uG.Item(1)         ' a[0] = 1
        uD.Item(0) = uG.Item(1)         ' d[0] = 1
        
        For lIdx = 254 To 0 Step -1
            lPrev = lFlag
            lFlag = (baKey(lIdx \ 8) \ LNG_POW2(lIdx And 7)) And 1
            pvGF25519Sel uA, uB, lFlag Xor lPrev
            pvGF25519Sel uC, uD, lFlag Xor lPrev
            pvGF25519Add uE, uA, uC  ' e = a + c
            pvGF25519Sub uA, uA, uC  ' a = a - c
            pvGF25519Add uC, uB, uD  ' c = b + d
            pvGF25519Sub uB, uB, uD  ' b = b - d
            pvGF25519Mul uD, uE, uE  ' d = e * e
            pvGF25519Mul uF, uA, uA  ' f = a * a
            pvGF25519Mul uA, uC, uA  ' a = c * a
            pvGF25519Mul uC, uB, uE  ' c = b * e
            pvGF25519Add uE, uA, uC  ' e = a + c
            pvGF25519Sub uA, uA, uC  ' a = a - c
            pvGF25519Mul uB, uA, uA  ' b = a * a
            pvGF25519Sub uC, uD, uF  ' c = d - f
            pvGF25519Mul uA, uC, uG  ' a = c * g
            pvGF25519Add uA, uA, uD  ' a = a + d
            pvGF25519Mul uC, uC, uA  ' c = c * a
            pvGF25519Mul uA, uD, uF  ' a = d * f
            pvGF25519Mul uD, uB, uX  ' d = b * x
            pvGF25519Mul uB, uE, uE  ' b = e * e
        Next
        pvGF25519Inv uC, uC
        pvGF25519Mul uX, uA, uC
        pvGF25519Pack baRetVal, uX
    End Sub
    
    Private Sub pvGF25519ScalarBase(baRetVal() As Byte, baPriv() As Byte)
        Dim baBase(0 To LNG_KEYSZ - 1) As Byte
        
        baBase(0) = 9
        pvGF25519ScalarMult baRetVal, baPriv, baBase
    End Sub
    
    Public Sub CryptoX25519PrivateKey(baRetVal() As Byte, Optional Seed As Variant)
        If Not IsMissing(Seed) Then
            baRetVal = Seed
            ReDim Preserve baRetVal(0 To LNG_KEYSZ - 1) As Byte
        Else
            ReDim baRetVal(0 To LNG_KEYSZ - 1) As Byte
            Call RtlGenRandom(baRetVal(0), UBound(baRetVal) + 1)
        End If
        pvGF25519Clamp baRetVal
    End Sub
    
    Public Sub CryptoX25519PublicKey(baRetVal() As Byte, baPriv() As Byte)
        pvInit
        pvGF25519ScalarBase baRetVal, baPriv
    End Sub
    
    Public Sub CryptoX25519SharedSecret(baRetVal() As Byte, baPriv() As Byte, baPub() As Byte)
        pvInit
        pvGF25519ScalarMult baRetVal, baPriv, baPub
    End Sub
    
    '= XyztPoint =============================================================
    
    Private Sub pvEdwardsAdd(uP As XyztPoint, uQ As XyztPoint)
        Dim gfA             As GF25519Element
        Dim gfB             As GF25519Element
        Dim gfC             As GF25519Element
        Dim gfD             As GF25519Element
        Dim gfE             As GF25519Element
        Dim gfF             As GF25519Element
        Dim gfG             As GF25519Element
        Dim gfH             As GF25519Element
        Dim gfT             As GF25519Element
        
        pvGF25519Sub gfA, uP.gfY, uP.gfX
        pvGF25519Sub gfT, uQ.gfY, uQ.gfX
        pvGF25519Mul gfA, gfA, gfT
        pvGF25519Add gfB, uP.gfX, uP.gfY
        pvGF25519Add gfT, uQ.gfX, uQ.gfY
        pvGF25519Mul gfB, gfB, gfT
        pvGF25519Mul gfC, uP.gfT, uQ.gfT
        pvGF25519Mul gfC, gfC, m_gfD2
        pvGF25519Mul gfD, uP.gfZ, uQ.gfZ
        pvGF25519Add gfD, gfD, gfD
        pvGF25519Sub gfE, gfB, gfA
        pvGF25519Sub gfF, gfD, gfC
        pvGF25519Add gfG, gfD, gfC
        pvGF25519Add gfH, gfB, gfA
        pvGF25519Mul uP.gfX, gfE, gfF
        pvGF25519Mul uP.gfY, gfH, gfG
        pvGF25519Mul uP.gfZ, gfG, gfF
        pvGF25519Mul uP.gfT, gfE, gfH
    End Sub
    
    Private Sub pvEdwardsCSwap(uP As XyztPoint, uQ As XyztPoint, ByVal bSwap As Boolean)
        pvGF25519Sel uP.gfX, uQ.gfX, bSwap
        pvGF25519Sel uP.gfY, uQ.gfY, bSwap
        pvGF25519Sel uP.gfZ, uQ.gfZ, bSwap
        pvGF25519Sel uP.gfT, uQ.gfT, bSwap
    End Sub
    
    Private Sub pvEdwardsPack(baRetVal() As Byte, ByVal lOutPos As Long, uP As XyztPoint)
        Dim gfTx            As GF25519Element
        Dim gfTy            As GF25519Element
        Dim gfZi            As GF25519Element
        Dim baTemp()        As Byte
        
        pvGF25519Inv gfZi, uP.gfZ
        pvGF25519Mul gfTx, uP.gfX, gfZi
        pvGF25519Mul gfTy, uP.gfY, gfZi
        pvGF25519Pack baTemp, gfTy
        Debug.Assert UBound(baRetVal) + 1 >= lOutPos + LNG_KEYSZ
        Call CopyMemory(baRetVal(lOutPos), baTemp(0), LNG_KEYSZ)
        pvGF25519Pack baTemp, gfTx
        lOutPos = lOutPos + LNG_KEYSZ - 1
        baRetVal(lOutPos) = baRetVal(lOutPos) Xor ((baTemp(0) And 1) * &H80)
    End Sub
    
    Private Sub pvEdwardsScalarMult(uP As XyztPoint, uQ As XyztPoint, baKey() As Byte, Optional ByVal lPos As Long)
        Dim lIdx            As Long
        Dim lFlag           As Long
        
        pvInit Extended:=True
        uP.gfX = m_gf0
        uP.gfY = m_gf1
        uP.gfZ = m_gf1
        uP.gfT = m_gf0
        For lIdx = 255 To 0 Step -1
            lFlag = (baKey(lPos + lIdx \ 8) \ LNG_POW2(lIdx And 7)) And 1
            pvEdwardsCSwap uP, uQ, lFlag
            pvEdwardsAdd uQ, uP
            pvEdwardsAdd uP, uP
            pvEdwardsCSwap uP, uQ, lFlag
        Next
    End Sub
    
    Private Sub pvEdwardsScalarBase(uP As XyztPoint, baKey() As Byte, Optional ByVal lPos As Long)
        Dim uQ              As XyztPoint
        
        uQ.gfX = m_gfX
        uQ.gfY = m_gfY
        uQ.gfZ = m_gf1
        pvGF25519Mul uQ.gfT, m_gfX, m_gfY
        pvEdwardsScalarMult uP, uQ, baKey, lPos
    End Sub
    
    Private Sub pvEdwardsModL(baRetVal() As Byte, ByVal lOutPos As Long, aX As ArrayLong64)
    #If HasPtrSafe Then
        Dim lCarry          As LongLong
    #Else
        Dim lCarry          As Variant
    #End If
        Dim lIdx            As Long
        Dim lJdx            As Long
        
        For lIdx = 63 To 32 Step -1
            lCarry = m_lZero
            For lJdx = lIdx - 32 To lIdx - 13
                aX.Item(lJdx) = aX.Item(lJdx) + lCarry - 16 * aX.Item(lIdx) * m_aL.Item(lJdx - (lIdx - 32))
                lCarry = (aX.Item(lJdx) + 128 And -&H100) \ &H100
                aX.Item(lJdx) = aX.Item(lJdx) - lCarry * &H100
            Next
            aX.Item(lJdx) = aX.Item(lJdx) + lCarry
            aX.Item(lIdx) = 0
        Next
        lCarry = 0
        For lJdx = 0 To 31
            aX.Item(lJdx) = aX.Item(lJdx) + lCarry - ((aX.Item(31) And -&H10) \ &H10) * m_aL.Item(lJdx)
            lCarry = (aX.Item(lJdx) And -&H100) \ &H100
            aX.Item(lJdx) = aX.Item(lJdx) And &HFF
        Next
        For lJdx = 0 To 31
            aX.Item(lJdx) = aX.Item(lJdx) - lCarry * m_aL.Item(lJdx)
        Next
        For lIdx = 0 To 31
            aX.Item(lIdx + 1) = aX.Item(lIdx + 1) + ((aX.Item(lIdx) And -&H100) \ &H100)
            baRetVal(lOutPos + lIdx) = CByte(aX.Item(lIdx) And &HFF)
        Next
    End Sub
    
    Private Sub pvEdwardsReduce(baRetVal() As Byte)
        Dim aX              As ArrayLong64
        Dim lIdx            As Long
        
        For lIdx = 0 To 63
            aX.Item(lIdx) = m_lZero + baRetVal(lIdx)
            baRetVal(lIdx) = 0
        Next
        pvEdwardsModL baRetVal, 0, aX
    End Sub
    
    Private Function pvEdwardsUnpackNeg(uR As XyztPoint, baKey() As Byte) As Boolean
        Dim gfT             As GF25519Element
        Dim gfChk           As GF25519Element
        Dim gfNum           As GF25519Element
        Dim gfDen           As GF25519Element
        Dim gfDen2          As GF25519Element
        Dim gfDen4          As GF25519Element
        Dim gfDen6          As GF25519Element
        Dim baTemp()        As Byte
        
        uR.gfZ = m_gf1
        pvGF25519Unpack uR.gfY, baKey
        pvGF25519Sqr gfNum, uR.gfY
        pvGF25519Mul gfDen, gfNum, m_gfD
        pvGF25519Sub gfNum, gfNum, m_gf1
        pvGF25519Add gfDen, gfDen, m_gf1
        pvGF25519Sqr gfDen2, gfDen
        pvGF25519Sqr gfDen4, gfDen2
        pvGF25519Mul gfDen6, gfDen4, gfDen2
        pvGF25519Mul gfT, gfDen6, gfNum
        pvGF25519Mul gfT, gfT, gfDen
        pvGF25519Pow2523 gfT, gfT
        pvGF25519Mul gfT, gfT, gfNum
        pvGF25519Mul gfT, gfT, gfDen
        pvGF25519Mul gfT, gfT, gfDen
        pvGF25519Mul uR.gfX, gfT, gfDen
        pvGF25519Sqr gfChk, uR.gfX
        pvGF25519Mul gfChk, gfChk, gfDen
        If pvGF25519Neq(gfChk, gfNum) Then
            pvGF25519Mul uR.gfX, uR.gfX, m_gfI
        End If
        pvGF25519Sqr gfChk, uR.gfX
        pvGF25519Mul gfChk, gfChk, gfDen
        If pvGF25519Neq(gfChk, gfNum) Then
            GoTo QH
        End If
        pvGF25519Pack baTemp, uR.gfX
        If (baTemp(0) And 1) = (baKey(31) \ &H80) Then
            pvGF25519Sub uR.gfX, m_gf0, uR.gfX '-- X = -X
        End If
        pvGF25519Mul uR.gfT, uR.gfX, uR.gfY
        '--- success
        pvEdwardsUnpackNeg = True
    QH:
    End Function
    
    Private Function pvEdwardsHash(baOutput() As Byte, baInput() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1)
        #If HasSha512 Then
            CryptoSha512 512, baOutput, baInput, Pos, Size
            Debug.Assert UBound(baOutput) + 1 >= LNG_HASHSZ
        #Else
            Err.Raise vbObjectError, , "SHA-512 not compiled (use CRYPT_HAS_SHA512 = 1)"
        #End If
    End Function
    
    Public Sub pvEdwardsPublicKey(baRetVal() As Byte, ByVal lOutPos As Long, baPriv() As Byte)
        Dim baD()           As Byte
        Dim uP              As XyztPoint
        
        pvEdwardsHash baD, baPriv
        pvGF25519Clamp baD
        pvEdwardsScalarBase uP, baD
        pvEdwardsPack baRetVal, lOutPos, uP
    End Sub
    
    Public Sub CryptoEd25519PrivateKey(baRetVal() As Byte, Optional Seed As Variant)
        If Not IsMissing(Seed) Then
            baRetVal = Seed
            ReDim Preserve baRetVal(0 To LNG_KEYSZ - 1) As Byte
        Else
            ReDim baRetVal(0 To LNG_KEYSZ - 1) As Byte
            Call RtlGenRandom(baRetVal(0), UBound(baRetVal) + 1)
        End If
    End Sub
    
    Public Sub CryptoEd25519PublicKey(baRetVal() As Byte, baPriv() As Byte)
        Debug.Assert UBound(baPriv) + 1 >= LNG_KEYSZ
        pvInit Extended:=True
        ReDim baRetVal(0 To LNG_KEYSZ - 1) As Byte
        pvEdwardsPublicKey baRetVal, 0, baPriv
    End Sub
    
    Public Sub CryptoEd25519Sign(baRetVal() As Byte, baPriv() As Byte, baMsg() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1)
        Dim baDelta()       As Byte
        Dim baHash()        As Byte
        Dim baR()           As Byte
        Dim uP              As XyztPoint
        Dim aX              As ArrayLong64
        Dim lIdx            As Long
        Dim lJdx            As Long
        
        Debug.Assert UBound(baPriv) + 1 >= LNG_KEYSZ
        pvInit Extended:=True
        pvEdwardsHash baDelta, baPriv
        pvGF25519Clamp baDelta
        If Size < 0 Then
            Size = UBound(baMsg) + 1 - Pos
        End If
        ReDim baRetVal(0 To LNG_HASHSZ + Size - 1) As Byte
        Call CopyMemory(baRetVal(LNG_HALFHASHSZ), baDelta(LNG_HALFHASHSZ), LNG_HALFHASHSZ)
        If Size > 0 Then
            Call CopyMemory(baRetVal(LNG_HASHSZ), baMsg(Pos), Size)
        End If
        pvEdwardsHash baR, baRetVal, Pos:=LNG_HALFHASHSZ
        pvEdwardsReduce baR
        pvEdwardsScalarBase uP, baR
        pvEdwardsPack baRetVal, 0, uP
        pvEdwardsPublicKey baRetVal, LNG_HALFHASHSZ, baPriv
        pvEdwardsHash baHash, baRetVal
        pvEdwardsReduce baHash
        For lIdx = 0 To LNG_HALFHASHSZ - 1
            aX.Item(lIdx) = baR(lIdx)
        Next
        For lIdx = 0 To LNG_HALFHASHSZ - 1
            For lJdx = 0 To LNG_HALFHASHSZ - 1
                aX.Item(lIdx + lJdx) = aX.Item(lIdx + lJdx) + (m_lZero + baHash(lIdx)) * baDelta(lJdx)
            Next
        Next
        pvEdwardsModL baRetVal, LNG_HALFHASHSZ, aX
    End Sub
    
    Public Function CryptoEd25519Open(baRetVal() As Byte, baPub() As Byte, baSigMsg() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1) As Boolean
        Dim uP              As XyztPoint
        Dim uQ              As XyztPoint
        Dim baHash()        As Byte
        Dim baTemp(0 To LNG_KEYSZ - 1) As Byte
        Dim lIdx            As Long
        
        Debug.Assert UBound(baPub) + 1 >= LNG_KEYSZ
        pvInit Extended:=True
        If Size < 0 Then
            Size = UBound(baSigMsg) + 1 - Pos
        End If
        If Size < LNG_HASHSZ Then
            GoTo QH
        End If
        If Not pvEdwardsUnpackNeg(uQ, baPub) Then
            GoTo QH
        End If
        ReDim baRetVal(0 To Size - 1) As Byte
        Debug.Assert UBound(baSigMsg) + 1 >= Pos + Size
        Call CopyMemory(baRetVal(0), baSigMsg(Pos), Size)
        Call CopyMemory(baRetVal(LNG_HALFHASHSZ), baPub(0), LNG_HALFHASHSZ)
        pvEdwardsHash baHash, baRetVal
        pvEdwardsReduce baHash
        pvEdwardsScalarMult uP, uQ, baHash
        pvEdwardsScalarBase uQ, baSigMsg, LNG_HALFHASHSZ
        pvEdwardsAdd uP, uQ
        pvEdwardsPack baTemp, 0, uP
        For lIdx = 0 To LNG_HALFHASHSZ - 1
            If baTemp(lIdx) <> baSigMsg(lIdx) Then
                GoTo QH
            End If
        Next
        If UBound(baSigMsg) + 1 > LNG_HASHSZ Then
            ReDim baRetVal(0 To UBound(baSigMsg) - LNG_HASHSZ) As Byte
            Call CopyMemory(baRetVal(0), baSigMsg(LNG_HASHSZ), UBound(baRetVal) + 1)
        Else
            baRetVal = vbNullString
        End If
        '--- success
        CryptoEd25519Open = True
    QH:
    End Function
    
    Public Sub CryptoEd25519SignDetached(baRetVal() As Byte, baPriv() As Byte, baMsg() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1)
        CryptoEd25519Sign baRetVal, baPriv, baMsg, Pos, Size
        ReDim Preserve baRetVal(0 To LNG_HASHSZ - 1) As Byte
    End Sub
    
    Public Function CryptoEd25519VerifyDetached(baSig() As Byte, baPub() As Byte, baMsg() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1) As Boolean
        Dim baSigMsg()          As Byte
        Dim baTemp()            As Byte
        
        If UBound(baSig) + 1 < LNG_HASHSZ Then
            GoTo QH
        End If
        If Size < 0 Then
            Size = UBound(baMsg) + 1 - Pos
        End If
        ReDim baSigMsg(0 To LNG_HASHSZ + UBound(baMsg)) As Byte
        Call CopyMemory(baSigMsg(0), baSig(0), LNG_HASHSZ)
        If UBound(baMsg) >= 0 Then
            Call CopyMemory(baSigMsg(LNG_HASHSZ), baMsg(0), UBound(baMsg) + 1)
        End If
        CryptoEd25519VerifyDetached = CryptoEd25519Open(baTemp, baPub, baSigMsg)
    QH:
    End Function
    cheers,
    </wqw>

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width