'Subject: Cryptography: probable primes and crypto key generation.
'         Prints relevant values to public & private key-files.
'Author : Sjoerd.J.Schaper
'Date   : 03-13-2005
'Code   : QuickBasic, PDS, VBdos, FreeBasic
REM $LANG: "qb"
REM $INCLUDE: 'largeint.bi'
DECLARE SUB prntkey (n, sw)
'write base 64 data
CONST i0 = 0, i1 = 1, i2 = 2
CONST P = 3, Q = 4, w = 7 '            number of witnesses
t = LargeInit(Q, "genrator")
DIM g AS STRING, wdir AS STRING
DIM SHARED Keyfil
wdir = SPACE$(64): Work wdir '         working directory
CLS : tim# = TIMER

begin:
LOCATE 1, 1
PRINT "   +---------------------------------+"
PRINT "   |  input bitlength of modulus N,  |"
PRINT "   |  0 to exit.                     |"
PRINT "   |                                 |"
PRINT "   +---------------------------------+"
LOCATE 4, 7: INPUT ; "l(N)"; g
IF INSTR(g, "'") THEN GOTO begin
LOCATE 7, 1: L# = VAL(g)
IF L# < 1 THEN GOTO eind
IF L# < 73 OR L# > 2048 THEN
   Prints " illegal modulus size", 1
   GOTO begin
END IF
lx = 1 + INT(L#)
lp = lx \ 2 + INT(RND * 4)
lq = lx - lp '                         lengths primes P & Q

lx = lp
FOR t = 1 TO 2
   Rndf i0, lx
   Dup i0, t0: d = 5: df = 4
   r = Divint(t0, 6)
   IF r < 2 THEN d = 1: df = 2
   Inc i0, d - r '                     random i0 = +-1 (mod 6)
   '
   Dup i0, t0: d = Divint(t0, MD) '    i0 mod 10000
   g = " searching P..."
   IF t = 2 THEN g = " searching Q..."
   DO
      IF (df AND 3) = 0 THEN
         LOCATE 7, 1: PRINT g; d; SPACE$(3);
      END IF
      IF IsPPrm(i0, i1, w) THEN '      strong pseudoprime-test
         IF t = 1 THEN Dup i0, P
         EXIT DO
      END IF
      df = 6 - df: d = d + df
      Inc i0, df
   LOOP
   lx = lq
NEXT t
Dup i0, Q
IF Cmp(P, Q) < 1 THEN Swp P, Q

Keyfil = FREEFILE
OPEN wdir + "public.key" FOR OUTPUT AS Keyfil
   Mult P, Q, i0 '                     RSA modulus P * Q
   Letf i1, 65537 '                    public exponent F4
   prntkey i0, 1: prntkey i1, 0
CLOSE Keyfil

CLS : LOCATE 2, 1
Printn P, " P = ", "", 2 '             prime factors
Printn Q, " Q = ", "", 2
Printn i0, " N = ", "", 2
Printn i1, " e = ", "", 2
'
Dup i1, i0
Inc P, -1: Euclid i0, P, t3 '          e * i0 = 1 (mod P-1)
Inc P, 1: t = -Isf(t3, 1)
Inc Q, -1: Euclid i1, Q, t3 '          e * i1 = 1 (mod Q-1)
Inc Q, 1: t = t * Isf(t3, 1)
IF NOT t THEN
   Prints " gcd(phi(N), e) > 1, no private key generated", 1
   GOTO eind
END IF
Dup Q, i2: Euclid i2, P, t3 '          Q * i2 = 1 (mod P)
'
Printn i0, "dP = ", " (mod P-1)", 2 '  Crt exponents
Printn i1, "dQ = ", " (mod Q-1)", 2
Printn i2, "Q1 = ", " (mod P)", 2 '    Crt coefficient

Keyfil = FREEFILE
OPEN wdir + "private.key" FOR OUTPUT AS Keyfil
   prntkey P, 0: prntkey Q, 0
   prntkey i0, 0: prntkey i1, 0
   prntkey i2, 0
CLOSE Keyfil

eind:
Prints "", 1
g = STR$(CSNG(TIMER - tim#))
Prints " Timer:" + g + " s", 1
CALL Term
SYSTEM

SUB prntkey (n, sw)
b64$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
   i = Bitl(n)
   k = -INT(-i / 8): j = k * 8 '       byte Len
   k = -INT(-j / 6): i = k * 6 '       6-bit Len
   i = i - j: Dup n, t0
   IF i > 0 THEN Lsft t0, i '          left-align
   '
   i = i \ 2
   g$ = STRING$(k + i, "=")
   FOR t = 0 TO k - 1 '                largeint to base-64
      j = Mp2(t0, 64) + 1
      MID$(g$, k - t, 1) = MID$(b64$, j, 1)
      Rsft t0, 6
   NEXT t
   '
   IF sw THEN
      k = k + i: t = k \ 2
      PRINT #Keyfil, LEFT$(g$, t) '    split g high
      PRINT #Keyfil, RIGHT$(g$, k - t) ' & low
   ELSE
      PRINT #Keyfil, g$
   END IF
END SUB

