Programming Praxis

5 Responses to “Elsie Four”

1. chaw said

   March 31, 2018 at 1:36 AM

   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)))
                                  char=?)))
       (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))))
       arr))
   
   (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)
       arr))
   
   ;; 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)
       arr))
   
   ;;; Record type for LC4 state
   
   (define-record-type lc4s
     (make-lc4s i j s s1 x y r c)
     lc4s?
     (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)))
       (make-lc4s
        0
        0
        (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)
                              col)))))
        arr1d
        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)
                       n))
       (when (= (lcr s)
                (lcx s))
         (lcy! s (modulo (+ (lcy s) 1)
                         n)))
       (when (= (lcr s) 
                (lci s))
         (lcj! s (modulo (+ (lcj s) 1)
                         n))))
     s)
   
   ;; 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)
                       n))
       (when (= (lcc s)
                (lcy s))
         (lcr! s (modulo (+ (lcr s) 1)
                         n)))
       (when (= (lcj s)
                (lcy s))
         (lci! s (modulo (+ (lci s) 1)
                         n))))
     s)
   
   (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)
                                 nrows))
             (lcj! state (modulo (+ (lcj state) dj)
                                 ncols)))
           (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)
                              (newline))))
                        str)
       (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?
         (newline)
         (display (lc4s->string state))
         (newline))
       (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)
             (newline))
           ctext))))
   
   ;;; Example from ElsieFour paper [Kam17]
   
   (define (kam17-example)
     (lc4-encrypt "xv7ydq#opaj_39rzut8b45wcsgehmiknf26l"
                  "solwbf"
                  "im_about_to_put_the_hammer_down"
                  "#rubberduck"
                  #t))
   
   ;;; 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)
                              (newline))))
                        str)
       (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?
         (newline)
         (display (lc4s->string state))
         (newline))
       (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)
             (newline)
             (display "Signature: ")
             (display (if (string=? sig
                                    (string-copy ctext (- (string-length ctext)
                                                          (string-length sig))))
                          "OK"
                          "MISMATCH")))
           ctext))))
   
   ;;;Example based on the one in the paper.
   
   (define (kam17-example-decrypt)
     (lc4-decrypt "xv7ydq#opaj_39rzut8b45wcsgehmiknf26l"
                  "solwbf"
                  "i2zqpilr2yqgptltrzx2_9fzlmbo3y8_9pyssx8nf2"
                  "#rubberduck"
                  #t))
   
   ;;; Run example
   
   (kam17-example)
   (newline)
   (kam17-example-decrypt)
   (newline)
   
   ;;;
   
2. bavier said

   April 4, 2018 at 5:50 AM

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

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

   CREATE BUF 256 ALLOT CREATE B BUF ,
   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
       0 BEGIN DUP S[] R@ <> WHILE CHAR+ REPEAT R> DROP ;

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

   M. SPACE M @ SFIND 6 /MOD . SPACE . SPACE ;

   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
   SEND
       BL PARSE \ nonce
       BL PARSE \ header
       BL PARSE \ plaintext
       BL PARSE \ sig
       ENCRYPT ;

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

   PRIV-KEY ( " ccc" --)
    BL WORD COUNT
    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
PRIV-KEY XV7YDQ#OPAJ_39RZUT8B45WCSGEHMIKNF26L
s" solwbf" s" " s" im_about_to_put_the_hammer_down" s" #rubberduck" ENCRYPT
Ciphertext: i2zqpilr2yqgptltrzx2_9fzlmbo3y8_9pyssx8nf2
 ok
s" solwbf" s" " s" i2zqpilr2yqgptltrzx2_9fzlmbo3y8_9pyssx8nf2" DECRYPT
Plaintext: im_about_to_put_the_hammer_down#rubberduck
 ok
SEND nonce header this_is_an_amazing_message #theartist
Ciphertext: wn9pfizu9c3cjc8ul3bkwazx#xhcm8ubj_2p8d
 ok
RECEIVE nonce header wn9pfizu9c3cjc8ul3bkwazx#xhcm8ubj_2p8d
Plaintext: this_is_an_amazing_message#theartist
 ok

3. bavier said

   April 4, 2018 at 6:01 AM

   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

   April 7, 2018 at 7:10 PM

   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.
5. Daniel said

   May 27, 2018 at 3:09 PM

   Here’s a solution in Python using NumPy.

   The program omits unused calculations from the paper’s right-rotation and down-rotation subroutines.

   import numpy as np
   
   _ALPHABET = list("#_23456789abcdefghijklmnopqrstuvwxyz")
   _INDEX_LOOKUP = {val: idx for idx, val in enumerate(_ALPHABET)}
   
   class _State:
     def __init__(self, K):
       self.S = np.empty((6, 6), dtype=int)
       for k in range(36):
         self.S[divmod(k, 6)] = K[k]
       self.i = 0
       self.j = 0
   
     def astuple(self):
       return (self.S, self.i, self.j)
   
     def _update(self, S, i, j):
       self.S = S
       self.i = i
       self.j = j
   
     def step(self, r, x, y, ct):
       S, i, j = self.astuple()
       S[r, :] = np.roll(S[r, :], 1)
       y = (y + (x == r)) % 6
       j = (j + (i == r)) % 6
       S[:,y] = np.roll(S[:, y], 1)
       i = (i + (j == y)) % 6
       i = (i + ct // 6) % 6
       j = (j + ct % 6) % 6
       self._update(S, i, j)
   
   def _encrypt(state, P):
     n = P.shape[0]
     C = np.empty(n, dtype=int)
     for idx, pt in enumerate(P):
       S, i, j = state.astuple()
       where = np.where(S==pt)
       r = where[0][0]
       c = where[1][0]
       x = (r + S[i, j] // 6) % 6
       y = (c + S[i, j] % 6) % 6
       ct = S[x, y]
       C[idx] = ct
       state.step(r, x, y, ct)
     return C
   
   def _decrypt(state, C):
     n = C.shape[0]
     P = np.empty(n, dtype=int)
     for idx, ct in enumerate(C):
       S, i, j = state.astuple()
       where = np.where(S==ct)
       x = where[0][0]
       y = where[1][0]
       r = (x - S[i, j] // 6) % 6
       c = (y - S[i, j] % 6) % 6
       pt = S[r, c]
       P[idx] = pt
       state.step(r, x, y, ct)
     return P
   
   def encrypt(key, nonce, text, signature="", header=""):
     K = np.array([_INDEX_LOOKUP[x] for x in key.lower()])
     state = _State(K)
     _encrypt(state, np.array([_INDEX_LOOKUP[x] for x in nonce.lower()]))
     _encrypt(state, np.array([_INDEX_LOOKUP[x] for x in header.lower()]))
     P = np.array([_INDEX_LOOKUP[x] for x in (text + signature).lower()])
     encrypted = ''.join(_ALPHABET[x] for x in _encrypt(state, P))
     return encrypted
   
   def decrypt(key, nonce, text, header=""):
     K = np.array([_INDEX_LOOKUP[x] for x in key.lower()])
     state = _State(K)
     _encrypt(state, np.array([_INDEX_LOOKUP[x] for x in nonce.lower()]))
     _encrypt(state, np.array([_INDEX_LOOKUP[x] for x in header.lower()]))
     C = np.array([_INDEX_LOOKUP[x] for x in text.lower()])
     decrypted = ''.join(_ALPHABET[x] for x in _decrypt(state, C))
     return decrypted
   
   if __name__ == "__main__":
     key = "xv7ydq#opaj_39rzut8b45wcsgehmiknf26l"
     nonce = "solwbf"
     text = "im_about_to_put_the_hammer_down"
     signature = "#rubberduck"
   
     encrypted = encrypt(key, nonce, text, signature=signature)
     print("Encrypted: {}".format(encrypted))
   
     decrypted = decrypt(key, nonce, encrypted)
     print("Decrypted: {}".format(decrypted))
   

   Output:

   Encrypted: i2zqpilr2yqgptltrzx2_9fzlmbo3y8_9pyssx8nf2
   Decrypted: im_about_to_put_the_hammer_down#rubberduck