picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

rsa.l (2621B)

      1 # 10nov04abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # *InND
      5 
      6 # Generate long random number
      7 (de longRand (N)
      8    (use (R D)
      9       (while (=0 (setq R (abs (rand)))))
     10       (until (> R N)
     11          (unless (=0 (setq D (abs (rand))))
     12             (setq R (* R D)) ) )
     13       (% R N) ) )
     14 
     15 # X power Y modulus N
     16 (de **Mod (X Y N)
     17    (let M 1
     18       (loop
     19          (when (bit? 1 Y)
     20             (setq M (% (* M X) N)) )
     21          (T (=0 (setq Y (>> 1 Y)))
     22             M )
     23          (setq X (% (* X X) N)) ) ) )
     24 
     25 # Probabilistic prime check
     26 (de prime? (N)
     27    (and
     28       (> N 1)
     29       (bit? 1 N)
     30       (let (Q (dec N)  K 0)
     31          (until (bit? 1 Q)
     32             (setq
     33                Q  (>> 1 Q)
     34                K  (inc K) ) )
     35          (do 50
     36             (NIL (_prim? N Q K))
     37             T ) ) ) )
     38 
     39 # (Knuth Vol.2, p.379)
     40 (de _prim? (N Q K)
     41    (use (X J Y)
     42       (while (> 2 (setq X (longRand N))))
     43       (setq
     44          J 0
     45          Y (**Mod X Q N) )
     46       (loop
     47          (T
     48             (or
     49                (and (=0 J) (= 1 Y))
     50                (= Y (dec N)) )
     51             T )
     52          (T
     53             (or
     54                (and (> J 0) (= 1 Y))
     55                (<= K (inc 'J)) )
     56             NIL )
     57          (setq Y (% (* Y Y) N)) ) ) )
     58 
     59 # Find a prime number with `Len' digits
     60 (de prime (Len)
     61    (let P (longRand (** 10 (*/ Len 2 3)))
     62       (unless (bit? 1 P)
     63          (inc 'P) )
     64       (until (prime? P)  # P: Prime number of size 2/3 Len
     65          (inc 'P 2) )
     66       # R: Random number of size 1/3 Len
     67       (let (R (longRand (** 10 (/ Len 3)))  K (+ R (% (- P R) 3)))
     68          (when (bit? 1 K)
     69             (inc 'K 3) )
     70          (until (prime? (setq R (inc (* K P))))
     71             (inc 'K 6) )
     72          R ) ) )
     73 
     74 # Generate RSA key
     75 (de rsaKey (N)  #> (Encrypt . Decrypt)
     76    (let (P (prime (*/ N 5 10))  Q (prime (*/ N 6 10)))
     77       (cons
     78          (* P Q)
     79          (/
     80             (inc (* 2 (dec P) (dec Q)))
     81             3 ) ) ) )
     82 
     83 # Encrypt a list of characters
     84 (de encrypt (Key Lst)
     85    (let Siz (>> 1 (size Key))
     86       (make
     87          (while Lst
     88             (let N (char (pop 'Lst))
     89                (while (> Siz (size N))
     90                   (setq N (>> -16 N))
     91                   (inc 'N (char (pop 'Lst))) )
     92                (link (**Mod N 3 Key)) ) ) ) ) )
     93 
     94 # Decrypt a list of numbers
     95 (de decrypt (Keys Lst)
     96    (mapcan
     97       '((N)
     98          (let Res NIL
     99             (setq N (**Mod N (cdr Keys) (car Keys)))
    100             (until (=0 N)
    101                (push 'Res (char (& `(dec (** 2 16)) N)))
    102                (setq N (>> 16 N)) )
    103             Res ) )
    104       Lst ) )
    105 
    106 # Init crypt
    107 (de rsa (N)
    108    (seed (in "/dev/urandom" (rd 20)))
    109    (setq *InND (rsaKey N)) )