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.
(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)
`(+ 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+))
(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)))))
(setq y (aref v 0))
(setq z (with-u32 (word (aref v (1- n)))
(incf word (%xxtea-mx (1- n)))))
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)))))
(setq z (aref v (1- n)))
(setq y (with-u32 (word (aref v 0))
(decf word (%xxtea-mx 0))))
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 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) 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