Elsie Four

March 27, 2018

It’s been a while since we did any cryptography. Alan Kaminsky developed an algorithm that he claims is suitable for hand operation but is also quite secure. You can read about the cipher and Kaminsky’s cryptanalysis of it at the link.

Your task is to implement Kaminsky’s Elsie Four cipher. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.


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: