RSA-2048 in PowerBasic (no Crypto API)

Code:
' ==============================================================================

' RSA2048.bas  -  RSA-2048 in pure PowerBasic (no Windows Crypto API)

'

' - Big numbers: arrays of QUAD, each element holds one 16-bit limb

'  (little-endian: element 0 = least significant 16 bits).

'  16-bit limbs keep every intermediate product well inside a signed QUAD.

' - Modular exponentiation: Montgomery multiplication (no big division needed)

' - Key generation: random 1024-bit primes, trial division + Miller-Rabin

' - Private exponent: derived without big division (e is small, see below)

' - Padding: PKCS#1 v1.5 (type 2) for text messages, max 245 bytes

'

' Written as a PBCC console program. For PBWin, replace PRINT/WAITKEY$ with

' MSGBOX or file output.

'

' WARNING - educational code:

'  * RND is NOT a cryptographically secure random source. For real keys use

'    an OS entropy source.

'  * Not constant-time (timing side channels), no CRT, no blinding.

'  * PKCS#1 v1.5 padding is legacy; OAEP would need a hash function.

'==============================================================================

#Compile Exe

#Dim All

#Include "Win32Api.Inc"          ' only for QueryPerformanceCounter (seeding)



%LIMBS_MAX  = 136                ' 128 limbs = 2048 bits, plus guard limbs

%KEY_LIMBS  = 128                ' 2048 bits

%HALF_LIMBS = 64                  ' 1024 bits (p and q)

%E_PUBLIC  = 65537

%MR_ROUNDS  = 10                  ' Miller-Rabin rounds (bases = first primes)



Global g_L      As Long                          ' limbs in current modulus

Global g_Ninv  As Quad                          ' -n^-1 mod 2^16

Global g_N()    As Quad                          ' current modulus

Global g_R2()  As Quad                          ' R^2 mod n, R = 2^(16*L)

Global g_T()    As Quad                          ' scratch for MontMul

Global g_SP()  As Long                          ' small primes

Global g_SPCount As Long



'------------------------------------------------------------------------------

' Basic big-number helpers

'------------------------------------------------------------------------------

Sub BnClear(a() As Quad)

  Local i As Long

  For i = 0 To %LIMBS_MAX - 1

    a(i) = 0

  Next

End Sub



Sub BnCopy(src() As Quad, dst() As Quad)

  Local i As Long

  For i = 0 To %LIMBS_MAX - 1

    dst(i) = src(i)

  Next

End Sub



' compare over n limbs: -1, 0, 1

Function BnCmp(a() As Quad, b() As Quad, ByVal n As Long) As Long

  Local i As Long

  For i = n - 1 To 0 Step -1

    If a(i) > b(i) Then Function = 1 : Exit Function

    If a(i) < b(i) Then Function = -1 : Exit Function

  Next

  Function = 0

End Function



' a = a - b over n limbs (a >= b assumed, or the borrow is dropped)

Sub BnSubInPlace(a() As Quad, b() As Quad, ByVal n As Long)

  Local i As Long

  Local d As Quad, borrow As Quad

  borrow = 0

  For i = 0 To n - 1

    d = a(i) - b(i) - borrow

    If d < 0 Then

      d = d + 65536 : borrow = 1

    Else

      borrow = 0

    End If

    a(i) = d

  Next

End Sub



' a = a >> 1 over n limbs

Sub BnShr1(a() As Quad, ByVal n As Long)

  Local i As Long

  Local t As Quad, carry As Quad

  carry = 0

  For i = n - 1 To 0 Step -1

    t = a(i)

    a(i) = (t + carry * 65536) \ 2

    carry = t And 1

  Next

End Sub



Function BnBitLength(a() As Quad, ByVal n As Long) As Long

  Local i As Long, b As Long

  Local v As Quad

  For i = n - 1 To 0 Step -1

    If a(i) <> 0 Then

      v = a(i) : b = 0

      Do While v > 0

        Incr b

        v = v \ 2

      Loop

      Function = i * 16 + b

      Exit Function

    End If

  Next

  Function = 0

End Function



Function BnGetBit(a() As Quad, ByVal bitNo As Long) As Long

  Local k As Long

  Local v As Quad

  v = a(bitNo \ 16)

  For k = 1 To (bitNo Mod 16)

    v = v \ 2

  Next

  Function = (v And 1)

End Function



' remainder of a (n limbs) divided by small m (m < 2^31)

Function BnModSmall(a() As Quad, ByVal n As Long, ByVal m As Long) As Long

  Local i As Long

  Local r As Quad

  r = 0

  For i = n - 1 To 0 Step -1

    r = (r * 65536 + a(i)) Mod m

  Next

  Function = r

End Function



' a = a \ m over n limbs, returns remainder

Function BnDivSmall(a() As Quad, ByVal n As Long, ByVal m As Long) As Long

  Local i As Long

  Local r As Quad, Qcur As Quad

  r = 0

  For i = n - 1 To 0 Step -1

    Qcur = r * 65536 + a(i)

    a(i) = Qcur \ m

    r = Qcur Mod m

  Next

  Function = r

End Function



' a = a * m + addv over n limbs (m <= 65536, caller guarantees no overflow)

Sub BnMulSmallAdd(a() As Quad, ByVal n As Long, ByVal m As Long, ByVal addv As Long)

  Local i As Long

  Local s As Quad, c As Quad

  c = addv

  For i = 0 To n - 1

    s = a(i) * m + c

    a(i) = s And 65535

    c = s \ 65536

  Next

End Sub



' r = a * b  (schoolbook). r must be a different array than a and b.

Sub BnMul(a() As Quad, ByVal na As Long, b() As Quad, ByVal nb As Long, r() As Quad)

  Local i As Long, j As Long

  Local s As Quad, c As Quad

  Call BnClear(r())

  For i = 0 To na - 1

    c = 0

    For j = 0 To nb - 1

      s = r(i + j) + a(i) * b(j) + c

      r(i + j) = s And 65535

      c = s \ 65536

    Next

    r(i + nb) = c

  Next

End Sub



' inverse of a modulo m (small numbers, extended Euclid), 0 if none

Function ModInvSmall(ByVal a As Quad, ByVal m As Quad) As Quad

  Local t As Quad, newt As Quad, r As Quad, newr As Quad

  Local q As Quad, tmp As Quad

  t = 0 : newt = 1 : r = m : newr = a

  Do While newr <> 0

    q = r \ newr

    tmp = t - q * newt : t = newt : newt = tmp

    tmp = r - q * newr : r = newr : newr = tmp

  Loop

  If r > 1 Then Function = 0 : Exit Function

  If t < 0 Then t = t + m

  Function = t

End Function



'------------------------------------------------------------------------------

' Montgomery arithmetic

'------------------------------------------------------------------------------

' Select the (odd) modulus n of L limbs and precompute constants.

Sub SetModulus(n() As Quad, ByVal L As Long)

  Local i As Long, k As Long

  Local Qinv As Quad, n0 As Quad, s As Quad, carry As Quad

  Dim x(0 To %LIMBS_MAX - 1) As Local Quad



  g_L = L

  For i = 0 To %LIMBS_MAX - 1

    g_N(i) = 0 : g_R2(i) = 0 : x(i) = 0

  Next

  For i = 0 To L - 1

    g_N(i) = n(i)

  Next



  ' n0^-1 mod 2^16 by Newton iteration, then negate

  n0 = n(0) : Qinv = n0

  For i = 1 To 4

    Qinv = (Qinv * (2 - n0 * Qinv)) And 65535

  Next

  g_Ninv = (65536 - Qinv) And 65535



  ' R^2 mod n = 2^(32*L) mod n : start at 1, double 32*L times with reduction

  x(0) = 1

  For k = 1 To 32 * L

    carry = 0

    For i = 0 To L - 1

      s = x(i) * 2 + carry

      x(i) = s And 65535

      carry = s \ 65536

    Next

    If carry <> 0 Then

      Call BnSubInPlace(x(), g_N(), L)

    ElseIf BnCmp(x(), g_N(), L) >= 0 Then

      Call BnSubInPlace(x(), g_N(), L)

    End If

  Next

  For i = 0 To L - 1

    g_R2(i) = x(i)

  Next

End Sub



' r = a * b * R^-1 mod n  (CIOS method). r may be the same array as a or b.

Sub MontMul(a() As Quad, b() As Quad, r() As Quad)

  Local i As Long, j As Long, L As Long

  Local s As Quad, c As Quad, m As Quad, bi As Quad



  L = g_L

  For i = 0 To L + 1

    g_T(i) = 0

  Next



  For i = 0 To L - 1

    bi = b(i) : c = 0

    For j = 0 To L - 1

      s = g_T(j) + a(j) * bi + c

      g_T(j) = s And 65535

      c = s \ 65536

    Next

    s = g_T(L) + c

    g_T(L) = s And 65535

    g_T(L + 1) = s \ 65536



    m = (g_T(0) * g_Ninv) And 65535

    s = g_T(0) + m * g_N(0)

    c = s \ 65536

    For j = 1 To L - 1

      s = g_T(j) + m * g_N(j) + c

      g_T(j - 1) = s And 65535

      c = s \ 65536

    Next

    s = g_T(L) + c

    g_T(L - 1) = s And 65535

    g_T(L) = g_T(L + 1) + (s \ 65536)

    g_T(L + 1) = 0

  Next



  For i = 0 To L - 1

    r(i) = g_T(i)

  Next

  For i = L To %LIMBS_MAX - 1

    r(i) = 0

  Next

  If g_T(L) <> 0 Then

    Call BnSubInPlace(r(), g_N(), L)

  ElseIf BnCmp(r(), g_N(), L) >= 0 Then

    Call BnSubInPlace(r(), g_N(), L)

  End If

End Sub



' res = a * b mod n (plain, non-Montgomery in/out)

Sub ModMulPlain(a() As Quad, b() As Quad, r() As Quad)

  Dim tmp(0 To %LIMBS_MAX - 1) As Local Quad

  Call MontMul(a(), b(), tmp())

  Call MontMul(tmp(), g_R2(), r())

End Sub



' res = base ^ ex mod n    (base < n; modulus must be set with SetModulus)

Sub ModPow(Qbase() As Quad, ex() As Quad, ByVal exLimbs As Long, Res() As Quad)

  Local bitNo As Long, nbits As Long

  Dim bm(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim acc(0 To %LIMBS_MAX - 1) As Local Quad

  Dim one(0 To %LIMBS_MAX - 1) As Local Quad



  Call BnClear(one())

  one(0) = 1

  Call MontMul(Qbase(), g_R2(), bm())      ' base in Montgomery form

  Call MontMul(one(), g_R2(), acc())      ' 1 in Montgomery form



  nbits = BnBitLength(ex(), exLimbs)

  For bitNo = nbits - 1 To 0 Step -1

    Call MontMul(acc(), acc(), acc())

    If BnGetBit(ex(), bitNo) = 1 Then

      Call MontMul(acc(), bm(), acc())

    End If

  Next

  Call MontMul(acc(), one(), Res())      ' back to normal form

End Sub



'------------------------------------------------------------------------------

' Random numbers, small primes, primality test

'------------------------------------------------------------------------------

Sub InitSmallPrimes

  Local i As Long, j As Long

  Dim comp(0 To 2000) As Local Byte

  g_SPCount = 0

  For i = 2 To 2000

    If comp(i) = 0 Then

      g_SP(g_SPCount) = i

      Incr g_SPCount

      For j = i * i To 2000 Step i

        comp(j) = 1

      Next

    End If

  Next

End Sub



Sub SeedRandom

  Local q As Quad, seed As Long, i As Long, dummy As Long

  ' Mixes several high-resolution timer samples. This is NOT strong entropy.

  seed = 0

  For i = 1 To 8

    dummy = QueryPerformanceCounter(q)

    seed = seed Xor CLng(q And &H7FFFFFFF)

    seed = (seed * 31 + i) And &H7FFFFFFF

    Sleep 1

  Next

  Randomize seed

End Sub



Function RndLimb() As Quad

  Function = Int(Rnd * 65536)

End Function



' Miller-Rabin using the first %MR_ROUNDS small primes as bases

Function IsProbablePrime(n() As Quad, ByVal L As Long) As Long

  Local i As Long, s As Long, r As Long, rounds As Long, passed As Long

  Dim d(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim nm1(0 To %LIMBS_MAX - 1) As Local Quad

  Dim x(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim a(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim one(0 To %LIMBS_MAX - 1) As Local Quad



  Call SetModulus(n(), L)

  For i = 0 To %LIMBS_MAX - 1

    d(i) = n(i) : nm1(i) = n(i) : one(i) = 0

  Next

  d(0) = d(0) - 1                  ' n is odd, so no borrow

  nm1(0) = nm1(0) - 1

  one(0) = 1



  s = 0

  Do While (d(0) And 1) = 0

    Call BnShr1(d(), L)

    Incr s

  Loop



  For rounds = 0 To %MR_ROUNDS - 1

    Call BnClear(a())

    a(0) = g_SP(rounds)

    Call ModPow(a(), d(), L, x())

    If BnCmp(x(), one(), L) <> 0 And BnCmp(x(), nm1(), L) <> 0 Then

      passed = 0

      For r = 1 To s - 1

        Call ModMulPlain(x(), x(), x())

        If BnCmp(x(), nm1(), L) = 0 Then

          passed = 1

          Exit For

        End If

      Next

      If passed = 0 Then Function = 0 : Exit Function

    End If

  Next

  Function = 1

End Function



' random prime of L limbs: top two bits set, odd, (p-1) not divisible by e

Sub GenPrime(p() As Quad, ByVal L As Long)

  Local i As Long, k As Long, ok As Long

  Do

    Call BnClear(p())

    For i = 0 To L - 1

      p(i) = RndLimb()

    Next

    p(0) = p(0) Or 1

    p(L - 1) = p(L - 1) Or 49152                ' &HC000



    ok = 1

    If BnModSmall(p(), L, %E_PUBLIC) = 1 Then ok = 0  ' p-1 divisible by e

    If ok = 1 Then

      For k = 0 To g_SPCount - 1

        If BnModSmall(p(), L, g_SP(k)) = 0 Then ok = 0 : Exit For

      Next

    End If

    If ok = 1 Then

      If IsProbablePrime(p(), L) = 1 Then Exit Sub

    End If

  Loop

End Sub



'------------------------------------------------------------------------------

' Key generation

'  n = p*q,  e = 65537,  d = e^-1 mod (p-1)(q-1)

'  d without big division: choose k in [1,e-1] with (1 + k*phi) divisible by e

'  (k = -phi^-1 mod e, computed with small integers), then d = (1 + k*phi)/e.

'------------------------------------------------------------------------------

Sub RsaGenerateKey(n() As Quad, d() As Quad)

  Local r As Long, k As Long, i As Long

  Dim p(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim q(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim p1(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim q1(0 To %LIMBS_MAX - 1)  As Local Quad

  Dim phi(0 To %LIMBS_MAX - 1) As Local Quad



  Do

    Call GenPrime(p(), %HALF_LIMBS)

    Do

      Call GenPrime(q(), %HALF_LIMBS)

    Loop While BnCmp(p(), q(), %HALF_LIMBS) = 0



    Call BnMul(p(), %HALF_LIMBS, q(), %HALF_LIMBS, n())



    Call BnCopy(p(), p1()) : p1(0) = p1(0) - 1        ' primes are odd

    Call BnCopy(q(), q1()) : q1(0) = q1(0) - 1

    Call BnMul(p1(), %HALF_LIMBS, q1(), %HALF_LIMBS, phi())



    r = BnModSmall(phi(), %KEY_LIMBS, %E_PUBLIC)

    If r <> 0 Then Exit Do                            ' gcd(e, phi) = 1

  Loop



  k = (%E_PUBLIC - ModInvSmall(r, %E_PUBLIC)) Mod %E_PUBLIC

  Call BnMulSmallAdd(phi(), %KEY_LIMBS + 2, k, 1)    ' phi = 1 + k*phi

  Call BnDivSmall(phi(), %KEY_LIMBS + 2, %E_PUBLIC)  ' exact division



  Call BnClear(d())

  For i = 0 To %KEY_LIMBS - 1

    d(i) = phi(i)

  Next

End Sub



'------------------------------------------------------------------------------

' Conversions

'------------------------------------------------------------------------------

' big-endian byte string (even length) -> big number

Sub BytesToBn(s As String, a() As Quad)

  Local i As Long, ln As Long

  ln = Len(s)

  Call BnClear(a())

  For i = 0 To (ln \ 2) - 1

    a(i) = Asc(s, ln - 2 * i) + 256 * Asc(s, ln - 2 * i - 1)

  Next

End Sub



' big number -> big-endian byte string of nbytes (even)

Function BnToBytes(a() As Quad, ByVal nbytes As Long) As String

  Local i As Long

  Local s As String

  s = String$(nbytes, 0)

  For i = 0 To (nbytes \ 2) - 1

    Asc(s, nbytes - 2 * i)    = CLng(a(i) And 255)

    Asc(s, nbytes - 2 * i - 1) = CLng((a(i) \ 256) And 255)

  Next

  Function = s

End Function



Function BnToHex(a() As Quad, ByVal n As Long) As String

  Local i As Long

  Local s As String

  For i = n - 1 To 0 Step -1

    s = s + Hex$(CLng(a(i)), 4)

  Next

  Function = s

End Function



Function BytesToHex(s As String) As String

  Local i As Long

  Local h As String

  For i = 1 To Len(s)

    h = h + Hex$(Asc(s, i), 2)

  Next

  Function = h

End Function



'------------------------------------------------------------------------------

' Encrypt / decrypt with PKCS#1 v1.5 (type 2) padding

'  EM = 00 02 PS(>=8 random nonzero bytes) 00 M    (256 bytes)

'------------------------------------------------------------------------------

Function RsaEncrypt(msg As String, n() As Quad) As String

  Local mlen As Long, i As Long

  Local em As String

  Dim m(0 To %LIMBS_MAX - 1) As Local Quad

  Dim c(0 To %LIMBS_MAX - 1) As Local Quad

  Dim ex(0 To %LIMBS_MAX - 1) As Local Quad



  mlen = Len(msg)

  If mlen > 245 Then Function = "" : Exit Function



  em = String$(256, 0)

  Asc(em, 2) = 2

  For i = 3 To 256 - mlen - 1

    Asc(em, i) = 1 + Int(Rnd * 255)

  Next

  If mlen > 0 Then Mid$(em, 257 - mlen, mlen) = msg



  Call BytesToBn(em, m())

  Call SetModulus(n(), %KEY_LIMBS)

  Call BnClear(ex())

  ex(0) = 1 : ex(1) = 1                    ' 65537 = &H10001

  Call ModPow(m(), ex(), 2, c())

  Function = BnToBytes(c(), 256)

End Function



Function RsaDecrypt(cipher As String, n() As Quad, d() As Quad) As String

  Local i As Long

  Local em As String

  Dim c(0 To %LIMBS_MAX - 1) As Local Quad

  Dim m(0 To %LIMBS_MAX - 1) As Local Quad



  If Len(cipher) <> 256 Then Function = "" : Exit Function

  Call BytesToBn(cipher, c())

  If BnCmp(c(), n(), %KEY_LIMBS) >= 0 Then Function = "" : Exit Function



  Call SetModulus(n(), %KEY_LIMBS)

  Call ModPow(c(), d(), %KEY_LIMBS, m())

  em = BnToBytes(m(), 256)



  If Asc(em, 1) <> 0 Or Asc(em, 2) <> 2 Then Function = "" : Exit Function

  For i = 3 To 256

    If Asc(em, i) = 0 Then Exit For

  Next

  If i < 11 Or i > 256 Then Function = "" : Exit Function  ' bad padding

  Function = Mid$(em, i + 1)

End Function



'------------------------------------------------------------------------------

' Demo

'------------------------------------------------------------------------------

Function PBMain() As Long

  Local msg As String, cipher As String, plain As String

  Local t0 As Single

  Dim n(0 To %LIMBS_MAX - 1) As Quad

  Dim d(0 To %LIMBS_MAX - 1) As Quad



  ReDim g_N(0 To %LIMBS_MAX - 1)

  ReDim g_R2(0 To %LIMBS_MAX - 1)

  ReDim g_T(0 To %LIMBS_MAX + 1)

  ReDim g_SP(0 To 399)



  Call InitSmallPrimes

  Call SeedRandom



  Print "Generating RSA-2048 key (two 1024-bit primes), please wait..."

  t0 = Timer

  Call RsaGenerateKey(n(), d())

  Print "Done in "; Using$("##.#", Timer - t0); " s"

  Print

  Print "Modulus n (hex):"

  Print BnToHex(n(), %KEY_LIMBS)

  Print

  Print "Public exponent e = "; %E_PUBLIC

  Print



  msg = "Hello from pure PowerBasic RSA-2048!"

  Print "Message : "; msg

  cipher = RsaEncrypt(msg, n())

  Print "Cipher  : "; BytesToHex(cipher)

  Print

  plain = RsaDecrypt(cipher, n(), d())

  Print "Decrypted: "; plain

  If plain = msg Then

    Print "Round trip OK."

  Else

    Print "Round trip FAILED."

  End If



  Print

  Print "Press any key..."

  WaitKey$

End Function