;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (IDEA-CIPHER :USE FUTURE-COMMON-LISP); Base: 10 -*-

;;; Xuejia Lay and James Massey's IDEA(tm) cypher,

;;; Common Lisp implementation written 1994, 1995 by Mark Nahabedian and Tony Eng
;;; Artificial Intelligence Laboratory,
;;; Massachusetts Institute of Technology.

;;; IDEA(tm) is a trademark of Ascom-Tech AG

#|

Notes and References:

Reference [2] describes PES (Proposed Encryption Standard).  [6] shows that
PES is less robust against certain forms of attack and proposes slight
modifications to PES.  The resulting IPES (Improved PES) is described in [6]
as well as in [1].  The IPES decryption key schedule described in [1] is 
incorrect in that the Z2 and Z3 columns of the decryption key schedule should be
computed from the Z3 and Z2 (swapped) columns of the encryption key schedule for
all but the first and last rounds.  See [6] for the correct key schedule.  The key 
schedule as described in [1] does not correctly invert the cipher.

The algorithm used as an example in [7] (the patent claims cover a class of
algorithms not just the one used there for illustrative purposes)
corresponds to PES.


[1]  "Applied Cryptography -- Protocols, Algorithms and Source Code in C",
Bruce Schneier, John Wiley & Sons, ISBN 0-471-59756-2
This book is incorrect in its description of decryption key schedule
generation.  See [6].

[2]  Xuejia Lai and James Massey, "A Proposal For a New Block Encryption Standard" in 
"Advances In Cryptology -- EUROCRYPT 90 Proceedings", Springer-Verlag, 1991 p. 389-404.
This paper describes PES.

[3]  James Massey and Xuejia Lai, "Device for Converting a Digital Block and the
Use Thereof", International Patent application number PCT/CH91/00117, 28 November 1991.
International patent describing PES.  I don't know the publication number for the patent.
The wrong publication number is cited in the US patent [7].

[4]  Xuejia Lai, "On the Design and Security of Block Ciphers", ETH Series on
Information Processing (ed. J.L. Massey) Vol 1, Hartung-Gorre Verlag,
Konstanz, Switzerland, 1992.  ISBN 3-89191-573-X.
I havn't found this.

[5]  X. Lai, "Detaled Description and a Software Implementation of the IPES Cipher"
Cited in [1] as a preprint in [1].

[6]  X. Lai, J. Massey, S. Murphy, "Markov Ciphers and Differential
Cryptalalysis", Advances in Cryptology -- EOROCRYPT 91 Proceedings,
Springer-Verlag, 1991, p. 17-38.
This paper describes the IPES cipher and compares it to PES.

[7]  James L. Massey, Xuejia Lai, assignors to Ascom Tech AG, Bern
Switzerland, US Patent Number 5214703, "Device for the Conversion of a
Digital Block and Use of Same"
This can't really be used as a specification because patents, by their nature,
describe a wide range of algorithms so that they can broaden their claims.

There are presumably standards documents which specify the algorithm for IDEA.
I don't know which the appropriate one is.  You can look for a list of ANSI X9 
publications.  Try Ron Rivest's bibliography on his Web home page.

European Patent Number:  EP 0 482 154 B1

|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Package definition

(defpackage idea-cypher
  (:use #+Genera future-common-lisp
	#-Genera Common-Lisp)
  (:export
    "CIPHER-ALGORITHM"
    ))
(in-package "IDEA-CYPHER")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Control

;;; This software provides implementations for both PES and IPES.  

;;; The  parameter controls which operations are used in each round of the cypher.
;;; It should be set to one of the following:
;;; 	:IPES		algorithm as published in [1, 6].
;;; 	:PES		algorithm as published in [2].
(defparameter cipher-algorithm :ipes
  "This parameter controls whether the PES or IPES algorithm is used.
   Set it to either :PES or :IPES")

;;; Show intermediate results during cypher computation.
(defparameter debug-idea nil)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; arithmetic operations

;;; 16 bit exclusive or
(defun idea-xor (a b)
  (ldb (byte 16 0) (logxor a b)))

;;; addition mudulo 65536
(defun idea-add (a b)
  (ldb (byte 16 0) (+ a b)))

;;; invers operation to above
(defun idea-sub (a b)
  (ldb (byte 16 0) (- a b)))

;;; The domain and range of the above operations are the integers from 0 to
;;; 65535 inclusive.

;;; Multiplication modulo 65537.  This operation, and the set of non-zero
;;; elements in its domain form a group.  Since zero has no multiplicative
;;; inverse, and the integers modulo 65537 have one more element than the
;;; integers modulo 65536, an input of zero is mapped to a value of 65536 for
;;; the multiplication.  Similarly, an output of 65536 is mapped to zero.
(defun idea-mult (a b)
  ;; 
  ;; Zero is mapped to 65536 bacause multiplying by zero isn't invertible.
  (let* ((a (if (zerop a) 65536 a))
	 (b (if (zerop b) 65536 b))
	 (product (mod (* a b) 65537)))
    (if (= product 65536)
	0
	product)))

;;; Compute multiplicative inverse mod 65537.  Algorithm based on the Euclid
;;; algorithm as implemented in the C program appendix to [2].
(defun idea-mult-inverse (x)
  (if (zerop x)
      0
      (let ((n1 65537) (n2 x)
	    q r
	    (b1 0) (b2 1)
	    temp)
	(loop
	  (setq r (mod n1 n2)
		q (/ (- n1 r) n2))
	  (if (zerop r)
	      (return (mod b2 65537))
	      (setq n1 n2
		    n2 r
		    temp b2
		    b2 (- b1 (* q b2))
		    b1 temp))))))

;;; This function is used to permute the encryption key between rounds.
(defun left-rotate (num positions word-width)
  (dpb (ldb (byte (- word-width positions) 0) num)
       (byte (- word-width positions) positions)
       (ldb (byte positions (- word-width positions)) num)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; key schedule computation

#|
(defvar *idea-key-cache* nil)

(defun get-key-sub-blocks-for-key (key mode)
  (let ((entry (assoc key *idea-key-cache*)))
    (unless entry
      (let* ((encrypt (key-sub-blocks-for-encryption key))
	     (decrypt (key-sub-blocks-for-decryption encrypt)))
	(setq entry (list key encrypt decrypt))
	(push entry *idea-key-cache*)))
    (ecase mode
      (:encrypt (second entry))
      (:decrypt (third entry)))))
|#

(defun get-key-sub-blocks-for-key (key mode)
  (ecase mode
    (:encrypt (key-sub-blocks-for-encryption key))
    (:decrypt (key-sub-blocks-for-decryption
		(key-sub-blocks-for-encryption key)))))

(defun key-sub-blocks-for-encryption (key)
  (let ((key key)
	(sub-blocks nil))
    (macrolet ((with-key-sub-blocks (key vars &body body)
		 (let* ((key-var '#:key)
			(bindings
			  (loop for v in vars
				for position from 7 by -1
				when v
				  collect
				    (list v `(ldb (byte 16 (* 16 ,position))
						  ,key-var)))))
		   `(let* ((,key-var ,key)
			   ,@bindings)
		      ,@body)))
	       (rotate-key ()
		 `(setq key (left-rotate key 25 128)))
	       (key-phase-1 (&body body)
		 `(with-key-sub-blocks key (k1 k2 k3 k4 k5 k6)
		    ,@body))
	       (key-phase-2 (&body body)
		 `(with-key-sub-blocks key (nil nil nil nil nil nil k1 k2)
		    (rotate-key)
		    (with-key-sub-blocks key (k3 k4 k5 k6)
		      ,@body)))
	       (key-phase-3 (&body body)
		 `(with-key-sub-blocks key (nil nil nil nil k1 k2 k3 k4)
		    (rotate-key)
		    (with-key-sub-blocks key (k5 k6)
		      ,@body)))
	       (key-phase-4 (&body body)
		 `(with-key-sub-blocks key (nil nil k1 k2 k3 k4 k5 k6)
		    ,@body))
	       (get-em (&optional end-p)
		 `(progn k5 k6
			 (push (list k1 k2 k3 k4
				     ,@(unless end-p '(k5 k6)))
			       sub-blocks)) ))
      (key-phase-1 (get-em))
      (key-phase-2 (get-em))
      (key-phase-3 (get-em))
      (key-phase-4 (get-em))
      (rotate-key)
      (key-phase-1 (get-em))
      (key-phase-2 (get-em))
      (key-phase-3 (get-em))
      (key-phase-4 (get-em))
      (rotate-key)
      (key-phase-1 (get-em t)))
    (nreverse sub-blocks)))

(defun key-sub-blocks-for-decryption (sub-blocks-for-encryption)
  (macrolet ((k (round sub-block)
	       `(elt (elt sub-blocks-for-encryption (1- ,round)) (1- ,sub-block)))
	     (for-round (round &optional ipes-swap)
	       `(let* ((round ,round)
		       (round1 (1- round)))
		  (list (idea-mult-inverse (k round 1))
			(ecase cipher-algorithm
			  (:pes (idea-mult-inverse (k round 2)))
			  (:ipes (idea-sub 0 (k round
						,(if ipes-swap 3 2)))))
			(ecase cipher-algorithm
			  (:pes (idea-sub 0 (k round 3)))
			  (:ipes (idea-sub 0 (k round
						,(if ipes-swap 2 3)))))
			(ecase cipher-algorithm
			  (:ipes (idea-mult-inverse (k round 4)))
			  (:pes (idea-sub 0 (k round 4))))
			(k round1 5)
			(k round1 6)))))
    (list (for-round 9)
	  (for-round 8 t)
	  (for-round 7 t)
	  (for-round 6 t)
	  (for-round 5 t)
	  (for-round 4 t)
	  (for-round 3 t)
	  (for-round 2 t)
	  (list (idea-mult-inverse (k 1 1))
		(ecase cipher-algorithm
		  (:ipes (idea-sub 0 (k 1 2)))
		  (:pes (idea-mult-inverse (k 1 2))))
		(idea-sub 0 (k 1 3))
		(ecase cipher-algorithm
		  (:ipes (idea-mult-inverse (k 1 4)))
		  (:pes (idea-sub 0 (k 1 4))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; the algorithm

;;; a single round of computation for the cipher.  Permutation between rounds is
;;; performed by the caller.
(defun idea-do-one-round (x1 x2 x3 x4 k1 k2 k3 k4 k5 k6)
  (declare (inline idea-mult idea-add idea-xor))
  ;; setps here are as numbered in [1].
  (let* ((step1 (idea-mult x1 k1))
	 (step2 (ecase cipher-algorithm
		  (:ipes (idea-add x2 k2))
		  (:pes (idea-mult x2 k2))))
	 (step3 (idea-add x3 k3))
	 (step4 (ecase cipher-algorithm
		  (:ipes (idea-mult x4 k4))
		  (:pes (idea-add x4 k4))))
	 (step5 (idea-xor step1 step3))
	 (step6 (idea-xor step2 step4))
	 (step7 (idea-mult step5 k5))
	 (step8 (idea-add step6 step7))
	 (step9 (idea-mult step8 k6))
	 (step10 (idea-add step7 step9))
	 (step11 (idea-xor step1 step9))
	 (step12 (idea-xor step3 step9))
	 (step13 (idea-xor step2 step10))
	 (step14 (idea-xor step4 step10)))
    ;; no permutation is done here.  That's the caller's responsibility.
    (values step11 step13 step12 step14)))

(defun idea-crypt (x1 x2 x3 x4 key-sub-blocks)
  (declare (inline left-rotate))
  (let ((key-sub-blocks key-sub-blocks)
	(x1 x1) (x2 x2) (x3 x3) (x4 x4))
    (macrolet ((with-key-sub-blocks (&body body)
		 `(multiple-value-bind (k1 k2 k3 k4 k5 k6)
		      (apply #'values (pop key-sub-blocks))
		    k1 k2 k3 k4 k5 k6				;ignorable
		    ,@body)))
      (dotimes (i 8)
	(with-key-sub-blocks
	  ;;; this is where permutation is performed and alliteration alited.
	  (ecase cipher-algorithm
	    (:ipes (multiple-value-setq (x1 x3 x2 x4)
		     (idea-do-one-round x1 x2 x3 x4  k1 k2 k3 k4 k5 k6)))
	    (:pes (multiple-value-setq (x3 x4 x1 x2)
		     (idea-do-one-round x1 x2 x3 x4  k1 k2 k3 k4 k5 k6)))))
	(when debug-idea
	  (format *trace-output* "~&x1, x2, x3, x4: ~6d ~6d ~6d ~6d" x1 x2 x3 x4)))
      (ecase cipher-algorithm
	(:ipes (psetq x2 x3	;unswap for last round
		      x3 x2))
	(:pes))
      (with-key-sub-blocks
	(ecase cipher-algorithm
	  (:ipes
	    (values (idea-mult x1 k1) 
		    (idea-add x2 k2)
		    (idea-add x3 k3)
		    (idea-mult x4 k4)))
	  (:pes
	    (values (idea-mult x1 k1) 
		    (idea-mult x2 k2)
		    (idea-add x3 k3)
		    (idea-add x4 k4))))))))


#|

;;; test case from [2]

(defparameter key-list '(1 2 3 4 5 6 7 8))

;;;Key:  1 2 3 4 5 6 7 8
(defparameter correct-encryption-key-subblocks
	      '((    1	    2	    3	    4	    5	    6)
	   	(    7	    8	 1024	 1536	 2048	 2560)
		( 3072	 3584	 4096	  512	   16	   20)
		(   24	   28	   32	    4	    8	   12)
		(10240	12288	14336	16384	 2048	 4096)	
		( 6144	 8192	  112	  128	   16	   32)
		(   48	   64	   80	   96	    0	 8192)
		(16384	24576	32768	40960	49152	57345)
		(  128	  192	  256	  320	)))

;;; Reference [2] provides test results indicating the correct subblocks.
;;; note that these are for the PES algorithm.
;;;Key:  1 2 3 4 5 6 7 8
(defparameter correct-decryption-key-subblocks-pes
	      '((65025	43350	65280	65216	49152	57345)
	        (65533	21843	32768	24576	    0	 8192)
		(42326	64513	65456	65440	   16	   32)
		(21835	65529	65424	65408	 2048	 4096)
		(13101	43686	51200	49152	    8	   12)
		(19115	53834	65504	65532	   16	   20)
		(43670	28069	61440	65024	 2048	 2560)
		(18725	57345	64512	64000	    5	    6)
		(    1	32769	65533	65532	)))

;;; Decryption subblocks as generated by IDEA implementation in PGP, which uses
;;; the IPES algorithm.
;;;;Key:  1 2 3 4 5 6 7 8
(defparameter correct-decryption-key-subblocks-ipes
	      '((65025  65344  65280  26010  49152  57345)
		(65533  32768  40960  52428      0   8192)
		(42326  65456  65472  21163     16     32)
		(21835  65424  57344  65025   2048   4096)
		(13101  51200  53248  65533      8     12)
		(19115  65504  65508  49153     16     20)
		(43670  61440  61952  65409   2048   2560)
		(18725  64512  65528  21803      5      6)
		(1  65534  65533  49153)))


(defun list-to-int (key-list)
  (let ((result 0))
    (dolist (k key-list)
      (setq result
	    (logior (ash result 16) k)))
    result))

(defun compare (v1 v2 &optional where)
  (flet ((diff (a b)
	   (format t "~&Difference in element ~d: ~d ~d" where a b)))
    (cond ((null v1)
	   (when v2
	     (diff v1 v2)))
	  ((null v2)
	   (diff v1 v2))
	  ((and (listp v1) (listp v2))
	   (loop for vv1 in v1
		 for vv2 in v2
		 for i from 0
		 do (compare vv1 vv2 (append where (list i)))))
	  ((eql v1 v2))
	  (t (diff v1 v2)))))

;;; We generate correct encryption keys
(compare (key-sub-blocks-for-encryption (list-to-int key-list))
	 correct-encryption-key-subblocks)

;;; We generate correct encryption keys for PES
(let ((cipher-algorithm :pes))
  (compare (key-sub-blocks-for-decryption
	     (key-sub-blocks-for-encryption (list-to-int key-list)))
	   correct-decryption-key-subblocks-pes))

(let ((cipher-algorithm :ipes))
  (compare (key-sub-blocks-for-decryption
	     (key-sub-blocks-for-encryption (list-to-int key-list)))
	   correct-decryption-key-subblocks-ipes))


(let ((cipher-algorithm :pes))
  (compare (multiple-value-list
	     (idea-crypt 0 1 2 3 (key-sub-blocks-for-encryption (list-to-int key-list))))
	   ;; Values based on test case provided in [2]:
	   '(16379 12571 2628 1659)))

(let ((cipher-algorithm :pes)
      (ek (key-sub-blocks-for-encryption (list-to-int key-list))))
  (compare (multiple-value-bind (y1 y2 y3 y4)
	       (idea-crypt 0 1 2 3 ek)
	     (multiple-value-list 
	       (idea-crypt y1 y2 y3 y4 (key-sub-blocks-for-decryption ek))))
	   '(0 1 2 3)))

(let ((cipher-algorithm :ipes))
  (compare (multiple-value-list
	     (idea-crypt 0 1 2 3 (key-sub-blocks-for-encryption (list-to-int key-list))))
	   ;; Values based on PGP 2.6 implementation of IDEA:
	   '(4603 60715 408 28133)))

(let ((cipher-algorithm :ipes)
      (ek (key-sub-blocks-for-encryption (list-to-int key-list))))
  (compare (multiple-value-bind (y1 y2 y3 y4)
	       (idea-crypt 0 1 2 3 ek)
	     (multiple-value-list 
	       (idea-crypt y1 y2 y3 y4 (key-sub-blocks-for-decryption ek))))
	   '(0 1 2 3)))

|#