;;;; idea.lisp -- implementation of the IDEA block cipher ;;; converted mostly from the C code appearing in _Applied Cryptography_ ;;; by Bruce Schneier to Common Lisp.  Beware the C-isms. (in-package :crypto) (defun idea-mul (a b)   (declare (type (unsigned-byte 16) a b))   (cond     ((zerop a) (ldb (byte 16 0) (- 1 b)))     ((zerop b) (ldb (byte 16 0) (- 1 a)))     (t      (let* ((product (ldb (byte 32 0) (* a b)))             (x (ldb (byte 16 16) product))             (y (ldb (byte 16 0) product)))        (ldb (byte 16 0) (+ (- y x) (if (< y x) 1 0))))))) (defun idea-mul-inv (x)   (declare (type (unsigned-byte 16) x))   (let ((t1 1))     (declare (type (unsigned-byte 16) t1))     (when (<= x 1)       (return-from idea-mul-inv x))     (multiple-value-bind (t0 y) (truncate 65537 x)       (declare (type (unsigned-byte 16) t0 y))       (loop until (= y 1)         do (let ((q (truncate x y)))              (declare (type (unsigned-byte 16) q))              (setf x (mod x y))              (incf t1 (ldb (byte 16 0) (* q t0)))              (when (= x 1)                (return-from idea-mul-inv t1))              (setf q (truncate y x))              (setf y (mod y x))              (incf t0 (ldb (byte 16 0) (* q t1))))         finally (return (ldb (byte 16 0) (- 1 t0))))))) (deftype idea-round-keys () '(simple-array (unsigned-byte 16) (52))) (defun idea-munge-block (input input-start output output-start keys)   (declare (type (simple-array (unsigned-byte 8) (*)) input output))   (declare (type (integer 0 #.(- array-dimension-limit 8))                  input-start output-start))   (declare (type idea-round-keys keys))   (with-words ((x1 x2 x3 x4) input input-start :size 2)     (do ((i 0 (+ i 6)))         ((>= i 48)          ;; final round         (setf x1 (idea-mul x1 (aref keys 48))                x2 (ldb (byte 16 0) (+ x2 (aref keys 50)))                x3 (ldb (byte 16 0) (+ x3 (aref keys 49)))                x4 (idea-mul x4 (aref keys 51)))          (store-words output output-start x1 x3 x2 x4))       (setf x1 (idea-mul x1 (aref keys i))             x2 (ldb (byte 16 0) (+ x2 (aref keys (+ i 1))))             x3 (ldb (byte 16 0) (+ x3 (aref keys (+ i 2))))             x4 (idea-mul x4 (aref keys (+ i 3))))       (let ((t1 x3)             (t0 x2))         (setf x3 (idea-mul (logxor x3 x1) (aref keys (+ i 4)))               x2 (idea-mul (ldb (byte 16 0)                                 (+ (logxor x2 x4) x3))                            (aref keys (+ i 5))))         (setf x3 (ldb (byte 16 0) (+ x3 x2))               x1 (logxor x1 x2)               x4 (logxor x4 x3)               x2 (logxor x2 t1)               x3 (logxor x3 t0)))))) (defclass idea-context (cipher 8-byte-block-mixin)   ((encryption-keys :accessor encryption-keys)    (decryption-keys :accessor decryption-keys))) (define-block-encryptor idea 8   (idea-munge-block plaintext plaintext-start ciphertext ciphertext-start                     (encryption-keys context))) (define-block-decryptor idea 8   (idea-munge-block ciphertext ciphertext-start plaintext plaintext-start                     (decryption-keys context))) (defun idea-invert-key (encryption-keys decryption-keys)   (declare (type idea-round-keys encryption-keys decryption-keys))   (setf (aref decryption-keys 51) (idea-mul-inv (aref encryption-keys 3))         (aref decryption-keys 50) (ldb (byte 16 0) (- (aref encryption-keys 2)))         (aref decryption-keys 49) (ldb (byte 16 0) (- (aref encryption-keys 1)))         (aref decryption-keys 48) (idea-mul-inv (aref encryption-keys 0)))   (do ((i 1 (1+ i))        (k 4 (+ k 6))        (counter 47))       ((>= i 8)        (setf (aref decryption-keys 5) (aref encryption-keys 47)              (aref decryption-keys 4) (aref encryption-keys 46)              (aref decryption-keys 3) (idea-mul-inv (aref encryption-keys 51))              (aref decryption-keys 2) (ldb (byte 16 0) (- (aref encryption-keys 50)))              (aref decryption-keys 1) (ldb (byte 16 0) (- (aref encryption-keys 49)))              (aref decryption-keys 0) (idea-mul-inv (aref encryption-keys 48)))        decryption-keys)     (flet ((set-decryption-key (x)              (setf (aref decryption-keys counter) x)              (decf counter)))       (declare (inline set-decryption-key))     (set-decryption-key (aref encryption-keys (+ k 1)))     (set-decryption-key (aref encryption-keys k))     (set-decryption-key (idea-mul-inv (aref encryption-keys (+ k 5))))     (set-decryption-key (ldb (byte 16 0) (- (aref encryption-keys (+ k 3)))))     (set-decryption-key (ldb (byte 16 0) (- (aref encryption-keys (+ k 4)))))     (set-decryption-key (idea-mul-inv (aref encryption-keys (+ k 2))))))) (defun idea-key-schedule (key)   (declare (type (simple-array (unsigned-byte 8) (16)) key))   (let ((encryption-keys (make-array 52 :element-type '(unsigned-byte 16)))         (decryption-keys (make-array 52 :element-type '(unsigned-byte 16))))     (declare (type idea-round-keys encryption-keys decryption-keys))     (dotimes (i 8)       (setf (aref encryption-keys i) (ub16ref/be key (* i 2))))     (do ((j 1 (1+ (mod j 8)))          (k 8 (1+ k))          (offset 0))         ((>= k 52) (values encryption-keys (idea-invert-key encryption-keys                                                            decryption-keys)))       (setf (aref encryption-keys (+ j 7 offset))             (ldb (byte 16 0)                  (logior (ash (aref encryption-keys (+ (mod j 8) offset)) 9)                          (ash (aref encryption-keys (+ (mod (1+ j) 8) offset)) -7))))       (incf offset (if (= j 8) 8 0))))) (defmethod schedule-key ((cipher idea-context) key)   (declare (type (simple-array (unsigned-byte 8) (16)) key))   (multiple-value-bind (encryption-keys decryption-keys)       (idea-key-schedule key)     (setf (encryption-keys cipher) encryption-keys           (decryption-keys cipher) decryption-keys)     cipher)) (defcipher idea   (:encrypt-function idea-encrypt-block)   (:decrypt-function idea-decrypt-block)   (:block-length 8)   (:key-length (:fixed 16)))