/rsa.rkt

 1#lang racket
 2(require racket/include)
 3(include "primality.rkt")
 4  
 5
 6(define dec->bin
 7  (lambda (d)
 8    (cond
 9      ((< d 1) (list 0))
10      ((= d 1) (list 1))
11      ((> d 1) (append
12                (dec->bin (floor (/ d 2)))
13		(list (if (= (modulo d 2) 0) 0 1))))
14      )))
15
16(define (totient p q) (*(- p 1) (- q 1)))
17
18(define (coprime n)
19  (let ((nr (random n)))
20  (cond
21    ((= (gcd n 17) 1) 17)
22    ((= (gcd n nr) 1) nr)
23    (else (coprime n))
24    )))
25
26(define (extEuclidean a b)
27  (cond
28    ((= b 0) (list 1 0 a))
29    (else 
30     (let ((eAnswer (extEuclidean b (remainder a b))))
31           (list (cadr eAnswer)
32                 (- (car eAnswer) (* (cadr eAnswer) (floor (/ a b))))
33                 (car (cddr eAnswer)))
34     ))))
35(define (modInvEuclid a m)  (remainder (+ m (car (extEuclidean a m))) m))
36
37(define (quickExponentiate a b c)
38  (remainder (quickExponentiate-helper (reverse (dec->bin b)) c (reverse (quickExpPowers a c (floor (+ (/ (log b) (log 2)) 1)) '() ))) c)
39  )
40(define (quickExponentiate-helper b c n)
41  (cond
42    ((null? b) 1)
43    ((= (car b) 0) (quickExponentiate-helper (cdr b) c (cdr n)))
44    (else (* (car n) (quickExponentiate-helper (cdr b) c (cdr n))))
45    ))
46(define (quickExpPowers a c k n)
47  (cond
48    ((= k (length n)) n)
49    ((null? n) (quickExpPowers a c k (list (remainder a c))))
50    (else (quickExpPowers a c k (cons (remainder (pow (car n) 2) c) n)))
51    ))
52
53(define (rsa-keygen p q)
54  (let ((n (* p q)) (t (totient p q)))
55    (let ((e (coprime n)))
56      (let ((d (modInvEuclid e t)))
57      (cond
58        ((equal? d #f) #f)
59        (else (list (list n e) (list n d)))
60        ))
61      )
62    ))
63
64(define (rsa-encrypt public-key info) (quickExponentiate info (cadr public-key) (car public-key)))
65(define (rsa-decrypt private-key info) (quickExponentiate info (cadr private-key) (car private-key)))