Source

ecrypto / idea.el

;;;  idea.el -- block cipher

;; Copyright (C) 1998 Ray Jones

;; Author: Ray Jones, rjones@pobox.com
;; Keywords: IDEA, oink, cipher, cypher, cryptography
;; Created: 1998-04-01

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.

;;; Commentary:

;; this code probably isn't as efficient as it could be.
;; neither am i, though.

;;; Code:

(require 'cl)

;; multiplication mod (2^16)+1, chopped to 16 bits
;; works by splitting multiplicand into two 8 bit parts
;; note that an argument of 0 is treated as if it were 2^16
(defun idea-mul (a b)
  (if (or (= a 0)
          (= b 0))
      (logand (- ?\x10001 a b) ?\xffff)

    ;; split a into 8 bit pieces
    (let* ((low (logand a ?\xff))
           (high (ash a -8)))

      ;; multiply low and high parts by b
      (setq low (* low b))
      (setq high (* high b))

      ;; add overlapped bits of high and low, store in low
      (setq low (+ low (ash (logand ?\xff high) 8)))
      
      ;; shift high so high and low do not overlap
      (setq high (+ (ash high -8) (ash low -16)))
      (setq low (logand low ?\xffff))

      ;; product is now (+ (ash high 16) low)
      
      ;; optimized mod operation
      (setq low (- low high))
      (if (<= low 0)
          (logand (+ low ?\x10001) ?\xffff)
        (logand low ?\xffff)))))

;; multiplicative inverse, mod (2^16)+1 (which is prime)
;; uses extended Euclid algorithm
(defun idea-mul-inv (x)
  (if (= x 0)
      0
    ;; calculate am + bn = d, d = greatest common divisor of m,n.
    ;; if m is prime, then b and n are multiplicative inverses
    (let ((m ?\x10001)
          (n x)
          (a 0)
          (b 1)
          (not-done t))
      (while not-done
        (let ((r (mod m n))
              (q (/ m n))
              (temp b))
          (if (= r 0)
              (setq not-done nil)
            (progn
              (setq m n)
              (setq n r)
              (setq b (- a (* q b)))
              (setq a temp)))))
      (if (< b 0)
          (logand (+ b ?\x10001) ?\xffff)
        (logand b ?\xffff)))))


(defconst *idea-rounds* 8)
(defconst *idea-subkey-number* 52)

;; generate internal encryption keys from an external key
(defun idea-encrypt-subkeys (key &optional xor-safe)
  "generate the IDEA-subkeys from a 128-bit (8 element vector of
16-bit values).  optional second arg controls XORing with 0x0dae to
prevent \"weak\" keys from being generated.  return vector of 52
16-bit numbers."

  ;; sanity check
  (assert (= (length key) 8) nil
	  "idea-encrypt-subkeys: first arg must be of length 8")

  (let ((subkeys (make-vector *idea-subkey-number* 0)))

    (dotimes (idx 8)
      (aset subkeys idx (aref key idx)))

    (do ((idx 8 (1+ idx)))
	((= idx *idea-subkey-number*))

      (let* ((idx1 (if (= 0 (mod (1+ idx) 8))
		       (- idx 15)
		     (- idx 7)))
	     (idx2 (if (< (mod (+ idx 2) 8) 2)
		       (- idx 14)
		     (- idx 6))))
	(aset subkeys idx (logand ?\xffff
				  (logior (ash (aref subkeys idx1) 9)
					  (ash (aref subkeys idx2)
					       -7))))))
    (when xor-safe
      (dotimes (idx *idea-subkey-number*)
	(aset subkeys idx (logxor ?\x0dae (aref subkeys idx)))))

    subkeys))

(defun idea-decrypt-subkeys (enc-subkeys)
  "generate IDEA decryptions subkeys from the encryption subkeys"
  (let ((dec-subkeys (make-vector *idea-subkey-number* 0))
	(in-idx 0))
    (flet ((next-subkey ()
	      (prog1
		  (aref enc-subkeys in-idx)
		(incf in-idx))))

      (let ((idx (* 6 *idea-rounds*)))
	(aset dec-subkeys (+ idx 0) (idea-mul-inv (next-subkey)))
	(aset dec-subkeys (+ idx 1) (logand ?\xffff (- (next-subkey))))
	(aset dec-subkeys (+ idx 2) (logand ?\xffff (- (next-subkey))))
	(aset dec-subkeys (+ idx 3) (idea-mul-inv (next-subkey))))

      (do ((idx (* 6 (1- *idea-rounds*)) (- idx 6)))
	  ((< idx 0))
	(aset dec-subkeys (+ idx 4) (next-subkey))
	(aset dec-subkeys (+ idx 5) (next-subkey))
	(aset dec-subkeys (+ idx 0) (idea-mul-inv (next-subkey)))
	
	(if (= 0 idx)
	    (progn
	      (aset dec-subkeys (+ idx 1) (logand ?\xffff (- (next-subkey))))
	      (aset dec-subkeys (+ idx 2) (logand ?\xffff (- (next-subkey)))))
	  (progn
	    (aset dec-subkeys (+ idx 2) (logand ?\xffff (- (next-subkey))))
	    (aset dec-subkeys (+ idx 1) (logand ?\xffff (- (next-subkey))))))
	
	(aset dec-subkeys (+ idx 3) (idea-mul-inv (next-subkey)))))
    dec-subkeys))

;; encrypt a 64-bit block of data (4 16-bit words), using the subkeys
;; provided, in place 
(defun idea-cipher-block (data subkeys)
  (let ((word0 (aref data 0))
        (word1 (aref data 1))
        (word2 (aref data 2))
        (word3 (aref data 3))
        (idx 0)
	(key-idx 0)
        t1 t2)
    (flet ((next-subkey ()
	      (prog1
		  (aref subkeys key-idx)
		(incf key-idx))))

      (dotimes (idx *idea-rounds*)
	(setq word0 (idea-mul word0 (next-subkey)))
	(setq word1 (logand ?\xffff (+ word1 (next-subkey))))
	(setq word2 (logand ?\xffff (+ word2 (next-subkey))))
	(setq word3 (idea-mul word3 (next-subkey)))
	
	(setq t2 (idea-mul (logxor word0 word2) 
			   (next-subkey)))
	(setq t1 (idea-mul (logand ?\xffff (+ t2 (logxor word1 word3)))
			   (next-subkey)))
	(setq t2 (logand ?\xffff (+ t1 t2)))
	
	(setq word0 (logxor word0 t1))
	(setq word3 (logxor word3 t2))
	
	(setq t2 (logxor t2 word1))
	(setq word1 (logxor word2 t1))
	(setq word2 t2))
      
      (setq word0 (idea-mul word0 (next-subkey)))
      (setq word2 (logand ?\xffff (+ word2 (next-subkey))))
      (setq word1 (logand ?\xffff (+ word1 (next-subkey))))
      (setq word3 (idea-mul word3 (next-subkey))))
      
    ;; word 1 and 2 are swapped before output
    (aset data 0 word0)
    (aset data 1 word2)
    (aset data 2 word1)
    (aset data 3 word3)))

(defun idea-cbc-encode (data subkeys &optional IV)
  "encrypts its first argument, a vector of 16-bit ints, with the keys
in its second argument, using the IV in the optional third argument
(which is prepended to the output vector).  if IV is nil, it is taken
as \[0 0 0 0\] and not prepended to the output.
returns a vector of 16-bit ints."
  (let* ((len (length data))
	 (out-vec (make-vector (if IV (+ len 4) len) 0))
	 (temp-vec (make-vector 4 0)))

    ;; sanity checks
    (assert (zerop (mod len 4)) nil
	    "idea-cbc-encode: length of data must be a multiple of 4")
    (when IV
      (assert (= 4 (length IV)) nil 
	      "idea-cbc-encode: length of IV must be 4"))
    (assert (= *idea-subkey-number* (length subkeys)) nil
	    "idea-cbc-encode: there must be %d subkeys"
	    *idea-subkey-number*)

    ;; write IV into output and temp-vec, if present
    (when IV
      (dotimes (idx 4)
	(aset temp-vec idx (aref IV idx))
	(aset out-vec idx (aref IV idx))))

    ;; encrypt the rest of the input in CBC mode
    (do ((in-idx 0 (+ in-idx 4))
	 (out-idx (if IV 4 0) (+ out-idx 4)))
	((= in-idx len))

      (dotimes (offset 4)
	;; XOR the current plaintext block and previous ciphertext
	;; block (which is in temp-vec) into temp-vec.  (if no IV was
	;; given, then temp-vec will be all zeroes.)
	(aset temp-vec offset (logxor (aref data (+ in-idx offset))
				      (aref temp-vec offset))))

      ;; encrypt temp-vec in place
      (idea-cipher-block temp-vec subkeys)
      
      ;; write temp-vec into the output
      (dotimes (offset 4)
        (aset out-vec (+ out-idx offset) (aref temp-vec offset))))

    ;; clean up 
    (fillarray temp-vec 0)

    out-vec))

(defun idea-cbc-decode (data subkeys &optional no-iv)
  "decrypts its first argument, a vector of 16-bit ints, with the keys
in its second argument.  third argument, if non-nil, indicates that
the data does not have an IV prepended, and that the IV should be
taken as \[0 0 0 0\].
returns a vector of 16-bit ints."
  (let* ((len (length data))
         (out-vec (make-vector (max 0 (if no-iv len (- len 4))) 0))
         (temp-vec (make-vector 4 0))
	 (cur-block (make-vector 4 0))
	 (prev-block (make-vector 4 0)))
    
    ;; sanity checks
    (assert (zerop (mod len 4)) nil
	    "idea-cbc-decode: length of data must be a multiple of 4")
    (unless no-iv
      (assert (> len 0) nil
	      "idea-cbc-decode: length of data must be at least 4"))
    (assert (= *idea-subkey-number* (length subkeys)) nil
	    "idea-cbc-decode: there must be %d subkeys"
	    *idea-subkey-number*)
    
    ;; set up the feedback block
    (unless no-iv
      (dotimes (offset 4)
	(aset prev-block offset (aref data offset))))

    ;; decrypt the input in CBC mode
    (do ((in-idx (if no-iv 0 4) (+ in-idx 4))
	 (out-idx 0 (+ out-idx 4)))
	((= in-idx len))

      ;; copy the ciphertext block into temp-vec and cur-block
      (dotimes (offset 4)
	(let ((x (aref data (+ in-idx offset))))
	  (aset temp-vec offset x)
	  (aset cur-block offset x)))

      ;; decrypt temp-vec in place with the keys
      (idea-cipher-block temp-vec subkeys)

      (dotimes (offset 4)
	;; XOR the output of the cipher with the previous ciphertext
	;; block, storing the result in the output
	(aset out-vec 
	      (+ out-idx offset)
	      (logxor (aref temp-vec offset)
		      (aref prev-block offset)))
	;; move cur-block into prev-block
	(aset prev-block offset (aref cur-block offset))))

    ;; clean up
    (fillarray temp-vec 0)
    (fillarray prev-block 0)
    (fillarray cur-block 0)

    out-vec))

(defun idea-package-transform (data key)
  "perform the idea-cbc package transform on DATA using KEY.
all arguments are vectors of 16-bit integers.  DATA should be 4*n
elements long, KEY should be 8 elements.  no IV is used to seed the
CBC, since the key is (supposedly) random.

package transform is:
  m <= \(idea-cbc data key\)
  k <= key
  k[i%8] <= \(logxor k[i%8] m[i]\) ;; i from 0 to \(length m\)
  output <= \(append m k\)"

  (let* ((subkeys (idea-encrypt-subkeys key))
         (enc-data (idea-cbc-encode data subkeys))
         (enc-len (length enc-data))
         ;; m is enc-data with the key appended
         (m-len (+ enc-len 8))
         (m (make-vector m-len 0))
         ;; scratch space for the key
         (k (make-vector 8 0)))
    
    ;; copy key into k
    (dotimes (key-idx 8)
      (aset k key-idx (aref key key-idx)))

    ;; XOR the k with the blocks of enc-data
    (do ((idx 0 (1+ idx))
         (key-idx 0 (% (1+ key-idx) 8)))
        ((= idx enc-len))
      (aset k key-idx (logxor (aref k key-idx)
                              (aref enc-data idx))))

    ;; copy the encoded data into m
    (dotimes (idx enc-len)
      (aset m idx (aref enc-data idx)))

    ;; copy k into the final elements of m
    (dotimes (key-idx 8)
      (aset m (+ enc-len key-idx) (aref k key-idx)))

    ;; clean up
    (fillarray enc-data 0)
    (fillarray subkeys 0)
    (fillarray k 0)
    
    m))


(defun idea-package-untransform (data)
  "reverse the idea-cbc package transform on DATA.  see the
documentation for idea-package-transform for an explanation of the
transform that this function undoes."

  ;; decode m, allocate space for encrypted message and key
  (let* ((len (length data))
         (enc-len (- len 8))
         (enc-data (make-vector enc-len 0))
         (key (make-vector 8 0)))
    
    ;; extract enc-data
    (dotimes (idx enc-len)
      (aset enc-data idx (aref data idx)))

    ;; extract the XORed key
    (dotimes (key-idx 8)
      (aset key key-idx (aref data (+ enc-len key-idx))))

    ;; XOR the key with the blocks of enc-data
    (do ((idx 0 (1+ idx))
         (key-idx 0 (% (1+ key-idx) 8)))
        ((= idx enc-len))
      (aset key key-idx (logxor (aref key key-idx)
                                (aref enc-data idx))))

    ;; generate the decryption keys
    (let* ((enc-subkeys (idea-encrypt-subkeys key))
           (dec-subkeys (idea-decrypt-subkeys enc-subkeys)))
      
      ;; extract the result and clean up
      (prog1
	  ;; no IV sent included in package transform
          (idea-cbc-decode enc-data dec-subkeys t)
        (fillarray enc-data 0)
        (fillarray key 0)
        (fillarray enc-subkeys 0)
        (fillarray dec-subkeys 0)))))

(provide 'idea)