Programming Praxis

There’s nothing particularly hard about this exercise, but there are a lot of pieces. The shift key is represented by a tilde character in these functions that map the alphabet, and we use string-index from the Standard Prelude:

(define alpha "abcdefghijklmnopqrstuvwxyz0123456789.? ~")
(define shift "ABCDEFGHIJKLMNOPQRSTUVWXYZ)!@#$%^&*(,/|~")

(define (c->i c) (string-index c alpha))
(define (i->c i) (string-ref alpha i))

Converting back and forth between strings and internal form requires keeping track of the status of the shift lock:

; 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))))))

We’re ready to look at the cipher algorithm. The initialization and stream-generation are unchanged from the RC4 code of the previous exercise, except that all occurrences of 256 are changed to 40:

(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)))))

In RC4, ciphering and deciphering are symmetric, applying the XOR operator to the key stream. But the XOR operation doesn’t work, because there are only 40 characters in the alphabet instead of 256, so we make functions that add and subtract modulo 40, and provide two similar operations to encipher and decipher:

(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))))))

We won’t show an example here. You can see the encryption and decryption of the sample string at http://ideone.com/RVLOKF.

By the way, Unangst is wrong. In three tries, I never managed to initialize the key by hand, much less decrypt the message; the problem is that a single error propagates to every character that follows. Even though RC40 is clearly simpler to operate than Solitaire, it’s still too hard for me. Maybe it’s a good thing I’m a computer programmer and not a spy using RC40 to send secret messages.

Pages: 1 2