RSA2048 encryption - Printable Version

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

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

'

'  https://pump.richheimer.de/showthread.php?tid=150&pid=1115#pid1115



' - 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

   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

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

    ELSEIF BnCmp(x(), g_N(), L) >= 0 THEN

       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

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

  ELSEIF BnCmp(r(), g_N(), L) >= 0 THEN

     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

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

   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



   BnClear(one())

  one(0) = 1

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

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



  nbits = BnBitLength(ex(), exLimbs)

  FOR bitNo = nbits - 1 TO 0 STEP -1

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

    IF BnGetBit(ex(), bitNo) = 1 THEN

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

    END IF

  NEXT

   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



   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

     BnShr1(d(), L)

    INCR s

  LOOP



  FOR rounds = 0 TO %MR_ROUNDS - 1

     BnClear(a())

    a(0) = g_SP(rounds)

     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

         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

     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

     GenPrime(p(), %HALF_LIMBS)

    DO

       GenPrime(q(), %HALF_LIMBS)

    LOOP WHILE BnCmp(p(), q(), %HALF_LIMBS) = 0



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



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

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

     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

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

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



   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)

   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



   BytesToBn(em, m())

   SetModulus(n(), %KEY_LIMBS)

   BnClear(ex())

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

   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

   BytesToBn(cipher, c())

  IF BnCmp(c(), n(), %KEY_LIMBS) >= 0 THEN FUNCTION = "" : EXIT FUNCTION



   SetModulus(n(), %KEY_LIMBS)

   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)



   InitSmallPrimes

   SeedRandom



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

  msg = "Test this 123456 789*)($#@!"

  

  t0 = TIMER





   RsaGenerateKey(n(), d())



   LOCAL dspmsg AS STRING

  dspmsg = "Done in "+ USING$("##.#", TIMER - t0)+ " s" + $CRLF



  dspmsg += "Modulus n (hex):"  + _

            BnToHex(n(), %KEY_LIMBS)  + $CRLF



  dspmsg += "Public exponent e = "+ STR$( %E_PUBLIC)







  dspmsg += $CRLF + "Message : "+ msg   + $CRLF

  cipher = RsaEncrypt(msg, n())

  dspmsg += "Cipher  : "+ BytesToHex(cipher)  + $CRLF



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

  dspmsg += "Decrypted: "+ plain  + $CRLF

  IF plain = msg THEN

    dspmsg += "Round trip OK."

  ELSE

    dspmsg += "Round trip FAILED."

  END IF



  ?  dspmsg



END FUNCTION