ftp.eterna.com.au/2014.06.ftp.eterna.com.au.tar/ftp.eterna.com.au/lisp/idea.el

Lisp/Scheme | 1998-04-14 | 5KB | 167 lines

;; 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)
;; = (+ (* 6 *idea-rounds*) 4)

;; generate internal encryption keys from an external key
;;
;; takes a 128-bit key (vector of 8 16-bit words) and returns a vector
;; of 52 (*idea-subkey-number*) 16-bit subkeys
(defun idea-encrypt-subkeys (key)
  (let ((subkeys (make-vector *idea-subkey-number* 0))
    (idx 0))
    (while (< idx 8)
      (aset subkeys idx (aref key idx))
      (setq idx (1+ idx)))
    (while (< 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)))))
      (setq idx (1+ idx)))
    subkeys))

(defmacro idea-pop (var)
  "damn elisp's lack of CLisms"
  `(prog1
       (car ,var)
     (setq ,var (cdr ,var))))


;; generate internal decryption keys from internal encryption keys
;;
;; takes a vector of 52 (*idea-subkey-number*) 16-bit words and
;; returns the same.
(defun idea-decrypt-subkeys (enc-subkeys)
  (let ((dec-subkeys (make-vector *idea-subkey-number* 0))
    (idx (* 6 *idea-rounds*))
    (enc-list (mapcar #'identity enc-subkeys)))

    (aset dec-subkeys (+ idx 0) (idea-mul-inv (idea-pop enc-list)))
    (aset dec-subkeys (+ idx 1) (logand ?\xffff (- (idea-pop enc-list))))
    (aset dec-subkeys (+ idx 2) (logand ?\xffff (- (idea-pop enc-list))))
    (aset dec-subkeys (+ idx 3) (idea-mul-inv (idea-pop enc-list)))

    (setq idx (* 6 (1- *idea-rounds*)))
    (while (>= idx 0)
      (aset dec-subkeys (+ idx 4) (idea-pop enc-list))
      (aset dec-subkeys (+ idx 5) (idea-pop enc-list))
      (aset dec-subkeys (+ idx 0) (idea-mul-inv (idea-pop enc-list)))

      (if (= 0 idx)
      (progn
        (aset dec-subkeys (+ idx 1) (logand ?\xffff (- (idea-pop enc-list))))
        (aset dec-subkeys (+ idx 2) (logand ?\xffff (- (idea-pop enc-list)))))
    (progn
      (aset dec-subkeys (+ idx 2) (logand ?\xffff (- (idea-pop enc-list))))
      (aset dec-subkeys (+ idx 1) (logand ?\xffff (- (idea-pop enc-list))))))

      (aset dec-subkeys (+ idx 3) (idea-mul-inv (idea-pop enc-list)))

      (setq idx (- idx 6)))

    dec-subkeys))

;; encrypt a 64-bit block of data (4 16-bit words), using the subkeys provided
(defun idea-cipher-block (data subkeys)
  (let ((word1 (aref data 0))
    (word2 (aref data 1))
    (word3 (aref data 2))
    (word4 (aref data 3))
    (key-list (mapcar #'identity subkeys))
    (idx 0)
    t1 t2)

    (while (< idx *idea-rounds*)
      (setq word1 (idea-mul word1 (idea-pop key-list)))
      (setq word2 (logand ?\xffff (+ word2 (idea-pop key-list))))
      (setq word3 (logand ?\xffff (+ word3 (idea-pop key-list))))
      (setq word4 (idea-mul word4 (idea-pop key-list)))

      (setq t2 (idea-mul (logxor word1 word3)
             (idea-pop key-list)))
      (setq t1 (idea-mul (logand ?\xffff (+ t2 (logxor word2 word4)))
             (idea-pop key-list)))
      (setq t2 (logand ?\xffff (+ t1 t2)))

      (setq word1 (logxor word1 t1))
      (setq word4 (logxor word4 t2))

      (setq t2 (logxor t2 word2))
      (setq word2 (logxor word3 t1))
      (setq word3 t2)

      (setq idx (1+ idx)))

    (setq word1 (idea-mul word1 (idea-pop key-list)))
    (setq word3 (logand ?\xffff (+ word3 (idea-pop key-list))))
    (setq word2 (logand ?\xffff (+ word2 (idea-pop key-list))))
    (setq word4 (idea-mul word4 (idea-pop key-list)))

    (vector word1 word3 word2 word4)))

(provide 'idea)