SAFER
SAFER (Secure And Fast Encryption Routine) is a block cipher that was first published in 1993, followed by later variants. SK-128, meaning "Strengthened Key schedule" with 128-bit key size, is shown here as another example of bit-twiddling in ANSI Common Lisp. SAFER is a byte-oriented cipher that operates on a 64-bit block. Contrast this with XXTEA, which has variable-sized blocks with a granularity of 32 bits per element. Another difference is that SAFER's key scheduling is much more complex. It also makes use of S-boxes based on discrete powers and logarithms.

SAFER SK-128

This implementation of SAFER SK-128 encryption, by David Mullen, gives the same results as the original Turbo Pascal implementation (from 1995) and may be easier to follow, depending on one's preference for zero-based or one-based array indexing. Real Programmers may dislike Pascal and Common Lisp equally. In any event, all code on this page is licensed under Apache 2.

(eval-when (:compile-toplevel :load-toplevel :execute) ;; James L. Massey: "For SAFER SK-128, we keep the previous ;; recommendation of 10 rounds with a maximum of 12 rounds." (defconstant +safer-rounds+ 10)) (defmacro define-octet-vector (constant-name &body contents) (let ((vector (coerce contents '(vector (unsigned-byte 8))))) `(progn (define-symbol-macro ,constant-name ,vector) (declaim (type ,(type-of vector) ,constant-name)) ',constant-name))) (define-octet-vector +regular-s-box+ 1 45 226 147 190 69 21 174 120 3 135 164 184 56 207 63 8 103 9 148 235 38 168 107 189 24 52 27 187 191 114 247 64 53 72 156 81 47 59 85 227 192 159 216 211 243 141 177 255 167 62 220 134 119 215 166 17 251 244 186 146 145 100 131 241 51 239 218 44 181 178 43 136 209 153 203 140 132 29 20 129 151 113 202 95 163 139 87 60 130 196 82 92 28 232 160 4 180 133 74 246 19 84 182 223 12 26 142 222 224 57 252 32 155 36 78 169 152 158 171 242 96 208 108 234 250 199 217 0 212 31 110 67 188 236 83 137 254 122 93 73 201 50 194 249 154 248 109 22 219 89 150 68 233 205 230 70 66 143 10 193 204 185 101 176 210 198 172 30 65 98 41 46 14 116 80 2 90 195 37 123 138 42 91 240 6 13 71 111 112 157 126 16 206 18 39 213 76 79 214 121 48 104 54 117 125 228 237 128 106 144 55 162 94 118 170 197 127 61 175 165 229 25 97 253 77 124 183 11 238 173 75 34 245 231 115 35 33 200 5 225 102 221 179 88 105 99 86 15 161 49 149 23 7 58 40) (define-octet-vector +inverse-s-box+ 128 0 176 9 96 239 185 253 16 18 159 228 105 186 173 248 192 56 194 101 79 6 148 252 25 222 106 27 93 78 168 130 112 237 232 236 114 179 21 195 255 171 182 71 68 1 172 37 201 250 142 65 26 33 203 211 13 110 254 38 88 218 50 15 32 169 157 132 152 5 156 187 34 140 99 231 197 225 115 198 175 36 91 135 102 39 247 87 244 150 177 183 92 139 213 84 121 223 170 246 62 163 241 17 202 245 209 23 123 147 131 188 189 82 30 235 174 204 214 53 8 200 138 180 226 205 191 217 208 80 89 63 77 98 52 10 72 136 181 86 76 46 107 158 210 61 60 3 19 251 151 81 117 74 145 113 35 190 118 42 95 249 212 85 11 220 55 49 22 116 215 119 167 230 7 219 164 47 70 243 97 69 103 227 12 162 59 28 133 24 4 29 41 160 143 178 90 216 166 126 238 141 83 75 161 154 193 14 122 73 165 44 129 196 199 54 43 127 67 149 51 242 108 104 109 240 2 40 206 221 155 234 94 153 124 20 134 207 229 66 184 64 120 45 58 233 100 31 146 144 125 57 111 224 137 48) (defun make-block (&optional (size 8) (element-type '(unsigned-byte 8)) initial-element) (make-array size :element-type element-type :initial-element (or initial-element 0))) (defparameter +additive-key-biases+ (loop with bias-rows = (+ 2 (* 2 +safer-rounds+)) with array-dimensions = `(,bias-rows 8) with array = (make-block array-dimensions) finally (return array) ; 22x8 octet array. for i fixnum from 2 below bias-rows do (loop for j fixnum from 1 to 8 do (setf (aref array i (1- j)) (aref +regular-s-box+ (aref +regular-s-box+ (+ (* 9 i) j))))))) (defmacro octet+ (octet-1 octet-2) (let* ((octet-1 `(the (unsigned-byte 8) ,octet-1)) (octet-2 `(the (unsigned-byte 8) ,octet-2)) (result `(the fixnum (+ ,octet-1 ,octet-2)))) ;; Addition modulo 256. `(the (unsigned-byte 8) (logand ,result #xFF)))) (defun %set-parity-byte (expanded-key) "Set the extra byte of EXPANDED-KEY to the result of XOR'ing together the original eight bytes." (declare (optimize (safety 0) (speed 3)) (type (simple-array (unsigned-byte 8) (9)) expanded-key)) (loop with parity of-type (unsigned-byte 8) = (aref expanded-key 0) for i of-type fixnum from 1 to 7 do (setq parity (logxor parity (aref expanded-key i))) finally (setf (aref expanded-key 8) parity))) (defmacro %left-rotate-3 (octet) (let ((temp-octet (gensym (symbol-name '#:octet)))) `(the (unsigned-byte 8) (let ((,temp-octet ,octet)) (declare (type (unsigned-byte 8) ,temp-octet)) (logior (logand (ash ,temp-octet 3) #xFF) (ash ,temp-octet -5)))))) (defun make-key-schedule (key) "SAFER SK-128 turns a 128-bit key into 64-bit subkeys." (check-type key (simple-array (unsigned-byte 8) (16))) (let ((left-key (make-block 9)) (right-key (make-block 9)) (biases +additive-key-biases+)) (declare (type (simple-array (unsigned-byte 8) (9)) left-key)) (declare (type (simple-array (unsigned-byte 8) (9)) right-key)) (declare (type (simple-array (unsigned-byte 8) (22 8)) biases)) (declare (optimize (safety 0) (speed 3))) (loop for i of-type fixnum from 0 below 8 for j of-type fixnum from 8 below 16 do (setf (aref left-key i) (aref key i)) (setf (aref right-key i) (aref key j)) finally (%set-parity-byte left-key) (%set-parity-byte right-key)) ;; Each round uses two subkeys, and an extra ;; subkey is used after the end of the rounds. ;; Subkeys alternate between the left and right ;; half of the key (the first key uses the right). (loop with subkey-count = (1+ (* 2 +safer-rounds+)) with subkeys = (make-array subkey-count) initially (setf (svref subkeys 0) (subseq right-key 0 8)) for i of-type (unsigned-byte 16) from 1 below subkey-count finally (return subkeys) do (let ((key-half (if (oddp i) left-key right-key)) (subkey (setf (svref subkeys i) (make-block)))) (declare (type (simple-array (unsigned-byte 8) (9)) key-half)) (declare (type (simple-array (unsigned-byte 8) (8)) subkey)) (dotimes (j 9) (setf (aref left-key j) (%left-rotate-3 (aref left-key j))) (setf (aref right-key j) (%left-rotate-3 (aref right-key j)))) (loop for j of-type (unsigned-byte 4) below 8 for position of-type fixnum = (mod (the fixnum (+ i j)) 9) for octet of-type (unsigned-byte 8) = (aref key-half position) do (setf (aref subkey j) (octet+ octet (aref biases (1+ i) j)))))))) (defmacro apply-s-boxes (block) `(setf (aref ,block 0) (aref +regular-s-box+ (aref ,block 0)) (aref ,block 1) (aref +inverse-s-box+ (aref ,block 1)) (aref ,block 2) (aref +inverse-s-box+ (aref ,block 2)) (aref ,block 3) (aref +regular-s-box+ (aref ,block 3)) (aref ,block 4) (aref +regular-s-box+ (aref ,block 4)) (aref ,block 5) (aref +inverse-s-box+ (aref ,block 5)) (aref ,block 6) (aref +inverse-s-box+ (aref ,block 6)) (aref ,block 7) (aref +regular-s-box+ (aref ,block 7)))) (defmacro apply-subkey-1 (block subkey) `(setf (aref ,block 0) (logxor (aref ,block 0) (aref ,subkey 0)) (aref ,block 1) (octet+ (aref ,block 1) (aref ,subkey 1)) (aref ,block 2) (octet+ (aref ,block 2) (aref ,subkey 2)) (aref ,block 3) (logxor (aref ,block 3) (aref ,subkey 3)) (aref ,block 4) (logxor (aref ,block 4) (aref ,subkey 4)) (aref ,block 5) (octet+ (aref ,block 5) (aref ,subkey 5)) (aref ,block 6) (octet+ (aref ,block 6) (aref ,subkey 6)) (aref ,block 7) (logxor (aref ,block 7) (aref ,subkey 7)))) (defmacro apply-subkey-2 (block subkey) `(setf (aref ,block 0) (octet+ (aref ,block 0) (aref ,subkey 0)) (aref ,block 1) (logxor (aref ,block 1) (aref ,subkey 1)) (aref ,block 2) (logxor (aref ,block 2) (aref ,subkey 2)) (aref ,block 3) (octet+ (aref ,block 3) (aref ,subkey 3)) (aref ,block 4) (octet+ (aref ,block 4) (aref ,subkey 4)) (aref ,block 5) (logxor (aref ,block 5) (aref ,subkey 5)) (aref ,block 6) (logxor (aref ,block 6) (aref ,subkey 6)) (aref ,block 7) (octet+ (aref ,block 7) (aref ,subkey 7)))) (defmacro %safer-f (left right &optional (left-place left) (right-place right)) "The SAFER algorithm uses f(L, R) = (2L + R, L + R), with addition mod 256." (let ((2*left `(octet+ ,left ,left))) `(psetf ,left-place (octet+ ,2*left ,right) ,right-place (octet+ ,left ,right)))) (defmacro interchange-and-mix (block output) `(progn (%safer-f (aref ,block 0) (aref ,block 2) (aref ,output 0) (aref ,output 1)) (%safer-f (aref ,block 4) (aref ,block 6) (aref ,output 2) (aref ,output 3)) (%safer-f (aref ,block 1) (aref ,block 3) (aref ,output 4) (aref ,output 5)) (%safer-f (aref ,block 5) (aref ,block 7) (aref ,output 6) (aref ,output 7)) (loop for byte fixnum below 8 do (setf (aref ,block byte) (aref ,output byte))))) (deftype safer-block () ;; Data and subkeys are both 64 bits. '(simple-array (unsigned-byte 8) (8))) (defun check-key-schedule (key-schedule) (check-type key-schedule (simple-vector #.(1+ (* 2 +safer-rounds+)))) (loop for subkey across key-schedule do (check-type subkey safer-block)) key-schedule) (defparameter *default-key* (map '(vector (unsigned-byte 8) 16) #'char-code "The Unsecret Key")) (defun safer-encrypt (block &optional (key *default-key*)) (let* ((pre-scheduled-key-p (simple-vector-p key)) (subkeys (if pre-scheduled-key-p (check-key-schedule key) (make-key-schedule key)))) (check-type block safer-block) (let ((temporary-data (make-block 8)) (even-subkey (svref subkeys 0)) (odd-subkey (svref subkeys 1)) (extra-subkey (svref subkeys (* 2 +safer-rounds+)))) (declare (type safer-block block temporary-data)) (declare (type safer-block even-subkey odd-subkey)) (declare (type safer-block extra-subkey)) (declare (optimize (safety 0) (speed 3))) (loop for r of-type (unsigned-byte 16) = 0 then (1+ r) ;; Each round uses two subkeys. The odd and even ;; subkeys are applied differently, so that one ;; has XOR where the other has modular addition. do (apply-subkey-1 block even-subkey) (apply-s-boxes block) (apply-subkey-2 block odd-subkey) ;; The linear layer has three levels; ;; the latter two interchange bytes. (%safer-f (aref block 0) (aref block 1)) (%safer-f (aref block 2) (aref block 3)) (%safer-f (aref block 4) (aref block 5)) (%safer-f (aref block 6) (aref block 7)) (interchange-and-mix block temporary-data) (interchange-and-mix block temporary-data) (let ((next-round (1+ r))) (if (< next-round +safer-rounds+) (let ((next-subkey-index (* 2 next-round))) (declare (type (unsigned-byte 16) next-subkey-index)) (setq even-subkey (svref subkeys next-subkey-index)) (setq odd-subkey (svref subkeys (1+ next-subkey-index)))) ;; In the final output transformation, the extra ;; subkey is applied like the first (even) subkey. (progn (apply-subkey-1 block extra-subkey) (return-from safer-encrypt block))))))))

Counter (CTR) mode

The basic idea of CTR mode is that an ever-changing block is encrypted to provide a stream of effectively random data that can be XORed with an arbitrary input. As XOR is trivially reversible, this provides both encryption and decryption. A requirement is that the same IV block is not encrypted twice under the same key (or at least not any time soon). In other words, a predictable keystream isn't acceptable.

This simple example encrypts files using SAFER SK-128 in CTR mode. The counter block includes both a random nonce and a counter that increments starting from zero. The nonce is included in the file header so that the decrypt-file function can generate the same keystream when passed the same secret key. Note that the intention is for both encryption and decryption to create a new file, rather than overwriting the input file.

(defstruct keystream (schedule (error "Need keys.")) (nonce (random (expt 2 32))) (counter -1 :type fixnum) (position 8 :type fixnum) (block (make-block 8))) (defun keystream-next (keystream) (let ((nonce (keystream-nonce keystream)) (iv-block (keystream-block keystream)) (key-schedule (keystream-schedule keystream))) (declare (type (simple-array (unsigned-byte 8) (8)) iv-block)) (with-accessors ((position keystream-position)) keystream (cond ((< position 7) (aref iv-block (incf position))) (t (let ((counter (incf (keystream-counter keystream)))) (declare (type (unsigned-byte 32) nonce counter)) (setf (aref iv-block 0) (ldb (byte 8 0) nonce)) (setf (aref iv-block 1) (ldb (byte 8 8) nonce)) (setf (aref iv-block 2) (ldb (byte 8 16) nonce)) (setf (aref iv-block 3) (ldb (byte 8 24) nonce)) (setf (aref iv-block 4) (ldb (byte 8 0) counter)) (setf (aref iv-block 5) (ldb (byte 8 8) counter)) (setf (aref iv-block 6) (ldb (byte 8 16) counter)) (setf (aref iv-block 7) (ldb (byte 8 24) counter)) (safer-encrypt iv-block key-schedule) (aref iv-block (setq position 0)))))))) (defun encrypt-file (input-pathname &optional (key *default-key*) output-pathname) (unless output-pathname (setq output-pathname (merge-pathnames ".saf" input-pathname))) (with-open-file (input-stream input-pathname :element-type '(unsigned-byte 8)) (let ((keystream (make-keystream :schedule (make-key-schedule key)))) (with-open-file (output-stream output-pathname :direction :output :element-type (stream-element-type input-stream)) (loop for c across "SAFE" do (write-byte (char-code c) output-stream)) (write-byte (ldb (byte 8 0) (keystream-nonce keystream)) output-stream) (write-byte (ldb (byte 8 8) (keystream-nonce keystream)) output-stream) (write-byte (ldb (byte 8 16) (keystream-nonce keystream)) output-stream) (write-byte (ldb (byte 8 24) (keystream-nonce keystream)) output-stream) (loop for octet = (or (read-byte input-stream nil nil) (loop-finish)) for encrypted-octet = (logxor octet (keystream-next keystream)) do (write-byte encrypted-octet output-stream) finally (return (truename output-pathname))))))) (defun decrypt-file (input-pathname &optional (key *default-key*) output-pathname) (unless output-pathname (setq output-pathname (merge-pathnames ".tmp" input-pathname))) (with-open-file (input-stream input-pathname :element-type '(unsigned-byte 8)) (assert (= (read-byte input-stream) (char-code #\S))) (assert (= (read-byte input-stream) (char-code #\A))) (assert (= (read-byte input-stream) (char-code #\F))) (assert (= (read-byte input-stream) (char-code #\E))) (let* ((nonce-used-for-encryption (logior (read-byte input-stream) (ash (read-byte input-stream) 8) (ash (read-byte input-stream) 16) (ash (read-byte input-stream) 24))) ;; With the nonce, we can make a keystream that is equivalent to the one used for encryption. (keystream (make-keystream :schedule (make-key-schedule key) :nonce nonce-used-for-encryption))) (with-open-file (output-stream output-pathname :direction :output :element-type '(unsigned-byte 8)) (loop for octet = (or (read-byte input-stream nil nil) (loop-finish)) for decrypted-octet = (logxor octet (keystream-next keystream)) do (write-byte decrypted-octet output-stream) finally (return (truename output-pathname)))))))

This code is less optimized than the actual SAFER algorithm, and fast I/O may not exactly be Common Lisp's strong suit, depending on the implementation—and on how low-level you're willing to go. With CCL, encrypting a 32 MB file takes about 16 seconds on a low-end laptop, while consing 62 MB (and similarly for decryption). Note that since the counter itself is only 32 bits (the other half of the IV block), a keystream can only go 2^32 blocks (32 GB) before the counter wraps around. This would necessitate rekeying to avoid a repeat keystream.


Cryptography