codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; rabin's cryptosystem (define (split n xs) (let loop ((n n) (xs xs) (zs '())) (if (or (zero? n) (null? xs)) (values (reverse zs) xs) (loop (- n 1) (cdr xs) (cons (car xs) zs))))) (define rand #f) (define randint #f) (let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f)) (define (mod-diff x y) (modulo (- x y) two31)) ; generic version ; (define (mod-diff x y) (logand (- x y) #x7FFFFFFF)) ; fast version (define (flip-cycle) (do ((ii 1 (+ ii 1)) (jj 32 (+ jj 1))) ((< 55 jj)) (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj)))) (do ((ii 25 (+ ii 1)) (jj 1 (+ jj 1))) ((< 55 ii)) (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj)))) (set! fptr 54) (vector-ref a 55)) (define (init-rand seed) (let* ((seed (mod-diff seed 0)) (prev seed) (next 1)) (vector-set! a 55 prev) (do ((i 21 (modulo (+ i 21) 55))) ((zero? i)) (vector-set! a i next) (set! next (mod-diff prev next)) (set! seed (+ (quotient seed 2) (if (odd? seed) #x40000000 0))) (set! next (mod-diff next seed)) (set! prev (vector-ref a i))) (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle))) (define (next-rand) (if (negative? (vector-ref a fptr)) (flip-cycle) (let ((next (vector-ref a fptr))) (set! fptr (- fptr 1)) next))) (define (unif-rand m) (let ((t (- two31 (modulo two31 m)))) (let loop ((r (next-rand))) (if (<= t r) (loop (next-rand)) (modulo r m))))) (init-rand 19380110) ; happy birthday donald e knuth (set! rand (lambda seed (cond ((null? seed) (/ (next-rand) two31)) ((eq? (car seed) 'get) (cons fptr (vector->list a))) ((eq? (car seed) 'set) (set! fptr (caadr seed)) (set! a (list->vector (cdadr seed)))) (else (/ (init-rand (modulo (numerator (inexact->exact (car seed))) two31)) two31))))) (set! randint (lambda args (cond ((null? (cdr args)) (if (< (car args) two31) (unif-rand (car args)) (floor (* (next-rand) (car args))))) ((< (car args) (cadr args)) (let ((span (- (cadr args) (car args)))) (+ (car args) (if (< span two31) (unif-rand span) (floor (* (next-rand) span)))))) (else (let ((span (- (car args) (cadr args)))) (- (car args) (if (< span two31) (unif-rand span) (floor (* (next-rand) span)))))))))) (define (expm b e m) (define (m* x y) (modulo (* x y) m)) (cond ((zero? e) 1) ((even? e) (expm (m* b b) (/ e 2) m)) (else (m* b (expm (m* b b) (/ (- e 1) 2) m))))) (define (euclid x y) (let loop ((a 1) (b 0) (g x) (u 0) (v 1) (w y)) (if (zero? w) (values a b g) (let ((q (quotient g w))) (loop u v w (- a (* q u)) (- b (* q v)) (- g (* q w))))))) (define (prime? n) (define (expm b e m) (define (m* x y) (modulo (* x y) m)) (cond ((zero? e) 1) ((even? e) (expm (m* b b) (/ e 2) m)) (else (m* b (expm (m* b b) (/ (- e 1) 2) m))))) (define (digits n . args) (let ((b (if (null? args) 10 (car args)))) (let loop ((n n) (d '())) (if (zero? n) d (loop (quotient n b) (cons (modulo n b) d)))))) (define (isqrt n) (let loop ((x n) (y (quotient (+ n 1) 2))) (if (<= 0 (- y x) 1) x (loop y (quotient (+ y (quotient n y)) 2))))) (define (square? n) (let ((n2 (isqrt n))) (= n (* n2 n2)))) (define (jacobi a n) (if (not (and (integer? a) (integer? n) (positive? n) (odd? n))) (error 'jacobi "modulus must be positive odd integer") (let jacobi ((a a) (n n)) (cond ((= a 0) 0) ((= a 1) 1) ((= a 2) (case (modulo n 8) ((1 7) 1) ((3 5) -1))) ((even? a) (* (jacobi 2 n) (jacobi (quotient a 2) n))) ((< n a) (jacobi (modulo a n) n)) ((and (= (modulo a 4) 3) (= (modulo n 4) 3)) (- (jacobi n a))) (else (jacobi n a)))))) (define (inverse x n) (let loop ((x (modulo x n)) (a 1)) (cond ((zero? x) (error 'inverse "division by zero")) ((= x 1) a) (else (let ((q (- (quotient n x)))) (loop (+ n (* q x)) (modulo (* q a) n))))))) (define (miller? n a) (let loop ((r 0) (s (- n 1))) (if (even? s) (loop (+ r 1) (/ s 2)) (if (= (expm a s n) 1) #t (let loop ((r r) (s s)) (cond ((zero? r) #f) ((= (expm a s n) (- n 1)) #t) (else (loop (- r 1) (* s 2))))))))) (define (chain m f g x0 x1) (let loop ((ms (digits m 2)) (u x0) (v x1)) (cond ((null? ms) (values u v)) ((zero? (car ms)) (loop (cdr ms) (f u) (g u v))) (else (loop (cdr ms) (g u v) (f v)))))) (define (lucas? n) (let loop ((a 11) (b 7)) (let ((d (- (* a a) (* 4 b)))) (cond ((square? d) (loop (+ a 2) (+ b 1))) ((not (= (gcd n (* 2 a b d)) 1)) (loop (+ a 2) (+ b 2))) (else (let* ((x1 (modulo (- (* a a (inverse b n)) 2) n)) (m (quotient (- n (jacobi d n)) 2)) (f (lambda (u) (modulo (- (* u u) 2) n))) (g (lambda (u v) (modulo (- (* u v) x1) n)))) (let-values (((xm xm1) (chain m f g 2 x1))) (zero? (modulo (- (* x1 xm) (* 2 xm1)) n))))))))) (cond ((or (not (integer? n)) (< n 2)) (error 'prime? "must be integer greater than one")) ((even? n) (= n 2)) ((zero? (modulo n 3)) (= n 3)) (else (and (miller? n 2) (miller? n 3) (lucas? n))))) (define (splits n xs) (let loop ((xs xs) (zs (list))) (if (null? xs) (reverse zs) (call-with-values (lambda () (split n xs)) (lambda (head tail) (loop tail (cons head zs))))))) (define (keygen k) (define (gen k) (let loop ((v (randint (expt 2 (- k 1)) (expt 2 k)))) (if (and (prime? v) (= (modulo v 4) 3)) v (loop (+ v 1))))) (let* ((k2 (quotient k 2)) (p (gen k2)) (q (gen k2)) (n (* p q))) (call-with-values (lambda () (euclid p q)) (lambda (a b g) (values n p q a b))))) (define (encrypt m n) (let ((m (+ (* m 256) 255))) (expm m 2 n))) (define (decrypt c n p q a b) (let* ((r (expm c (/ (+ p 1) 4) p)) (s (expm c (/ (+ q 1) 4) q)) (aps (* a p s)) (bqr (* b q r)) (x (modulo (+ aps bqr) n)) (y (modulo (- aps bqr) n)) (m1 x) (m2 (modulo (- x) n)) (m3 y) (m4 (modulo (- y) n))) (cond ((= (remainder m1 256) 255) (quotient m1 256)) ((= (remainder m2 256) 255) (quotient m2 256)) ((= (remainder m3 256) 255) (quotient m3 256)) ((= (remainder m4 256) 255) (quotient m4 256)) (else (error 'decrypt "oops"))))) (define (prepare str n) (let ((len (- n (modulo (string-length str) n)))) (string->list (string-append str (make-string len (integer->char len)))))) (define (unprepare xs) (let loop ((xs (reverse xs))) (if (char=? (car xs) (cadr xs)) (loop (cdr xs)) (reverse (cdr xs))))) (define (chars->num cs) (let loop ((cs cs) (n 0)) (if (null? cs) n (loop (cdr cs) (+ (* n 256) (char->integer (car cs))))))) (define (num->chars n) (let loop ((n n) (cs (list))) (if (zero? n) cs (loop (quotient n 256) (cons (integer->char (remainder n 256)) cs))))) (define (encipher plaintext key blocksize) (list->string (apply append (map num->chars (map (lambda (m) (encrypt m key)) (map chars->num (splits blocksize (prepare plaintext blocksize)))))))) (define (decipher ciphertext n p q a b blocksize) (list->string (unprepare (apply append (map num->chars (map (lambda (c) (decrypt c n p q a b)) (map chars->num (splits (+ blocksize 1) (string->list ciphertext))))))))) (display (decipher (encipher "Programming Praxis" 2090723993 3) 2090723993 61027 34259 -14246 25377 3))
Private
[
?
]
Run code
Submit