codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; data encryption standard (define (vector-map proc . vecs) (define (elt i) (lambda (vec) (vector-ref vec i))) (let* ((len (vector-length (car vecs))) (result (make-vector len))) (do ((i 0 (+ i 1))) ((= i len) result) (vector-set! result i (apply proc (map (elt i) vecs)))))) (define (vector-permute rule vec) (let* ((len (vector-length rule)) (result (make-vector len))) (do ((i 0 (+ i 1))) ((= i len) result) (vector-set! result i (vector-ref vec (vector-ref rule i)))))) (define (vector-cycle shift vec) ; positive => left, negative => right (let* ((len (vector-length vec)) (result (make-vector len))) (do ((i 0 (+ i 1))) ((= i len) result) (let ((j (modulo (+ i shift) len))) (vector-set! result i (vector-ref vec j)))))) (define (vector-slice vec start len) (let ((result (make-vector len))) (do ((i 0 (+ i 1))) ((= i len) result) (vector-set! result i (vector-ref vec (+ i start)))))) (define (vector-slice-by n vec) (let* ((len (vector-length vec))) (let loop ((k 0) (result '())) (if (= k len) (reverse result) (loop (+ k n) (cons (vector-slice vec k n) result)))))) (define (vector-append . vecs) (let* ((len (apply + (map vector-length vecs))) (result (make-vector len))) (let loop ((i 0) (j 0) (vecs vecs)) (cond ((null? vecs) result) ((= (vector-length (car vecs)) j) (loop i 0 (cdr vecs))) (else (vector-set! result i (vector-ref (car vecs) j)) (loop (+ i 1) (+ j 1) vecs)))))) (define (vector-xor vec1 vec2) (define (xor a b) (if (= a b) 0 1)) (vector-map xor vec1 vec2)) (define (undigits ds . args) (let ((b (if (null? args) 10 (car args)))) (let loop ((ds ds) (n 0)) (if (null? ds) n (loop (cdr ds) (+ (* n b) (car ds))))))) (define (n->bits n) (let ((bv (list->vector '((0 0 0 0) (0 0 0 1) (0 0 1 0) (0 0 1 1) (0 1 0 0) (0 1 0 1) (0 1 1 0) (0 1 1 1) (1 0 0 0) (1 0 0 1) (1 0 1 0) (1 0 1 1) (1 1 0 0) (1 1 0 1) (1 1 1 0) (1 1 1 1))))) (vector-ref bv n))) (define (char->bits c) (n->bits (- (char->integer (char-upcase c)) (if (char-numeric? c) 48 55)))) (define (bits->char bits) (let ((n (undigits (vector->list bits) 2))) (integer->char (+ n (if (< n 10) 48 55))))) (define (hex->bits hex) (list->vector (apply append (map char->bits (string->list hex))))) (define (bits->hex vec) (list->string (map bits->char (vector-slice-by 4 vec)))) (define (ascii->bits txt) (list->vector (apply append (map (lambda (c) (let ((x (char->integer c))) (append (n->bits (quotient x 16)) (n->bits (modulo x 16))))) (string->list txt))))) (define (bits->ascii bits) (list->string (map integer->char (map (lambda (v) (undigits (vector->list v) 2)) (vector-slice-by 8 bits))))) (define (check-parity? key) (let loop ((ks (vector-slice-by 8 key))) (cond ((null? ks) #t) ((even? (apply + (vector->list (car ks)))) #f) (else (loop (cdr ks)))))) (define (pc1 key) (let ((rule #( 57 49 41 33 25 17 9 1 58 50 42 34 26 18 10 2 59 51 43 35 27 19 11 3 60 52 44 36 63 55 47 39 31 23 15 7 62 54 46 38 30 22 14 6 61 53 45 37 29 21 13 5 28 20 12 4))) (vector-permute (vector-map sub1 rule) key))) (define (ls i key) (let ((rule #(1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1))) (vector-cycle (vector-ref rule i) key))) (define (pc2 key) (let ((rule #( 14 17 11 24 1 5 3 28 15 6 21 10 23 19 12 4 26 8 16 7 27 20 13 2 41 52 31 37 47 55 30 40 51 45 33 48 44 49 39 56 34 53 46 42 50 36 29 32))) (vector-permute (vector-map sub1 rule) key))) (define (key-schedule key) (let ((c (make-vector 17 #f)) (d (make-vector 17 #f)) (k (make-vector 17 #f)) (c0d0 (pc1 key))) (vector-set! c 0 (vector-slice c0d0 0 28)) (vector-set! d 0 (vector-slice c0d0 28 28)) (do ((i 1 (+ i 1))) ((< 16 i) k) (vector-set! c i (ls (- i 1) (vector-ref c (- i 1)))) (vector-set! d i (ls (- i 1) (vector-ref d (- i 1)))) (vector-set! k i (pc2 (vector-append (vector-ref c i) (vector-ref d i))))))) (define (ip data) (let ((rule #( 58 50 42 34 26 18 10 2 60 52 44 36 28 20 12 4 62 54 46 38 30 22 14 6 64 56 48 40 32 24 16 8 57 49 41 33 25 17 9 1 59 51 43 35 27 19 11 3 61 53 45 37 29 21 13 5 63 55 47 39 31 23 15 7))) (vector-permute (vector-map sub1 rule) data))) (define (e data) (let ((rule #( 32 1 2 3 4 5 4 5 6 7 8 9 8 9 10 11 12 13 12 13 14 15 16 17 16 17 18 19 20 21 20 21 22 23 24 25 24 25 26 27 28 29 28 29 30 31 32 1))) (vector-permute (vector-map sub1 rule) data))) (define (s vec) (define (b->s j) (let* ((sbox #( #(14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7 ; 1 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0 15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13) #(15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10 ; 2 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15 13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9) #(10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8 ; 3 13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1 13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12) #( 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15 ; 4 13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9 10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14) #( 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9 ; 5 14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14 11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3) #(12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11 ; 6 10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13) #( 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1 ; 7 13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12) #(13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7 ; 8 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11))) (m1 (vector-ref vec (* j 6))) (m2 (vector-ref vec (+ (* j 6) 5))) (m (undigits (list m1 m2) 2)) (n (undigits (vector->list (vector-slice vec (+ (* j 6) 1) 4)) 2))) (vector-ref (vector-ref sbox j) (+ (* m 16) n)))) (let loop ((j 0) (result '())) (if (= j 8) (list->vector (apply append (map n->bits (reverse result)))) (loop (+ j 1) (cons (b->s j) result))))) (define (p data) (let ((rule #( 16 7 20 21 29 12 28 17 1 15 23 26 5 18 31 10 2 8 24 14 32 27 3 9 19 13 30 6 22 11 4 25))) (vector-permute (vector-map sub1 rule) data))) (define (fp data) (let ((rule #( 40 8 48 16 56 24 64 32 39 7 47 15 55 23 63 31 38 6 46 14 54 22 62 30 37 5 45 13 53 21 61 29 36 4 44 12 52 20 60 28 35 3 43 11 51 19 59 27 34 2 42 10 50 18 58 26 33 1 41 9 49 17 57 25))) (vector-permute (vector-map sub1 rule) data))) (define (f x k) (p (s (vector-xor (e x) k)))) (define (encipher ks block) (let ((l (make-vector 17 #f)) (r (make-vector 17 #f)) (l0r0 (ip block))) (vector-set! l 0 (vector-slice l0r0 0 32)) (vector-set! r 0 (vector-slice l0r0 32 32)) (do ((i 1 (+ i 1))) ((< 16 i) (fp (vector-append (vector-ref r 16) (vector-ref l 16)))) (vector-set! l i (vector-ref r (- i 1))) (vector-set! r i (vector-xor (vector-ref l (- i 1)) (f (vector-ref r (- i 1)) (vector-ref ks i))))))) (define (decipher ks block) (let ((l (make-vector 17 #f)) (r (make-vector 17 #f)) (r16l16 (ip block))) (vector-set! r 16 (vector-slice r16l16 0 32)) (vector-set! l 16 (vector-slice r16l16 32 32)) (do ((i 16 (- i 1))) ((= i 0) (fp (vector-append (vector-ref l 0) (vector-ref r 0)))) (vector-set! r (- i 1) (vector-ref l i)) (vector-set! l (- i 1) (vector-xor (vector-ref r i) (f (vector-ref l i) (vector-ref ks i))))))) ; > (bits->hex ; (encipher ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (ascii->bits "ProgPrax"))) ; "CC99EA46B16E2890" ; > (bits->ascii ; (decipher ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (hex->bits "CC99EA46B16E2890"))) ; "ProgPrax" (define (pad txt) (let ((c0 (integer->char 0)) (s128 (string (integer->char 128)))) (string-append txt s128 (make-string (- 7 (modulo (string-length txt) 8)) c0)))) (define (unpad txt) (do ((i (- (string-length txt) 1) (- i 1))) ((= (char->integer (string-ref txt i)) 128) (substring txt 0 i)))) (define (read8 port) (let loop ((n 7) (c (read-char port)) (cs '())) (cond ((eof-object? c) (if (null? cs) c (list->string (reverse cs)))) ((zero? n) (list->string (reverse (cons c cs)))) (else (loop (- n 1) (read-char port) (cons c cs)))))) (define (ecb-encipher ks port) (define (encode txt) (encipher ks (ascii->bits txt))) (let loop ((txt (read8 port))) (cond ((eof-object? txt) (display (bits->ascii (encode (pad ""))))) ((< (string-length txt) 8) (display (bits->ascii (encode (pad txt))))) (else (display (bits->ascii (encode txt))) (loop (read8 port)))))) (define (ecb-decipher ks port) (define (decode txt) (decipher ks (ascii->bits txt))) (let ((txt (read8 port))) (if (eof-object? txt) (error 'ecb-decipher "no data") (let loop ((txt txt) (next (read8 port))) (if (eof-object? next) (display (unpad (bits->ascii (decode txt)))) (begin (display (bits->ascii (decode txt))) (loop next (read8 port)))))))) ; > (with-input-from-string "Programming Praxis" ; (lambda () ; (ecb-encipher ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; asdfasdfasdfasdfasdfasdf ; > (with-input-from-string "asdfasdfasdfasdfasdfasdf" ; (lambda () ; (ecb-decipher ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; Programming Praxis (define (cbc-encipher iv ks port) (define (encode prev txt) (encipher ks (vector-xor (ascii->bits txt) prev))) (let loop ((prev iv) (txt (read8 port))) (cond ((eof-object? txt) (display (bits->ascii (encode prev (pad ""))))) ((< (string-length txt) 8) (display (bits->ascii (encode prev (pad txt))))) (else (let ((next (encode prev txt))) (display (bits->ascii next)) (loop next (read8 port))))))) (define (cbc-decipher iv ks port) (define (decode prev txt) (vector-xor (decipher ks (ascii->bits txt)) prev)) (let loop ((prev iv) (txt (read8 port))) (if (eof-object? (peek-char port)) (display (unpad (bits->ascii (decode prev txt)))) (let ((next (decode prev txt))) (display (bits->ascii next)) (loop (ascii->bits txt) (read8 port)))))) ; > (with-input-from-string "Programming Praxis" ; (lambda () ; (cbc-encipher ; (ascii->bits "ProgPrax") ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; asdfasdfasdfasdfasdfasdf ; > (with-input-from-string "asdfasdfasdfasdfasdfasdf" ; (lambda () ; (cbc-decipher ; (ascii->bits "ProgPrax") ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; Programming Praxis (define (cfb-encipher iv ks port) (define (encode prev txt) (vector-xor (encipher ks prev) (ascii->bits txt))) (let loop ((prev iv) (txt (read8 port))) (when (not (eof-object? txt)) (let ((len (string-length txt))) (if (= len 8) (let ((next (encode prev txt))) (display (bits->ascii next)) (loop next (read8 port))) (display (bits->ascii (vector-slice (encode prev (pad txt)) 0 (* 8 len))))))))) (define (cfb-decipher iv ks port) (define (encode prev txt) (vector-xor (encipher ks prev) (ascii->bits txt))) (let loop ((prev iv) (txt (read8 port))) (when (not (eof-object? txt)) (let ((len (string-length txt))) (if (= len 8) (let ((next (encode prev txt))) (display (bits->ascii next)) (loop (ascii->bits txt) (read8 port))) (display (bits->ascii (vector-slice (encode prev (pad txt)) 0 (* 8 len))))))))) ; > (with-input-from-string "Programming Praxis" ; (lambda () ; (cfb-encipher ; (ascii->bits "ProgPrax") ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; asdfasdfasdfasdfas ; > (with-input-from-string "asdfasdfasdfasdfas" ; (lambda () ; (cfb-decipher ; (ascii->bits "ProgPrax") ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; Programming Praxis (define (ofb-encipher iv ks port) (do ((txt (read8 port) (read8 port)) (o (encipher ks iv) (encipher ks o))) ((eof-object? txt)) (display (bits->ascii (if (= (string-length txt) 8) (vector-xor (ascii->bits txt) o) (let* ((bits (ascii->bits txt)) (len (vector-length bits))) (vector-xor bits (vector-slice o 0 len)))))))) (define ofb-decipher ofb-encipher) ; > (with-input-from-string "Programming Praxis" ; (lambda () ; (ofb-encipher ; (ascii->bits "ProgPrax") ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; asdfasdfasdfasdfas ; > (with-input-from-string "asdfasdfasdfasdfas" ; (lambda () ; (ofb-decipher ; (ascii->bits "ProgPrax") ; (key-schedule (hex->bits "0123456789ABCDEF")) ; (current-input-port)))) ; Programming Praxis
Private
[
?
]
Run code
Submit