; rc40
(define (string-index c str)
(let loop ((ss (string->list str)) (k 0))
(cond ((null? ss) #f)
((char=? (car ss) c) k)
(else (loop (cdr ss) (+ k 1))))))
; tilde represents shift
(define alpha "abcdefghijklmnopqrstuvwxyz0123456789.? ~")
(define shift "ABCDEFGHIJKLMNOPQRSTUVWXYZ)!@#$%^&*(,/|~")
(define (c->i c) (string-index c alpha))
(define (i->c i) (string-ref alpha i))
; convert list [~burrito ~~sale~~ 2 ~2 ~47.99] to "Burrito SALE 2 @ $7.99"
(define (rc40->string cs)
(let loop ((cs cs) (locked? #f) (ss (list)))
(cond ((null? cs) (list->string (reverse ss)))
((and locked? (pair? (cdr cs)) (char=? (car cs) #\~) (char=? (cadr cs) #\~))
(loop (cddr cs) #f ss))
(locked? (loop (cdr cs) #t (cons (string-ref shift (c->i (car cs))) ss)))
((and (pair? (cdr cs)) (char=? (car cs) #\~) (char=? (cadr cs) #\~))
(loop (cddr cs) #t ss))
((and (pair? cs) (char=? (car cs) #\~))
(loop (cddr cs) #f (cons (string-ref shift (c->i (cadr cs))) ss)))
(else (loop (cdr cs) #f (cons (car cs) ss))))))
; convert "Burrito SALE 2 @ $7.99" to list [~burrito ~~sale~~ 2 ~2 ~47.99]
(define (string->rc40 str)
(let loop ((cs (string->list str)) (locked? #f) (ss (list)))
(cond ((null? cs)
(if locked?
(reverse (cons #\~ (cons #\~ ss)))
(reverse ss)))
(locked?
(if (string-index (car cs) shift)
(loop (cdr cs) #t
(cons (string-ref alpha (string-index (car cs) shift)) ss))
(loop cs #f (cons #\~ (cons #\~ ss)))))
((string-index (car cs) shift)
(if (and (pair? (cdr cs)) (string-index (cadr cs) shift))
(loop cs #t (cons #\~ (cons #\~ ss)))
(loop (cdr cs) #f
(cons (string-ref alpha (string-index (car cs) shift))
(cons #\~ ss)))))
(else (loop (cdr cs) #f (cons (car cs) ss))))))
(define (rc40-init key)
(let ((kvec (make-vector 40)) (klen (string-length key)) (j 0)
(key (list->string (string->rc40 key))))
(do ((i 0 (+ i 1))) ((= i 40)) (vector-set! kvec i i))
(do ((i 0 (+ i 1))) ((= i 40) kvec)
(set! j (modulo (+ j (vector-ref kvec i)
(c->i (string-ref key (modulo i klen)))) 40))
(let ((t (vector-ref kvec i)))
(vector-set! kvec i (vector-ref kvec j))
(vector-set! kvec j t)))))
(define (rc40-stream key)
(let ((i 0) (j 0) (kvec (rc40-init key)))
(lambda ()
(set! i (modulo (+ i 1) 40))
(set! j (modulo (+ j (vector-ref kvec i)) 40))
(let ((t (vector-ref kvec j)))
(vector-set! kvec j (vector-ref kvec i))
(vector-set! kvec i t))
(vector-ref kvec (modulo (+ (vector-ref kvec i) (vector-ref kvec j)) 40)))))
(define (rc40-plus a b) (modulo (+ a b) 40))
(define (rc40-minus a b) (modulo (- b a) 40))
(define (rc40-encipher key text)
(let ((rc40 (rc40-stream key)))
(let loop ((ts (map c->i (string->rc40 text))) (zs '()))
(if (null? ts) (rc40->string (map i->c (reverse zs)))
(loop (cdr ts) (cons (rc40-plus (rc40) (car ts)) zs))))))
(define (rc40-decipher key text)
(let ((rc40 (rc40-stream key)))
(let loop ((ts (map c->i (string->rc40 text))) (zs '()))
(if (null? ts) (rc40->string (map i->c (reverse zs)))
(loop (cdr ts) (cons (rc40-minus (rc40) (car ts)) zs))))))
(display (rc40-encipher "tedunangst" "Programming Praxis sharpens your saw.")) (newline)
(display (rc40-decipher "tedunangst" "5cxaxlfrfhy6kh38fbplm0mDko58xs.l9Hkz8")) (newline)