Programming Praxis

We’ll begin with the Playfair cryptography. We want a function that turns a pass phrase into a Polybius square (we use an underscore to make the space character visible):

P r e 5 s i 9 d
4 n t _ O b 2 a
1 m v o C h 8 y
l p T F w c 3 u
f 6 g 7 . A B D
E G H I J K L M
N Q R S U V W X
Y Z j 0 k q x z

The rule is that each letter, period or space in the pass phrase appears once, in row-major order top-to-bottom, left-to-right, in the 8×8 grid, in the same order it appeared in the pass phrase. After the pass phrase is exhausted, the remaining characters are added in the order upper-case letters, lower-case letters, period and space. Digits are always paired with lower-case letters according to the mapping a->1, b->2, …, j->0. We find it easier to store the 8×8 grid as a string rather than a two-dimensional matrix of characters:

(define (make-key pass-phrase)
  (let ((digits '((#\a . #\1) (#\b . #\2) (#\c . #\3)
         (#\d . #\4) (#\e . #\5) (#\f . #\6) (#\g .
         #\7) (#\h . #\8) (#\i . #\9) (#\j . #\0))))
    (let loop ((pass (string->list (string-append
                 pass-phrase "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                 "abcdefghijklmnopqrstuvwxyz" ". ")))
               (key '()))
      (cond ((null? pass) (list->string (reverse key)))
            ((member (car pass) key) (loop (cdr pass) key))
            ((member (car pass) '(#\. #\space))
              (loop (cdr pass) (cons (car pass) key)))
            ((char-alphabetic? (car pass))
             (if (char<=? #\a (car pass) #\j)
                 (loop (cdr pass)
                       (cons (cdr (assoc (car pass) digits))
                             (cons (car pass) key)))
                 (loop (cdr pass) (cons (car pass) key))))
            (else (loop (cdr pass) key))))))

The split function changes slightly from the previous version, because the Playfair alphabet is different:

(define (split str)
  (define (clean str)
    (filter (lambda (c)
              (member c (string-append
                "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                "abcdefghijklmnopqrstuvwxyz"
                "0123456789. ")))
            (string->list str)))
  (let loop ((cs (clean str)) (zs '()))
    (cond ((null? cs) (reverse zs))
          ((null? (cdr cs))
            (reverse (cons (string (car cs) #\X) zs)))
          ((char=? (car cs) (cadr cs))
            (loop (cdr cs) (cons (string (car cs) #\X) zs)))
          (else (loop (cddr cs)
                      (cons (string (car cs) (cadr cs)) zs))))))

The encryption and decryption functions are the same as the previous version, except that every appearance of 5 has been changed to 8:

(define (encipher key plain-text)
  (define (p->c str)
    (let ((a (string-index (string-ref str 0) key))
          (b (string-index (string-ref str 1) key)))
      (cond ((= (quotient a 8) (quotient b 8)) ; same row
              (string (string-ref key (+ (* (quotient a 8) 8) (modulo (+ a 1) 8)))
                      (string-ref key (+ (* (quotient b 8) 8) (modulo (+ b 1) 8)))))
            ((= (modulo a 8) (modulo b 8)) ; same column
              (string (string-ref key (+ (* (modulo (+ (quotient a 8) 1) 8) 8) (modulo a 8)))
                      (string-ref key (+ (* (modulo (+ (quotient b 8) 1) 8) 8) (modulo b 8)))))
            (else (string (string-ref key (+ (* (quotient a 8) 8) (modulo b 8)))
                          (string-ref key (+ (* (quotient b 8) 8) (modulo a 8))))))))
  (apply string-append (map p->c (split plain-text))))

(define (decipher key cipher-text)
  (define (c->p str)
    (let ((a (string-index (string-ref str 0) key))
          (b (string-index (string-ref str 1) key)))
      (cond ((= (quotient a 8) (quotient b 8)) ; same row
              (string (string-ref key (+ (* (quotient a 8) 8) (modulo (- a 1) 8)))
                      (string-ref key (+ (* (quotient b 8) 8) (modulo (- b 1) 8)))))
            ((= (modulo a 8) (modulo b 8)) ; same column
              (string (string-ref key (+ (* (modulo (- (quotient a 8) 1) 8) 8) (modulo a 8)))
                      (string-ref key (+ (* (modulo (- (quotient b 8) 1) 8) 8) (modulo b 8)))))
            (else (string (string-ref key (+ (* (quotient a 8) 8) (modulo b 8)))
                          (string-ref key (+ (* (quotient b 8) 8) (modulo a 8))))))))
  (apply string-append (map c->p (split cipher-text))))

Now for the steganography. The first thing we need is a list of words, from which we can choose a word at random, where a word is defined as a maximal sequence of non-space characters. Valid? deletes words with space characters and those longer than eight characters, because longer words are more prone to errors in counting:

(define (valid? word)
  (and (all? char-alphabetic? (string->list word))
       (< (string-length word) 9)))

And here’s the code to read the word list, one word per line, producing a vector of valid strings; we use input combinators from the Standard Prelude, and store the dictionary and its length in global variables:

(define (read-dict file-name)
  (list->vector (fold-input (filter-input read-line valid?) (swap cons) '() file-name)))

(define dict (read-dict "moby.common"))

(define dict-len (vector-length dict))

Once we have the dictionary, it is easy to write the function that gets a random word of the appropriate length; notice the “can’t happen” message, which sadly appeared more than once during the development of the program:

(define (get-word b)
  (case b
    ((0) (let ((w (vector-ref dict (randint dict-len))))
           (if (even? (string-length w)) w (get-word b))))
    ((1) (let ((w (vector-ref dict (randint dict-len))))
           (if (odd? (string-length w)) w (get-word b))))
    (else (error 'get-word "can't happen"))))

To hide a message, we first convert it to binary digits using an alphabet, then convert the message letter-by-letter, choosing a new random word for each digit:

(define alpha
  (map (lambda (c n)
         (let ((ds (digits n 2)))
           (cons c (append (make-list (- 6 (length ds)) 0) ds))))
       (string->list (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
         "abcdefghijklmnopqrstuvwxyz" "0123456789" ". "))
       (range 64)))

(define (hide str)
  (string-join #\space (map get-word
    (mappend (lambda (c) (cdr (assoc c alpha))) (string->list str)))))

Extracting a message is the inverse operation, converting to binary digits, and taking the digits six-at-a-time, and using an inverse alphabet to convert back to letters:

(define inverse-alpha
  (map (lambda (xs) (cons (cdr xs) (car xs))) alpha))

(define (unhide str)
  (define (convert d) (if (even? d) 0 1))
  (let loop ((ds (map convert (map string-length (string-split #\space str)))) (cs '()))
    (if (null? ds) (apply string (reverse cs))
      (let ((c (cdr (assoc (take 6 ds) inverse-alpha))))
        (loop (drop 6 ds) (cons c cs))))))

Here’s an example, using the key given above and the message Programming Praxis:

> (define key-20110606 (make-key (string-append "President Obama's"
" visit to a Chrysler plant in Toledo, Ohio, on Friday was the"
" culmination of a campaign to portray the auto bailouts as a"
" brilliant success with no unpleasant side effects.")))
> key-20110606
"Pre5si9d4nt Ob2a1mvoCh8ylpTFwc3uf6g7.ABDEGHIJKLMNQRSUVWXYZj0kqxz"
> (define spam (hide (encipher key-20110606 "Programming Praxis")))
> spam
"subduct mythos qua backrest chanter Kioto cronyism Lettish Badajoz Saida moody
megavolt gondola coward Tibetan stoss andiron magenta Biisk Henry tumbler coquet
SHAPE affable flattery blear Bahaism lance meteor limbate hit anyway yoni Hengi
st phaeton Papua snick whiffle ankh Firdausi Chaplin triolein ampliate hum putsc
h desire buttocks Golconda groat fickle mensural utopia oecology scapula bruit S
tuart foamy Jane futures Vedic Halifax misquote agitate whereon resonate melodic
aground smoky muezzin riddance Aarau dB elm robin bugloss duckbill pe last pow
chanter winglet temporal yeanling Sidon Auckland regimen Cheviot skatole gobo sp
lenic neolith amid braiding lowlife riant Sunnite styrene ywis teacart flyspeck
deplore chyack Titan Percy hidalgo sniffle unbridle zig kinsfolk immense opaline
bebeeru heeled topsail yurt lobby trucking stridor Selden mullet"
> (decipher key-20110606 (unhide spam))
"ProgramXming PraxisX"

This crypto/stego system is rather more secure than Clancy’s, but still not “good” in any objective sense. Playfair hasn’t been good crypto for decades, but neither is it entirely bad crypto, and the 8×8 grid is stronger than the usual 5×5 grid. If you do a good job of key management (change to a different newspaper each week, or a web site, or the first sentence in each chapter of Oprah’s current book-of-the-month selection) and keep messages short (a few hundred characters, preferably less than 64) and infrequent (one or two per week, never more than one per day), the crypto won’t be awful. The stego depends on how much work you do to hide the message; a single message once a week to a known terrorist email address isn’t a good idea, but thousands of spam messages a week, from hundreds of emailers, makes a big enough haystack so it’s hard for the cryptanalyst to find the needle.

Incidentally, a terrorist working the steganography manually has more options than we have with our random dictionary words. The terrorist can choose words that make sense, and add punctuation or other characters to get the counts he needs. For instance, terrorists might communicate by hiding their messages in recipes — who would think that a recipe for veal parmigiana is actually a message to blow up a church?

We used a bunch of functions from the Standard Prelude: take, drop, range, mappend, all?, make-list, fold-input, read-line, filter-input, string-index, string-split, string-join, swap, rand and randint. You can run the program at http://programmingpraxis.codepad.org/ryMtgPbD.

Pages: 1 2