Elsie Four

March 27, 2018

My solution doesn’t work; it encrypts properly, according to the example in Kaminsky’s appendix, but doesn’t decrypt, and I don’t know why. Here is my code, which ignores the header, just as Kaminsky does:

; elsie four

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (make-matrix rows columns . value)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)
    (if (null? value)
        (vector-set! m i (make-vector columns))
        (vector-set! m i (make-vector columns (car value))))))

(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))

(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))

(define (string->ints str)
  (define (c->i c)
    (cond ((char=? c #\#) 0) ((char=? c #\_) 1)
          ((char<=? #\2 c #\9) (- (char->integer c) (char->integer #\0)))
          ((char<=? #\a c #\z) (- (char->integer c) (char->integer #\a) -10))
          ((char<=? #\A c #\Z) (- (char->integer c) (char->integer #\A) -10))
          (else (error 'string->ints "unrecognized character"))))
  (map c->i (string->list str)))

(define (ints->string ints)
  (define (i->c i)
    (cond ((or (< i 0) (< 35 i)) (error 'ints->string "unrecognized character"))
          ((= i 0) #\#) ((= i 1) #\_)
          ((< i 10) (integer->char (+ (char->integer #\0) i)))
          (else (integer->char (+ (char->integer #\A) i -10)))))
  (list->string (map i->c ints)))

(define (initialize-state key)
  (let ((xs (string->ints key)) (state (make-matrix 6 6)))
    (do ((k 0 (+ k 1)) (xs xs (cdr xs))) ((null? xs) state)
      (matrix-set! state (quotient k 6) (modulo k 6) (car xs)))))

(define (find s x)
  (let loop ((k 0))
    (let ((r (quotient k 6)) (c (modulo k 6)))
      (if (= (matrix-ref s r c) x) (values r c)
        (loop (+ k 1))))))

(define (advance-state state i j r c x y ct)
  (let ((t (matrix-ref state r 5)))
    (matrix-set! state r 5 (matrix-ref state r 4))
    (matrix-set! state r 4 (matrix-ref state r 3))
    (matrix-set! state r 3 (matrix-ref state r 2))
    (matrix-set! state r 2 (matrix-ref state r 1))
    (matrix-set! state r 1 (matrix-ref state r 0))
    (matrix-set! state r 0 t))
  (set! c (modulo (+ c 1) 6))
  (when (= x r) (set! y (modulo (+ y 1) 6)))
  (when (= i r) (set! j (modulo (+ j 1) 6)))
  (let ((t (matrix-ref state 5 y)))
    (matrix-set! state 5 y (matrix-ref state 4 y))
    (matrix-set! state 4 y (matrix-ref state 3 y))
    (matrix-set! state 3 y (matrix-ref state 2 y))
    (matrix-set! state 2 y (matrix-ref state 1 y))
    (matrix-set! state 1 y (matrix-ref state 0 y))
    (matrix-set! state 0 y t))
  (set! x (modulo (+ x 1) 6))
  (when (= c y) (set! r (modulo (+ r 1) 6)))
  (when (= j y) (set! i (modulo (+ i 1) 6)))
  (set! i (modulo (+ i (quotient ct 6)) 6))
  (set! j (modulo (+ j (modulo ct 6)) 6))
  (values state i j r c x y))

(define (encrypt key nonce plaintext signature)
  (let ((state (initialize-state key)) (i 0) (j 0))
    (let loop ((ps (string->ints (string-append nonce plaintext signature)))
               (state state) (i i) (j j) (cs (list)))
      (if (null? ps)
          (string-upcase (string-append nonce
            (ints->string (drop (string-length nonce) (reverse cs)))))
            (lambda () (find state (car ps)))
            (lambda (r c)
              (let* ((x (modulo (+ r (quotient (matrix-ref state i j) 6)) 6))
                     (y (modulo (+ c (modulo (matrix-ref state i j) 6)) 6))
                     (ct (matrix-ref state x y)))
                  (lambda () (advance-state state i j r c x y ct))
                  (lambda (state i j r c x y)
                    (loop (cdr ps) state i j (cons ct cs)))))))))))

(define (decrypt key nonce ciphertext)
  (let ((state (initialize-state key)) (i 0) (j 0))
    ; encrypt nonce (to set initial state for decryption)
    (let loop ((ps (string->ints nonce)) (state state) (i i) (j j))
      (when (pair? ps)
          (lambda () (find state (car ps)))
          (lambda (r c)
            (let* ((x (modulo (+ r (quotient (matrix-ref state i j) 6)) 6))
                   (y (modulo (+ c (modulo (matrix-ref state i j) 6)) 6))
                   (ct (matrix-ref state x y)))
                (lambda () (advance-state state i j r c x y ct))
                (lambda (state i j r c x y)
                  (loop (cdr ps) state i j))))))))
    ; decrypt message text and signature
    (let loop ((cs (string->ints ciphertext)) (state state) (i i) (j j) (ps (list)))
      (if (null? cs)
          (string-upcase (ints->string (reverse ps)))
            (lambda () (find state (car cs)))
            (lambda (x y)
              (let* ((r (modulo (- x (quotient (matrix-ref state i j) 6)) 6))
                     (c (modulo (- y (modulo (matrix-ref state i j) 6)) 6))
                     (pt (matrix-ref state r c)))
                  (lambda () (advance-state state i j r c x y (car cs)))
                  (lambda (state i j r c x y)
                    (loop (cdr cs) state i j (cons pt ps)))))))))))

(define nonce "SOLWBF")
(define plaintext "IM_ABOUT_TO_PUT_THE_HAMMER_DOWN")
(define signature "#RUBBERDUCK")

> (encrypt key nonce plaintext signature)

I’ve checked the decryption code several times, carefully, and don’t see a problem. I know that encrypt and advance-state work properly, and advance-state is the same for both encryption and decryption, so the problem is in the decrypt function, but I don’t see the problem. I’ll keep working on it; maybe one of you will spot the problem first. You can run the code at https://ideone.com/DEfZJ8.

By the way, I can never make these “hand-operable” ciphers work by hand. I don’t know if I lack concentration, or get too easily distracted, but my attempts to use manual ciphers always fail. For Elsie Four, I tried to encrypt the sample message three times, and my best result was to get the first fourteen characters right (and six of those were the nonce).


Pages: 1 2

4 Responses to “Elsie Four”

  1. chaw said

    Here is a rather messy and verbose, but working, implementation in
    standard Scheme. It tries to generalize to table-sizes other than
    6×6, but I haven’t tested that part yet.

    ;;;;; ElsieFour (LC4) implementation
    ;; 2018-03-30 Sudarshan S Chawathe
    ;;; Dependencies
    (import (scheme base)
            (scheme write)
            (only (srfi 1) iota)
            (srfi 8)
            (srfi 25)
            (srfi 69))
    ;;; Setup
    (define lc4-alphabet "#_23456789abcdefghijklmnopqrstuvwxyz")
    ;;; Alphabet-number mappings
    (define lc4-char->number
      (let ((ht (alist->hash-table (map cons
                                        (string->list lc4-alphabet)
                                        (iota (string-length lc4-alphabet)))
        (lambda (c)
          (hash-table-ref ht c))))
    (define lc4-number->char
      (let ((ht (alist->hash-table (map cons
                                        (iota (string-length lc4-alphabet))
                                        (string->list lc4-alphabet))
        (lambda (n)
          (hash-table-ref ht n))))
    ;;; Array utilities
    ;; 1-dimensional array with elements drawn from given vector.
    (define (vector->array vec)
      (let ((arr (make-array (shape 0 (vector-length vec)))))
        (let f ((i 0))
          (when (< i (vector-length vec))
            (array-set! arr i (vector-ref vec i))
            (f (+ i 1))))
    (define (array-2d->inline-string arr element->string)
      (let ((oport (open-output-string)))
        (let do-rows ((row (array-start arr 0)))
          (when (< row (array-end arr 0))
            (let do-cols ((col (array-start arr 1)))
              (when (< col (array-end arr 1))
                (display (element->string (array-ref arr row col)) oport)
                (do-cols (+ col 1))))
            (display " " oport)
            (do-rows (+ row 1))))
        (get-output-string oport)))
    ;;; Array row- and column-rotations
    ;; Consider 2D-array as a table (dimensions 0, 1 correspond to rows,
    ;; cols) and circular-rotate-right the given row by 1 (in-place).
    (define (array-2d-right-rotate-row! arr row)
      (let* ((ncols (array-end arr 1))
             (tval (array-ref arr row (- ncols 1))))
        (for-each (lambda (col)
                    (array-set! arr row (+ col 1) (array-ref arr row col)))
                  (iota (- ncols 1) (- ncols 2) -1))
        (array-set! arr row 0 tval)
    ;; Like array-2d-right-rotate-row! but circular-down-rotate the given
    ;; column.
    (define (array-2d-down-rotate-column! arr col)
      (let* ((nrows (array-end arr 0))
             (tval (array-ref arr (- nrows 1) col)))
        (for-each (lambda (row)
                    (array-set! arr (+ row 1) col (array-ref arr row col)))
                  (iota (- nrows 1) (- nrows 2) -1))
        (array-set! arr 0 col tval)
    ;;; Record type for LC4 state
    (define-record-type lc4s
      (make-lc4s i j s s1 x y r c)
      (i lci lci!)      ; marker's row
      (j lcj lcj!)      ; marker's column
      (s lcs lcs!)      ; 2-d array of letters/tiles
      (s1 lcs1 lcs1!)   ; 1-d view of above (shared storage)
      ;; x, y, r, c below are not technically part of the state (rather,
      ;; working variables) but are included here for convenience.
      (x lcx lcx!)
      (y lcy lcy!)
      (r lcr lcr!)
      (c lcc lcc!))  
    ;; String representation of state used by example in ElsieFour paper [Kam17].
    (define (lc4s->string s)
      (string-append (array-2d->inline-string (lcs s)
                                              (lambda (n)
                                                (string (lc4-number->char n))))
                     " "
                     (number->string (lci s))
                     "  "
                     (number->string (lcj s))))
    ;; LC4 state initialized from key.
    (define (lc4-make-state key)
      (let ((arr1d (vector->array key)))
         (let ((nletters (vector-length key)))
           (receive (tlen rem) (exact-integer-sqrt nletters)
             (unless (zero? rem)
               (error "Key size is not a perfect square"))
             (share-array arr1d
                          (shape 0 tlen 0 tlen)
                          (lambda (row col)
                            (+ (* tlen row)
         0 0 0 0)))
    (define (lc4s-nrows s)
      (- (array-end (lcs s) 0)
         (array-start (lcs s) 0)))
    (define (lc4s-ncols s)
      (- (array-end (lcs s) 1)
         (array-start (lcs s) 1)))
    ;;; LC4 state operations
    ;; Circular-rotate-right the given row of the state table, moving the
    ;; marker if it is in the affected row.
    ;; Input x is the x-coordinate of the encrypted-char tile.
    ;; Outputs an increment to the y coordinate of the encrypted-char tile.
    (define (lc4-right-rotate-row! s)
      (array-2d-right-rotate-row! (lcs s) (lcr s))
      (let ((n (lc4s-ncols s)))
        (lcc! s (modulo (+ (lcc s) 1)
        (when (= (lcr s)
                 (lcx s))
          (lcy! s (modulo (+ (lcy s) 1)
        (when (= (lcr s) 
                 (lci s))
          (lcj! s (modulo (+ (lcj s) 1)
    ;; Like lc4-right-rotate-row!, but for columns.
    (define (lc4-down-rotate-column! s)
      (array-2d-down-rotate-column! (lcs s) (lcy s))
      (let ((n (lc4s-nrows s)))
        (lcx! s (modulo (+ (lcx s) 1)
        (when (= (lcc s)
                 (lcy s))
          (lcr! s (modulo (+ (lcr s) 1)
        (when (= (lcj s)
                 (lcy s))
          (lci! s (modulo (+ (lci s) 1)
    (define (lc4-find! s ch)
      (let ((arr1d (lcs1 s)))
        (let f ((k (array-start arr1d 0)))
          (unless (< k (array-end arr1d 0))
            (error "character not found in table" ch))
          (if (char=? ch (lc4-number->char (array-ref arr1d k)))
              (receive (q r) (floor/ k (lc4s-ncols s))
                (lcr! s q)
                (lcc! s r))
              (f (+ k 1))))))
    ;;; Main encryption procedure
    (define (lc4s-marked-tile s)
      (array-ref (lcs s)
                 (lci s)
                 (lcj s)))
    ;;; Encryption 
    (define (lc4-encrypt-char! state ch)
      (let ((nrows (lc4s-nrows state))
            (ncols (lc4s-ncols state)))
        (lc4-find! state ch)
        (receive (dx dy) (floor/ (lc4s-marked-tile state) ncols)
          (lcx! state (modulo (+ (lcr state)  dx) nrows))
          (lcy! state (modulo (+ (lcc state) dy) ncols))
          (let ((enc (array-ref (lcs state) (lcx state) (lcy state))))
            (lc4-right-rotate-row! state)
            (lc4-down-rotate-column! state)
            (receive (di dj) (floor/ enc ncols)
              (lci! state (modulo (+ (lci state) di)
              (lcj! state (modulo (+ (lcj state) dj)
            (lc4-number->char enc)))))
    (define (lc4-encrypt-string! state str trace?)
      (let ((oport (open-output-string)))
        (string-for-each (lambda (c)
                           (let ((e (lc4-encrypt-char! state c)))
                             (display e oport)
                             (when trace?
                               (display (lc4s->string state))
                               (display " ")
                               (display c)
                               (display " ")
                               (display e)
        (get-output-string oport)))
    ;;; Main encryption interface
    (define (lc4-encrypt key nonce msg sig trace?)
      (let* ((nkey (list->vector (map lc4-char->number
                                      (string->list key))))
             (state (lc4-make-state nkey)))
        (when trace?
          (display (lc4s->string state))
        (let ((oport (open-output-string)))
          (lc4-encrypt-string! state nonce #t) ; output discarded
          (display (lc4-encrypt-string! state msg #t) oport)
          (display (lc4-encrypt-string! state sig #t) oport)
          (let ((ctext (get-output-string oport)))
            (when trace?
              (display "Ciphertext: ")
              (display ctext)
    ;;; Example from ElsieFour paper [Kam17]
    (define (kam17-example)
      (lc4-encrypt "xv7ydq#opaj_39rzut8b45wcsgehmiknf26l"
    ;;; Decryption
    (define (lc4-decrypt-char! state ch)
      (lc4-find! state ch)
      (lcx! state (lcr state))
      (lcy! state (lcc state))
      (receive (dx dy) (floor/ (lc4s-marked-tile state)
                               (lc4s-ncols state))
        (lcr! state (modulo (- (lcx state) dx)
                            (lc4s-nrows state)))
        (lcc! state (modulo (- (lcy state) dy)
                            (lc4s-ncols state)))
        (let ((dc (array-ref (lcs state)
                             (lcr state)
                             (lcc state))))
          (lc4-right-rotate-row! state)
          (lc4-down-rotate-column! state)
          (receive (di dj) (floor/ (lc4-char->number ch) (lc4s-ncols state))
            (lci! state (modulo (+ (lci state)  di)
                                (lc4s-nrows state)))
            (lcj! state (modulo (+ (lcj state) dj)
                                (lc4s-ncols state))))
          (lc4-number->char dc))))
    (define (lc4-decrypt-string! state str trace?)
      (let ((oport (open-output-string)))
        (string-for-each (lambda (c)
                           (let ((e (lc4-decrypt-char! state c)))
                             (display e oport)
                             (when trace?
                               (display (lc4s->string state))
                               (display " ")
                               (display c)
                               (display " ")
                               (display e)
        (get-output-string oport)))
    ;;; Main decryption interface
    (define (lc4-decrypt key nonce msg sig trace?)
      (let* ((nkey (list->vector (map lc4-char->number
                                      (string->list key))))
             (state (lc4-make-state nkey)))
        (when trace?
          (display (lc4s->string state))
        (let ((oport (open-output-string)))
          (lc4-encrypt-string! state nonce #t) ; N.B. encrypt; output discarded
          (display (lc4-decrypt-string! state msg #t) oport)
          (let ((ctext (get-output-string oport)))
            (when trace?
              (display "Plaintext: ")
              (display ctext)
              (display "Signature: ")
              (display (if (string=? sig
                                     (string-copy ctext (- (string-length ctext)
                                                           (string-length sig))))
    ;;;Example based on the one in the paper.
    (define (kam17-example-decrypt)
      (lc4-decrypt "xv7ydq#opaj_39rzut8b45wcsgehmiknf26l"
    ;;; Run example

  2. bavier said

    Here is a Forth implementation suitable for Gforth 0.7.3:

    \ Elsie-Four (LC4), Copyright 2018 etb, License: GPLv3+
    CREATE K 36 ALLOT \ Key buffer
    CREATE S 36 ALLOT \ State buffer
    CREATE M 0 , \ Marker

    ->INT ( c -- n)
        DUP [CHAR] # = IF DROP 0 ELSE
        DUP [CHAR] _ = IF DROP 1 ELSE
        DUP [CHAR] 2 >= OVER [CHAR] 9 <= AND IF [ CHAR 2 2 - ]L - ELSE
        DUP [CHAR] a >= OVER [CHAR] z <= AND IF [ CHAR a 10 - ]L - ELSE
        DUP [CHAR] A >= OVER [CHAR] Z <= AND IF [ CHAR A 10 - ]L - ELSE
        ." Warning: mapping '" EMIT ." ' to '_'" CR 1

    ->CHAR ( n -- c) >R
        S" #_23456789abcdefghijklmnopqrstuvwxyz" R@ <
        IF [CHAR] * ELSE R@ + C@ THEN R> DROP ;

    B0 BUF B ! ; : .B BUF B @ BUF - TYPE ;

    B, B @ C! [ 1 CHARS ]L B +! ;

    CREATE A 0 ,
    C@A+ ( -- c) A @ C@ 1 CHARS A +! ;

    A-C! ( c --) A @ 1 CHARS - TUCK C! A ! ;

    RIGHT-ROTATE ( row --) 6 * S + A !
        C@A+ C@A+ C@A+ C@A+ C@A+ C@A+ >R
        A-C! A-C! A-C! A-C! A-C! R> A-C! ;

    C@A6+ ( -- c) A @ C@ 6 CHARS A +! ;

    A6-C! ( c --) A @ 6 CHARS - TUCK C! A ! ;

    DOWN-ROTATE ( col --) S + A !
        C@A6+ C@A6+ C@A6+ C@A6+ C@A6+ C@A6+ >R
        A6-C! A6-C! A6-C! A6-C! A6-C! R> A6-C! ;

    S[] ( n -- c) S + C@ ;

    SFIND ( c -- n) >R

    +S ( n n' -- n'') \ Add indices within the state matrix
        6 /MOD ROT 6 /MOD ROT
        + 6 MOD 6 * >R + 6 MOD R> + ;

    -S ( n n' -- n'') \ Subtract indices within the state matrix
        6 /MOD ROT 6 /MOD ROT
        - 6 MOD 6 * >R SWAP - 6 MOD R> + ;

    \ Rather than maintain row and column indices for various markers,
    \ just keep track of the character, and search, via SFIND, for the
    \ index in S when needed.
    UPDATE ( C P --)
            SFIND 6 / RIGHT-ROTATE \ rotate row of P
        DUP SFIND 6 MOD DOWN-ROTATE \ rotate column of C
        M @ SFIND +S S[] M ! ; \ adjust marker

    CIPHER ( c --) ->INT
        DUP SFIND M @ ( P P' M)
        +S ( P C') S[] TUCK ( C P C)
        ->CHAR B, UPDATE ;

    PLAIN ( c --) ->INT
        DUP SFIND M @ ( C C' M)
        -S ( C P') S[] DUP ( C P P)
        ->CHAR B, UPDATE ;

    (ENCRYPT) ( c-addr u) BOUNDS ?DO I C@ CIPHER LOOP ;

    (DECRYPT) ( c-addr u) BOUNDS ?DO I C@ PLAIN LOOP ;

    RESET K S 36 CMOVE 0 S[] M ! ; \ Reset the state matrix and marker

    ENCRYPT ( nonce u1 header u2 plaintext u3 sig u4)
        2>R 2>R 2SWAP \ save plaintext/sig for later, setup nonce
        (ENCRYPT) B0 \ encrypt the nonce and ignore
        (ENCRYPT) B0 \ encrypt header, if any, and ignore
        2R> 2R> 2SWAP \ restore sig/plaintext
        (ENCRYPT) \ encrypt the plaintext
        (ENCRYPT) \ append the encrypted sig
        CR ." Ciphertext: " .B CR ;

    DECRYPT ( nonce u1 header u2 ciphertext u3)
        2SWAP 2ROT \ save ciphertext for later, setup nonce
        (ENCRYPT) B0 \ encrypt the nonce and ignore
        (ENCRYPT) B0 \ encrypt header, if any, and ignore
        (DECRYPT) \ decrypt the ciphertext
        CR ." Plaintext: " .B CR ;

    S. S A ! 6 0 DO 6 0 DO C@A+ ->CHAR EMIT LOOP SPACE LOOP ;


    TRACE ( c-addr u) CR RESET
        ." State" 38 SPACES ." i j pt ct" CR
        S. M. CR BOUNDS ?DO
        I C@ CIPHER
        S. M. I C@ EMIT 2 SPACES B @ 1 CHARS - C@ EMIT CR
        LOOP ;

    \ Convenience syntax
        BL PARSE \ nonce
        BL PARSE \ header
        BL PARSE \ plaintext
        BL PARSE \ sig
        ENCRYPT ;

        BL PARSE \ nonce
        BL PARSE \ header
        BL PARSE \ ciphertext
        DECRYPT ;

    PRIV-KEY ( " ccc" --)
        36 <> IF DROP ." ERROR: Key must have length 36" CR QUIT THEN
        A ! 36 0 DO C@A+ ->INT K I + C! LOOP ; IMMEDIATE

    An example of use:

    $ gforth elsie-four.fth
    s" solwbf" s" " s" im_about_to_put_the_hammer_down" s" #rubberduck" ENCRYPT
    Ciphertext: i2zqpilr2yqgptltrzx2_9fzlmbo3y8_9pyssx8nf2
    s" solwbf" s" " s" i2zqpilr2yqgptltrzx2_9fzlmbo3y8_9pyssx8nf2" DECRYPT
    Plaintext: im_about_to_put_the_hammer_down#rubberduck
    SEND nonce header this_is_an_amazing_message #theartist
    Ciphertext: wn9pfizu9c3cjc8ul3bkwazx#xhcm8ubj_2p8d
    RECEIVE nonce header wn9pfizu9c3cjc8ul3bkwazx#xhcm8ubj_2p8d
    Plaintext: this_is_an_amazing_message

  3. bavier said

    And of course the formatting comes out less than desirable. So here’s the same code in a git repo: https://notabug.org/bavier/elsie-four/src/master/elsie-four.fth

  4. BE said

    At https://github.com/exaexa/ls47 you can find according Python 3 code (LS47.py) with many command line options.
    They allow to switch between LC4 and its enhancement LS47, and to use different paddings.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s

%d bloggers like this: