XXTEA
XXTEA is an encryption algorithm, first introduced in 1998, which is relatively easy to implement. Unlike many block ciphers, XXTEA has a variable block size. (For example, the original Tiny Encryption Algorithm works on 64-bit blocks, as does SAFER.) This page gives Lisp code for XXTEA as an example of bit bashing in CL, particularly with type and optimize declarations.

The algorithm

This implementation (by David Mullen) is released under an Apache 2 license. It's translated from the C implementation, with the Lisp version being more verbose, but not much harder to follow. There are few things to note. For one, C's overflow/underflow doesn't come into play here, so we have to explicitly constrain each result to a 32-bit unsigned integer (the element of a block). Secondly: %xxtea-encrypt and %xxtea-decrypt both operate destructively on the input block, and are compiled with zero safety—which disables argument count checking, as well as type checks. And finally: type declarations are made with the hope that each intermediate result will fit in a fixnum (which is the case in a 64-bit Lisp). This code has been tested with CCL, SBCL, and CLISP.

(defconstant +xxtea-delta+ #x9E3779B9 "32-bit constant for XXTEA cipher.") (defmacro %xxtea-mx (p &aux (p-remainder `(logand (the fixnum ,p) 3))) `(macrolet ((%xor (u1 u2) `(the (unsigned-byte 48) (logxor ,u1 ,u2)))) (%xor (+ (%xor (ash z -5) (ash y 2)) (%xor (ash y -3) (ash z 4))) (+ (%xor sum y) (%xor (aref key (%xor ,p-remainder e)) z))))) (defmacro %xxtea-rounds (block-size) ;; TRUNCATE should be fixnum-optimized. `(+ 6 (the (unsigned-byte 16) (truncate 52 ,block-size)))) (defmacro with-u32 ((word place) &body body) "Helper macro for 32-bit modular arithmetic." `(let ((,word (the (unsigned-byte 32) ,place))) (declare (type (signed-byte 48) ,word)) ;; Temporary word is signed so we can subtract. ,@body (setf ,place (ldb (byte 32 0) ,word)))) (defun %xxtea-encrypt (v n key) (declare (optimize (safety 0) (speed 3))) (declare (type (simple-array (unsigned-byte 32) (*)) v)) (declare (type (simple-array (unsigned-byte 32) (4)) key)) (declare (type (integer 0 (#.array-total-size-limit)) n)) (loop with z of-type (unsigned-byte 32) = (aref v (1- n)) with sum of-type (unsigned-byte 48) = 0 with e of-type (unsigned-byte 32) = 0 with y of-type (unsigned-byte 32) = 0 with rounds fixnum = (%xxtea-rounds n) do (incf sum +xxtea-delta+) (setq e (logand (ash sum -2) 3)) (loop for p fixnum below (1- n) do (setq y (aref v (the fixnum (1+ p)))) (setq z (with-u32 (word (aref v p)) (incf word (%xxtea-mx p))))) ;; Extension of inner loop, ;; effectively with p = n-1. (setq y (aref v 0)) (setq z (with-u32 (word (aref v (1- n))) (incf word (%xxtea-mx (1- n))))) ;; Used a LOOP REPEAT clause, but CCL made ;; more inline code (for generic arithmetic). do (decf rounds) until (zerop rounds) finally (return v))) (defun %xxtea-decrypt (v n key) (declare (optimize (safety 0) (speed 3))) (declare (type (simple-array (unsigned-byte 32) (*)) v)) (declare (type (simple-array (unsigned-byte 32) (4)) key)) (declare (type (integer 0 (#.array-total-size-limit)) n)) (loop with y of-type (unsigned-byte 32) = (aref v 0) with rounds of-type (unsigned-byte 16) = (%xxtea-rounds n) with sum of-type (unsigned-byte 48) = (* rounds +xxtea-delta+) with z of-type (unsigned-byte 32) = 0 with e of-type (unsigned-byte 32) = 0 do (setq e (logand (ash sum -2) 3)) (loop for p fixnum downfrom (1- n) above 0 do (setq z (aref v (the fixnum (1- p)))) (setq y (with-u32 (word (aref v p)) (decf word (%xxtea-mx p))))) ;; Same as the inner loop, ;; effectively with p = 0. (setq z (aref v (1- n))) (setq y (with-u32 (word (aref v 0)) (decf word (%xxtea-mx 0)))) ;; ROUNDS is the loop count. do (decf sum +xxtea-delta+) when (zerop sum) return v))

Base24 encoding

Base24 is a binary-to-text encoding designed for data with 32-bit alignment, which makes it a good fit for XXTEA output (and the encoding overhead is the same as Base36, i.e. seven digits per 32-bit word). These low-level functions can be used to implement functions that encrypt and decrypt strings, representing the encrypted data as Base24 encoded text.

(define-symbol-macro +base24+ "ZAC2B3EF4GH5TK67P8RS9WXY") (defmacro %base24 (char) `(the (integer 0 (24)) (or (position ,char +base24+ :test #'char-equal) (error "Not a Base24 character: ~S." ,char)))) (defun %parse-base24 (string offset) (declare (type (integer 0 (#.array-total-size-limit)) offset)) (declare (optimize (safety 0) (speed 3)) (type string string)) (loop with value of-type (unsigned-byte 32) = 0 for i fixnum from offset below (+ offset 7) for char of-type character = (char string i) do (setq value (+ (* value 24) (%base24 char))) finally (return value))) (defun %write-base24 (string offset value) (declare (optimize (safety 0) (speed 3))) (declare (type (integer 0 (#.array-total-size-limit)) offset)) (declare (type (unsigned-byte 32) value) (type string string)) (loop with digit-value of-type (integer 0 (24)) = 0 for i of-type fixnum downfrom (+ offset 6) downto offset do (setf (values value digit-value) (truncate value 24)) (setf (schar string i) (schar +base24+ digit-value))))

String encryption/decryption

(defparameter *default-key* (coerce '(897790353 1070388493 2487796323 830006950) '(simple-array (unsigned-byte 32) (4)))) (defun make-block (block-size &key (element-type '(unsigned-byte 32))) (make-array block-size :initial-element 0 :element-type element-type)) (defun encrypt-string (string &optional (key *default-key*)) (check-type key (simple-array (unsigned-byte 32) (4))) (let* ((n (max 2 (ceiling (length string) 4))) (v (make-block n))) (loop for char across string for i fixnum below (length string) for j fixnum = (ash i -2) for k = (* 8 (logand i 3)) do (setf (ldb (byte 8 k) (aref v j)) (char-code char))) ;; Make base24 encoding of the encryption. (loop with b24-string = (make-string (* n 7)) for offset of-type fixnum from 0 by 7 for word across (%xxtea-encrypt v n key) do (%write-base24 b24-string offset word) finally (return b24-string)))) (defun decrypt-string (string &optional (key *default-key*)) (check-type key (simple-array (unsigned-byte 32) (4))) (let* ((n (/ (length string) 7)) (v (make-block n))) (loop for offset of-type fixnum below (* n 7) by 7 for coded-word = (%parse-base24 string offset) for i of-type fixnum upfrom 0 do (setf (aref v i) coded-word) finally (%xxtea-decrypt v n key)) (with-output-to-string (string-stream) (loop with octets fixnum = (ash n 2) for i fixnum from 0 below octets for j fixnum = (ash i -2) for k fixnum = (* 8 (logand i 3)) for code fixnum = (ldb (byte 8 k) (aref v j)) until (eql code 0) ; Zero is the padding code. do (write-char (code-char code) string-stream)))))

Quick test

Here a string is encrypted three times, using the default encryption key (*default-key*) that was defined above, for testing purposes:

? (encrypt-string "X Marks the Spot") "FWFRZ4ZBWRBEZGW2X5RTA79HR58T" ? (encrypt-string *) "6ESFY5XPR5ATR9KSKC8E8APHB9BYF6PYWHTPTS674RGYGR583" ? (encrypt-string *) "TB6AFKCCBHKH7CSHRBB2BT35596KE57Y4T5TSX4CFFEG6S6T7RG8467Y39T2E3AHKE7G6WCR7BG87H6BKZEP4PKAGYA" ? (decrypt-string *) "6ESFY5XPR5ATR9KSKC8E8APHB9BYF6PYWHTPTS674RGYGR583" ? (decrypt-string *) "FWFRZ4ZBWRBEZGW2X5RTA79HR58T" ? (decrypt-string *) "X Marks the Spot"

Note how each layer of encryption nearly doubles the size of the string, due to the overhead of Base24 in representing 32-bit raw data. Also observe that the encrypt-string function encrypts ASCII strings. These cannot have embedded nulls, as the data block being encrypted (or decrypted) is zero-padded with 32-bit alignment. For extra credit, consider how to represent arbitrary byte vectors (or Unicode strings) in encrypted form.

Cryptography