tmtt/chez-openbsd
Archived
1
0
Fork 0
Code Issues Pull requests Releases 1 Activity

fix: README -> README.md

Browse source
This commit is contained in:
tmtt 2022-08-09 23:28:25 +02:00
parent 43e68af625
commit 99b0a6292c
756 changed files with 323753 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

308
ta6ob/examples/rsa.ss Normal file
View file

@ -0,0 +1,308 @@
;;; rsa.ss
;;; Bruce T. Smith, University of North Carolina at Chapel Hill
;;; (circa 1984)
;;; Updated for Chez Scheme Version 7, May 2005
;;; This is a toy example of an RSA public-key encryption system. It
;;; is possible to create users who register their public keys with a
;;; center and hide their private keys. Then, it is possible to have
;;; the users exchange messages. To a limited extent one can look at
;;; the intermediate steps of the process by using encrypt and decrypt.
;;; The encrypted messages are represented by lists of numbers.
;;; Example session:
#|
> (make-user bonzo)
Registered with Center
User: bonzo
Base: 152024296883113044375867034718782727467
Encryption exponent: 7
> (make-user bobo)
Registered with Center
User: bobo
Base: 244692569127295893294157219042233636899
Encryption exponent: 5
> (make-user tiger)
Registered with Center
User: tiger
Base: 138555414233087084786368622588289286073
Encryption exponent: 7
> (show-center)
User: tiger
Base: 138555414233087084786368622588289286073
Encryption exponent: 7
User: bobo
Base: 244692569127295893294157219042233636899
Encryption exponent: 5
User: bonzo
Base: 152024296883113044375867034718782727467
Encryption exponent: 7
> (send "hi there" bonzo bobo)
"hi there"
> (send "hi there to you" bobo bonzo)
"hi there to you"
> (decrypt (encrypt "hi there" bonzo bobo) tiger)
" #z R4WN Zbb E8J"
|#
;;; Implementation:
(module ((make-user user) show-center encrypt decrypt send)
;;; (make-user name) creates a user with the chosen name. When it
;;; creates the user, it tells him what his name is. He will use
;;; this when registering with the center.
(define-syntax make-user
(syntax-rules ()
[(_ uid)
(begin (define uid (user 'uid)) (uid 'register))]))
;;; (encrypt mesg u1 u2) causes user 1 to encrypt mesg using the public
;;; keys for user 2.
(define-syntax encrypt
(syntax-rules ()
[(_ mesg u1 u2) ((u1 'send) mesg 'u2)]))
;;; (decrypt number-list u) causes the user to decrypt the list of
;;; numbers using his private key.
(define-syntax decrypt
(syntax-rules ()
[(_ numbers u) ((u 'receive) numbers)]))
;;; (send mesg u1 u2) this combines the functions 'encrypt' and 'decrypt',
;;; calling on user 1 to encrypt the message for user 2 and calling on
;;; user 2 to decrypt the message.
(define-syntax send
(syntax-rules ()
[(_ mesg u1 u2) (decrypt (encrypt mesg u1 u2) u2)]))
;;; A user is capable of the following:
;;; - choosing public and private keys and registering with the center
;;; - revealing his public and private keys
;;; - retrieving user's private keys from the center and encrypting a
;;; message for that user
;;; - decrypting a message with his private key
(define user
(lambda (name)
(let* ([low (expt 2 63)] ; low, high = bounds on p and q
[high (* 2 low)]
[p 0] ; p,q = two large, probable primes
[q 0]
[n 0] ; n = p * q, base for modulo arithmetic
[phi 0] ; phi = lcm(p-1,q-1), not quite the Euler phi function,
; but it will serve for our purposes
[e 0] ; e = exponent for encryption
[d 0]) ; d = exponent for decryption
(lambda (request)
(case request
;; choose keys and register with the center
[register
(set! p (find-prime low high))
(set! q
(let loop ([q1 (find-prime low high)])
(if (= 1 (gcd p q1))
q1
(loop (find-prime low high)))))
(set! n (* p q))
(set! phi
(/ (* (1- p) (1- q))
(gcd (1- p) (1- q))))
(set! e
(do ([i 3 (+ 2 i)])
((= 1 (gcd i phi)) i)))
(set! d (mod-inverse e phi))
(register-center (cons name (list n e)))
(printf "Registered with Center~%")
(printf "User: ~s~%" name)
(printf "Base: ~d~%" n)
(printf "Encryption exponent: ~d~%" e)]
;; divulge your keys-- you should resist doing this...
[show-all
(printf "p = ~d ; q = ~d~%" p q)
(printf "n = ~d~%" n)
(printf "phi = ~d~%" (* (1- p) (1- q)))
(printf "e = ~d ; d = ~d~%" e d)]
;; get u's public key from the center and encode
;; a message for him
[send
(lambda (mesg u)
(let* ([public (request-center u)]
[base (car public)]
[exponent (cadr public)]
[mesg-list (string->numbers mesg base)])
(map (lambda (x) (expt-mod x exponent base))
mesg-list)))]
;; decrypt a message with your private key
[receive
(lambda (crypt-mesg)
(let ([mesg-list (map (lambda (x) (expt-mod x d n)) crypt-mesg)])
(numbers->string mesg-list)))])))))
;;; The center maintains the list of public keys. It can register
;;; new users, provide the public keys for any particular user, or
;;; display the whole public file.
(module (register-center request-center show-center)
(define public-keys '())
(define register-center
(lambda (entry)
(set! public-keys
(cons entry
(remq (assq (car entry) public-keys) public-keys)))))
(define request-center
(lambda (u)
(let ([a (assoc u public-keys)])
(when (null? a)
(error 'request-center
"User ~s not registered in center"
u))
(cdr a))))
(define show-center
(lambda ()
(for-each
(lambda (entry)
(printf "~%User: ~s~%" (car entry))
(printf "Base: ~s~%" (cadr entry))
(printf "Encryption exponent: ~s~%" (caddr entry)))
public-keys)))
)
;;; string->numbers encodes a string as a list of numbers
;;; numbers->string decodes a string from a list of numbers
;;; string->numbers and numbers->string are defined with respect to
;;; an alphabet. Any characters in the alphabet are translated into
;;; integers---their regular ascii codes. Any characters outside
;;; the alphabet cause an error during encoding. An invalid code
;;; during decoding is translated to a space.
(module (string->numbers numbers->string)
(define first-code 32)
(define last-code 126)
(define alphabet
; printed form of the characters, indexed by their ascii codes
(let ([alpha (make-string 128 #\space)])
(do ([i first-code (1+ i)])
((= i last-code) alpha)
(string-set! alpha i (integer->char i)))))
(define string->integer
(lambda (str)
(let ([ln (string-length str)])
(let loop ([i 0] [m 0])
(if (= i ln)
m
(let* ([c (string-ref str i)] [code (char->integer c)])
(when (or (< code first-code) (>= code last-code))
(error 'rsa "Illegal character ~s" c))
(loop (1+ i) (+ code (* m 128)))))))))
(define integer->string
(lambda (n)
(list->string
(map (lambda (n) (string-ref alphabet n))
(let loop ([m n] [lst '()])
(if (zero? m)
lst
(loop (quotient m 128)
(cons (remainder m 128) lst))))))))
; turn a string into a list of numbers, each no larger than base
(define string->numbers
(lambda (str base)
(letrec ([block-size
(do ([i -1 (1+ i)] [m 1 (* m 128)]) ((>= m base) i))]
[substring-list
(lambda (str)
(let ([ln (string-length str)])
(if (>= block-size ln)
(list str)
(cons (substring str 0 block-size)
(substring-list
(substring str block-size ln))))))])
(map string->integer (substring-list str)))))
; turn a list of numbers into a string
(define numbers->string
(lambda (lst)
(letrec ([reduce
(lambda (f l)
(if (null? (cdr l))
(car l)
(f (car l) (reduce f (cdr l)))))])
(reduce
string-append
(map (lambda (x) (integer->string x)) lst)))))
)
;;; find-prime finds a probable prime between two given arguments.
;;; find-prime uses a cheap but fairly dependable test for primality
;;; for large numbers, by first weeding out multiples of first 200
;;; primes, then applies Fermat's theorem with base 2.
(module (find-prime)
(define product-of-primes
; compute product of first n primes, n > 0
(lambda (n)
(let loop ([n (1- n)] [p 2] [i 3])
(cond
[(zero? n) p]
[(= 1 (gcd i p)) (loop (1- n) (* p i) (+ i 2))]
[else (loop n p (+ i 2))]))))
(define prod-first-200-primes (product-of-primes 200))
(define probable-prime
; first check is quick, and weeds out most non-primes
; second check is slower, but weeds out almost all non-primes
(lambda (p)
(and (= 1 (gcd p prod-first-200-primes))
(= 1 (expt-mod 2 (1- p) p)))))
(define find-prime
; find probable prime in range low to high (inclusive)
(lambda (low high)
(let ([guess
(lambda (low high)
(let ([g (+ low (random (1+ (- high low))))])
(if (odd? g) g (1+ g))))])
(let loop ([g (guess low high)])
(cond
; start over if already too high
[(> g high) (loop (guess low high))]
; if guess is probably prime, return
[(probable-prime g) g]
; don't bother with even guesses
[else (loop (+ 2 g))])))))
)
;;; mod-inverse finds the multiplicative inverse of x mod b, if it exists
(module (mod-inverse)
(define gcdx
; extended Euclid's gcd algorithm, x <= y
(lambda (x y)
(let loop ([x x] [y y] [u1 1] [u2 0] [v1 0] [v2 1])
(if (zero? y)
(list x u1 v1)
(let ([q (quotient x y)] [r (remainder x y)])
(loop y r u2 (- u1 (* q u2)) v2 (- v1 (* q v2))))))))
(define mod-inverse
(lambda (x b)
(let* ([x1 (modulo x b)] [g (gcdx x1 b)])
(unless (= (car g) 1)
(error 'mod-inverse "~d and ~d not relatively prime" x b))
(modulo (cadr g) b))))
)
)