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, and AES is standardized for 128-bit blocks.) This page gives Lisp code for XXTEA as an example of bit bashing in CL, particularly with type and optimize declarations.

Sample Code

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 (V), and are compiled with zero safety, which (at least in CCL) disables argument count checking, as well as type checks. And finally: type declarations are made with the understanding that each 32-bit word will fit in a fixnum, which is the case in a 64-bit Lisp.

;;; 32-bit constants for XXTEA cipher. (defconstant +xx-sum-delta+ #x9E3779B9) (defconstant +xx-word-mask+ #xFFFFFFFF) (defmacro %xxtea-mx (p) `(the (unsigned-byte 32) ,(let ((kw `(aref key (logxor (logand (the fixnum ,p) 3) e)))) `(logxor (+ (the (unsigned-byte 32) (logxor (ash z -5) (ash y 2))) (the (unsigned-byte 32) (logxor (ash y -3) (ash z 4)))) (+ (the (unsigned-byte 32) (logxor sum y)) (the (unsigned-byte 32) (logxor ,kw 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 ,place)) (declare (type (unsigned-byte 32) ,word)) ,@body (setq ,word (logand ,word +xx-word-mask+)) ;; Write back value. (setf ,place ,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 32) = 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 +xx-sum-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))))) ;; Originally I used a LOOP REPEAT clause, but CCL ;; generated more inline code (for generic arithmetic) ;; than for the equivalent DOTIMES. 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 32) = (%xxtea-rounds n) with sum of-type (unsigned-byte 32) = (* rounds +xx-sum-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 +xx-sum-delta+) when (zerop sum) return v)) (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 from 0 ; STRING index. for j fixnum = (ash i -2) for k = (* 8 (logand i 3)) do (setf (ldb (byte 8 k) (aref v j)) (char-code char))) (with-output-to-string (string-stream) (loop for code-word across (%xxtea-encrypt v n key) do (format string-stream "~36,7,'0R" code-word))))) (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 group-start fixnum below (* n 7) by 7 for group-end fixnum = (+ group-start 7) for coded-integer = (parse-integer string :radix 36 :start group-start :end group-end) for i of-type fixnum upfrom 0 do (setf (aref v i) coded-integer) 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") "0OXJ45C0FI99C91UVZXK11E3LX7O" ? (encrypt-string *) "0Z9S5X81WVMZEI1GWQCM101IU9TH08A1VIS0K42F311WVZ2N5" ? (encrypt-string *) "14TZ2JO1HLI08Z0TN1UOE0ZHMC6A0GUZXPS182S5IH10LCR5T1PDSZJ21M6W3QL0OD2XLY17Q9NY10QKO8JE1EVI7OD" ? (decrypt-string *) "0Z9S5X81WVMZEI1GWQCM101IU9TH08A1VIS0K42F311WVZ2N5" ? (decrypt-string *) "0OXJ45C0FI99C91UVZXK11E3LX7O" ? (decrypt-string *) "X Marks the Spot"

Note how each layer of encryption nearly doubles the size of the string, due to the overhead of Base36 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