This mdScryptKdf.bas implements scrypt password-based key derivation function as described in RFC 7914.
This module depends on mdSha2.bas for its PBKDF2-HMAC-SHA2 implementation (calls CryptoPbkdf2HmacSha2ByteArray).
The only public CryptoScryptKdfByteArray function uses moderately sized optional parameters for CPU and memory cost so these should be increased to be relevant to modern hardware.
cheers,
</wqw>
This module depends on mdSha2.bas for its PBKDF2-HMAC-SHA2 implementation (calls CryptoPbkdf2HmacSha2ByteArray).
Code:
'--- mdScryptKdf.bas
Option Explicit
DefObj A-Z
#Const HasPtrSafe = (VBA7 <> 0)
#Const HasOperators = (TWINBASIC <> 0)
#If HasPtrSafe Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Enum LongPtr
[_]
End Enum
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#End If
Private Type ArrayLong16
Item(0 To 15) As Long
End Type
#If Not HasOperators Then
Private LNG_POW2(0 To 31) As Long
Private Function RotL32(ByVal lX As Long, ByVal lN As Long) As Long
'--- RotL32 = LShift(X, n) Or RShift(X, 32 - n)
Debug.Assert lN <> 0
RotL32 = ((lX And (LNG_POW2(31 - lN) - 1)) * LNG_POW2(lN) Or -((lX And LNG_POW2(31 - lN)) <> 0) * LNG_POW2(31)) Or _
((lX And (LNG_POW2(31) Xor -1)) \ LNG_POW2(32 - lN) Or -(lX < 0) * LNG_POW2(lN - 1))
End Function
Private Function UAdd32(ByVal lX As Long, ByVal lY As Long) As Long
If (lX Xor lY) >= 0 Then
UAdd32 = ((lX Xor &H80000000) + lY) Xor &H80000000
Else
UAdd32 = lX + lY
End If
End Function
Private Sub Op32(X As ArrayLong16, ByVal lIdx As Long, ByVal lA As Long, ByVal lB As Long, ByVal lShift As Long)
X.Item(lIdx) = X.Item(lIdx) Xor RotL32(UAdd32(X.Item(lA), X.Item(lB)), lShift)
End Sub
#End If
#If HasOperators Then
[ IntegerOverflowChecks (False) ]
#End If
Private Sub pvSalsa20Core(B() As Byte)
Dim B32 As ArrayLong16
Dim X As ArrayLong16
Dim lIdx As Long
Debug.Assert UBound(B) + 1 >= 64
Call CopyMemory(B32, B(0), 64)
X = B32
For lIdx = 0 To 3
#If HasOperators Then
Dim lTemp As Long
With X
lTemp = .Item(0) + .Item(12): .Item(4) = .Item(4) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(4) + .Item(0): .Item(8) = .Item(8) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(8) + .Item(4): .Item(12) = .Item(12) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(12) + .Item(8): .Item(0) = .Item(0) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(5) + .Item(1): .Item(9) = .Item(9) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(9) + .Item(5): .Item(13) = .Item(13) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(13) + .Item(9): .Item(1) = .Item(1) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(1) + .Item(13): .Item(5) = .Item(5) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(10) + .Item(6): .Item(14) = .Item(14) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(14) + .Item(10): .Item(2) = .Item(2) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(2) + .Item(14): .Item(6) = .Item(6) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(6) + .Item(2): .Item(10) = .Item(10) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(15) + .Item(11): .Item(3) = .Item(3) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(3) + .Item(15): .Item(7) = .Item(7) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(7) + .Item(3): .Item(11) = .Item(11) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(11) + .Item(7): .Item(15) = .Item(15) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(0) + .Item(3): .Item(1) = .Item(1) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(1) + .Item(0): .Item(2) = .Item(2) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(2) + .Item(1): .Item(3) = .Item(3) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(3) + .Item(2): .Item(0) = .Item(0) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(5) + .Item(4): .Item(6) = .Item(6) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(6) + .Item(5): .Item(7) = .Item(7) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(7) + .Item(6): .Item(4) = .Item(4) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(4) + .Item(7): .Item(5) = .Item(5) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(10) + .Item(9): .Item(11) = .Item(11) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(11) + .Item(10): .Item(8) = .Item(8) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(8) + .Item(11): .Item(9) = .Item(9) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(9) + .Item(8): .Item(10) = .Item(10) Xor (lTemp << 18 Or lTemp >> 14)
lTemp = .Item(15) + .Item(14): .Item(12) = .Item(12) Xor (lTemp << 7 Or lTemp >> 25)
lTemp = .Item(12) + .Item(15): .Item(13) = .Item(13) Xor (lTemp << 9 Or lTemp >> 23)
lTemp = .Item(13) + .Item(12): .Item(14) = .Item(14) Xor (lTemp << 13 Or lTemp >> 19)
lTemp = .Item(14) + .Item(13): .Item(15) = .Item(15) Xor (lTemp << 18 Or lTemp >> 14)
End With
#Else
'--- Operate on columns
Op32 X, 4, 0, 12, 7: Op32 X, 8, 4, 0, 9
Op32 X, 12, 8, 4, 13: Op32 X, 0, 12, 8, 18
Op32 X, 9, 5, 1, 7: Op32 X, 13, 9, 5, 9
Op32 X, 1, 13, 9, 13: Op32 X, 5, 1, 13, 18
Op32 X, 14, 10, 6, 7: Op32 X, 2, 14, 10, 9
Op32 X, 6, 2, 14, 13: Op32 X, 10, 6, 2, 18
Op32 X, 3, 15, 11, 7: Op32 X, 7, 3, 15, 9
Op32 X, 11, 7, 3, 13: Op32 X, 15, 11, 7, 18
'--- Operate on rows
Op32 X, 1, 0, 3, 7: Op32 X, 2, 1, 0, 9
Op32 X, 3, 2, 1, 13: Op32 X, 0, 3, 2, 18
Op32 X, 6, 5, 4, 7: Op32 X, 7, 6, 5, 9
Op32 X, 4, 7, 6, 13: Op32 X, 5, 4, 7, 18
Op32 X, 11, 10, 9, 7: Op32 X, 8, 11, 10, 9
Op32 X, 9, 8, 11, 13: Op32 X, 10, 9, 8, 18
Op32 X, 12, 15, 14, 7: Op32 X, 13, 12, 15, 9
Op32 X, 14, 13, 12, 13: Op32 X, 15, 14, 13, 18
#End If
Next
For lIdx = 0 To 15
#If HasOperators Then
B32.Item(lIdx) += X.Item(lIdx)
#Else
B32.Item(lIdx) = UAdd32(B32.Item(lIdx), X.Item(lIdx))
#End If
Next
Call CopyMemory(B(0), B32, 64)
End Sub
Private Sub pvBlockMix(B() As Byte, Y() As Byte, ByVal lR As Long)
Dim X(0 To 63) As Byte
Dim lIdx As Long
Dim lJdx As Long
Debug.Assert UBound(B) + 1 >= 2 * lR * 64
Debug.Assert UBound(Y) + 1 >= 2 * lR * 64
Call CopyMemory(X(0), B((2 * lR - 1) * 64), 64)
For lIdx = 0 To 2 * lR - 1
For lJdx = 0 To 63
X(lJdx) = X(lJdx) Xor B(lIdx * 64 + lJdx)
Next
pvSalsa20Core X
Call CopyMemory(Y(lIdx * 64), X(0), 64)
Next
For lIdx = 0 To lR - 1
Call CopyMemory(B((0 + lIdx) * 64), Y((2 * lIdx + 0) * 64), 64)
Next
For lIdx = 0 To lR - 1
Call CopyMemory(B((lR + lIdx) * 64), Y((2 * lIdx + 1) * 64), 64)
Next
End Sub
Private Function pvIntegerify(X() As Byte, ByVal lR As Long) As Long
Debug.Assert UBound(X) + 1 >= 2 * lR * 64
Call CopyMemory(pvIntegerify, X((2 * lR - 1) * 64), 4)
pvIntegerify = pvIntegerify And &H7FFFFFFF
End Function
Private Sub pvSMix(ByVal lPtr As LongPtr, ByVal lR As Long, ByVal lN As Long, V() As Byte)
Dim X() As Byte
Dim Y() As Byte
Dim lIdx As Long
Dim lJdx As Long
Dim lK As Long
Dim lBlockSize As Long
lBlockSize = 128 * lR
Debug.Assert UBound(V) + 1 >= lN * lBlockSize
ReDim X(0 To lBlockSize - 1) As Byte
ReDim Y(0 To lBlockSize - 1) As Byte
Call CopyMemory(X(0), ByVal lPtr, lBlockSize)
For lIdx = 0 To lN - 1
Call CopyMemory(V(lIdx * lBlockSize), X(0), lBlockSize)
pvBlockMix X, Y, lR
Next
For lIdx = 0 To lN - 1
lK = pvIntegerify(X, lR) And (lN - 1)
For lJdx = 0 To lBlockSize - 1
X(lJdx) = X(lJdx) Xor V(lK * lBlockSize + lJdx)
Next
pvBlockMix X, Y, lR
Next
Call CopyMemory(ByVal lPtr, X(0), lBlockSize)
End Sub
Public Function CryptoScryptKdfByteArray(baPass() As Byte, baSalt() As Byte, _
Optional ByVal OutSize As Long, _
Optional ByVal CpuCost As Long = 16384, _
Optional ByVal MemoryCost As Long = 8, _
Optional ByVal Parallel As Long = 1) As Byte()
Dim lN As Long: lN = CpuCost
Dim lR As Long: lR = MemoryCost
Dim lP As Long: lP = Parallel
Dim B() As Byte
Dim V() As Byte
Dim lIdx As Long
Debug.Assert (lN And (lN - 1)) = 0 '-- must be power of 2
Debug.Assert CDbl(lP) * lR <= 2 ^ 30
#If Not HasOperators Then
If LNG_POW2(0) = 0 Then
LNG_POW2(0) = 1
For lIdx = 1 To 30
LNG_POW2(lIdx) = LNG_POW2(lIdx - 1) * 2
Next
LNG_POW2(31) = &H80000000
End If
#End If
ReDim V(0 To lN * 128 * lR - 1) As Byte
B = CryptoPbkdf2HmacSha2ByteArray(256, baPass, baSalt, 1, lP * 128 * lR)
For lIdx = 0 To lP - 1
pvSMix VarPtr(B(lIdx * 128 * lR)), lR, lN, V
Next
CryptoScryptKdfByteArray = CryptoPbkdf2HmacSha2ByteArray(256, baPass, B, 1, OutSize)
End Functioncheers,
</wqw>