Main program
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
#!/usr/bin/guile \ -e main -s !# (use-modules (srfi srfi-1) (srfi srfi-4) (ice-9 getopt-long)) (define (u8+ . args) (logand (apply + args) 255)) (define (make-sbox key rounds) (let ((sbox (apply u8vector (iota 256))) (s2 (apply vector (take (apply circular-list (map char->integer (string->list key))) 256))) (j 0)) (do ((k rounds (- k 1))) ((< k 1)) (for-each (lambda (i) (let ((temp (u8vector-ref sbox i))) (set! j (u8+ j temp (vector-ref s2 i))) (u8vector-set! sbox i (u8vector-ref sbox j)) (u8vector-set! sbox j temp))) (iota 256))) (vector-fill! s2 0) sbox)) (define (crypt-loop sbox) (let loop ((i 1) (j 0)) (let ((ch (read-char))) (if (not (eof-object? ch)) (let* ((temp (u8vector-ref sbox i)) (newj (u8+ j temp))) (u8vector-set! sbox i (u8vector-ref sbox newj)) (u8vector-set! sbox newj temp) (let ((val (u8vector-ref sbox (u8+ (u8vector-ref sbox i) temp)))) (write-char (integer->char (logxor (char->integer ch) val))) (loop (u8+ i 1) newj))))))) (define (do-crypt key iv rounds) (crypt-loop (make-sbox (string-append key iv) rounds))) (define (encrypt key rounds) (let ((iv (call-with-input-file "/dev/urandom" (lambda (port) (setvbuf port _IOFBF 10) (string-tabulate (lambda (i) (read-char port)) 10))))) (display iv) (do-crypt key iv rounds))) (define (decrypt key rounds) (let ((iv (string-tabulate (lambda (i) (read-char)) 10))) (do-crypt key iv rounds))) (define (main args) (let* ((options (getopt-long args `((key (single-char #\k) (required? #t) (value #t)) (rounds (single-char #\n) (value #t) (predicate ,string->number)) (decrypt (single-char #\d))))) (key (option-ref options 'key #f)) (rounds (string->number (option-ref options 'rounds "20"))) (decrypt? (option-ref options 'decrypt #f))) ((if decrypt? decrypt encrypt) key rounds)))
Refactorings
No refactoring yet !
Chris Jester-Young
June 22, 2008, June 22, 2008 11:16, permalink
No rating.
Login to rate!
Looking at the code, I just realised that the IV-reading in the decryption step only works correctly for a left-to-right string-building order (which is something not guaranteed by string-tabulate). I also welcome any good suggestions for fixing this: the best I can think of, at the moment, is to use reverse-list->string with unfold-right (both of which have efficient implementations in Guile).
The use of "1-" is a Guile-ism, but makes the code much easier to read. :-P
New decrypt function
1 2 3 4 5 6 7
(define (decrypt key rounds) (let ((iv (reverse-list->string (unfold-right zero? (lambda (i) (read-char)) 1- 10)))) (do-crypt key iv rounds))) ;; For non-Guile users: (define (1- x) (- x 1))
Apparently the last Scheme posting was half a year ago, so let's have more!
Quick executive summary of the code: CipherSaber (http://ciphersaber.gurus.org/) uses Arcfour (http://www.mozilla.org/projects/security/pki/nss/draft-kaukonen-cipher-arcfour-03.txt) for encryption, and the first 10 bytes of the encrypted file is the IV, which is appended to the user-specified key when keying the S-box.
I'm currently learning Scheme, and figure I could get some feedback on how to write more "idiomatic" Scheme programs...there are some things in my code at the moment that I'm not very happy with, like the "do" loop...I'm sure there's an analogue to Ruby "each" function that I'm yet to learn about. :-) I also don't see an easy way to avoid set!-ting j in the S-box setup loop...unlike in the main crypt loop.
There are also some Guile-isms in the code, like using logand/logxor without importing SRFI 60, getopt-long, and setvbuf. And Unixisms, like reading /dev/urandom. Apart from those, the code should be fairly "standard" R5RS.