Coverage report: /home/ellis/comp/ext/ironclad/src/ciphers/idea.lisp

Kind	Covered	All	%
expression	0	360	0.0
branch	0	20	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; idea.lisp -- implementation of the IDEA block cipher

2

3

;;; converted mostly from the C code appearing in _Applied Cryptography_

4

;;; by Bruce Schneier to Common Lisp. Beware the C-isms.

5

(in-package :crypto)

6

7

(defun idea-mul (a b)

8

(declare (type (unsigned-byte 16) a b))

9

(cond

10

((zerop a) (ldb (byte 16 0) (- 1 b)))

11

((zerop b) (ldb (byte 16 0) (- 1 a)))

12

(t

13

(let* ((product (ldb (byte 32 0) (* a b)))

14

(x (ldb (byte 16 16) product))

15

(y (ldb (byte 16 0) product)))

16

(ldb (byte 16 0) (+ (- y x) (if (< y x) 1 0)))))))

17

18

(defun idea-mul-inv (x)

19

(declare (type (unsigned-byte 16) x))

20

(let ((t1 1))

21

(declare (type (unsigned-byte 16) t1))

22

(when (<= x 1)

23

(return-from idea-mul-inv x))

24

(multiple-value-bind (t0 y) (truncate 65537 x)

25

(declare (type (unsigned-byte 16) t0 y))

26

(loop until (= y 1)

27

do (let ((q (truncate x y)))

28

(declare (type (unsigned-byte 16) q))

29

(setf x (mod x y))

30

(incf t1 (ldb (byte 16 0) (* q t0)))

31

(when (= x 1)

32

(return-from idea-mul-inv t1))

33

(setf q (truncate y x))

34

(setf y (mod y x))

35

(incf t0 (ldb (byte 16 0) (* q t1))))

36

finally (return (ldb (byte 16 0) (- 1 t0)))))))

37

38

(deftype idea-round-keys () '(simple-array (unsigned-byte 16) (52)))

39

40

(defun idea-munge-block (input input-start output output-start keys)

41

(declare (type (simple-array (unsigned-byte 8) (*)) input output))

42

(declare (type (integer 0 #.(- array-dimension-limit 8))

43

input-start output-start))

44

(declare (type idea-round-keys keys))

45

(with-words ((x1 x2 x3 x4) input input-start :size 2)

46

(do ((i 0 (+ i 6)))

47

((>= i 48)

48

;; final round

49

(setf x1 (idea-mul x1 (aref keys 48))

50

x2 (ldb (byte 16 0) (+ x2 (aref keys 50)))

51

x3 (ldb (byte 16 0) (+ x3 (aref keys 49)))

52

x4 (idea-mul x4 (aref keys 51)))

53

(store-words output output-start x1 x3 x2 x4))

54

(setf x1 (idea-mul x1 (aref keys i))

55

x2 (ldb (byte 16 0) (+ x2 (aref keys (+ i 1))))

56

x3 (ldb (byte 16 0) (+ x3 (aref keys (+ i 2))))

57

x4 (idea-mul x4 (aref keys (+ i 3))))

58

(let ((t1 x3)

59

(t0 x2))

60

(setf x3 (idea-mul (logxor x3 x1) (aref keys (+ i 4)))

61

x2 (idea-mul (ldb (byte 16 0)

62

(+ (logxor x2 x4) x3))

63

(aref keys (+ i 5))))

64

(setf x3 (ldb (byte 16 0) (+ x3 x2))

65

x1 (logxor x1 x2)

66

x4 (logxor x4 x3)

67

x2 (logxor x2 t1)

68

x3 (logxor x3 t0))))))

69

70

(defclass idea (cipher 8-byte-block-mixin)

71

((encryption-keys :accessor encryption-keys)

72

(decryption-keys :accessor decryption-keys)))

73

74

(define-block-encryptor idea 8

75

(idea-munge-block plaintext plaintext-start ciphertext ciphertext-start

76

(encryption-keys context)))

77

78

(define-block-decryptor idea 8

79

(idea-munge-block ciphertext ciphertext-start plaintext plaintext-start

80

(decryption-keys context)))

81

82

(defun idea-invert-key (encryption-keys decryption-keys)

83

(declare (type idea-round-keys encryption-keys decryption-keys))

84

(setf (aref decryption-keys 51) (idea-mul-inv (aref encryption-keys 3))

85

(aref decryption-keys 50) (ldb (byte 16 0) (- (aref encryption-keys 2)))

86

(aref decryption-keys 49) (ldb (byte 16 0) (- (aref encryption-keys 1)))

87

(aref decryption-keys 48) (idea-mul-inv (aref encryption-keys 0)))

88

(do ((i 1 (1+ i))

89

(k 4 (+ k 6))

90

(counter 47))

91

((>= i 8)

92

(setf (aref decryption-keys 5) (aref encryption-keys 47)

93

(aref decryption-keys 4) (aref encryption-keys 46)

94

(aref decryption-keys 3) (idea-mul-inv (aref encryption-keys 51))

95

(aref decryption-keys 2) (ldb (byte 16 0) (- (aref encryption-keys 50)))

96

(aref decryption-keys 1) (ldb (byte 16 0) (- (aref encryption-keys 49)))

97

(aref decryption-keys 0) (idea-mul-inv (aref encryption-keys 48)))

98

decryption-keys)

99

(flet ((set-decryption-key (x)

100

(setf (aref decryption-keys counter) x)

101

(decf counter)))

102

(declare (inline set-decryption-key))

103

(set-decryption-key (aref encryption-keys (+ k 1)))

104

(set-decryption-key (aref encryption-keys k))

105

(set-decryption-key (idea-mul-inv (aref encryption-keys (+ k 5))))

106

(set-decryption-key (ldb (byte 16 0) (- (aref encryption-keys (+ k 3)))))

107

(set-decryption-key (ldb (byte 16 0) (- (aref encryption-keys (+ k 4)))))

108

(set-decryption-key (idea-mul-inv (aref encryption-keys (+ k 2)))))))

109

110

(defun idea-key-schedule (key)

111

(declare (type (simple-array (unsigned-byte 8) (16)) key))

112

(let ((encryption-keys (make-array 52 :element-type '(unsigned-byte 16)))

113

(decryption-keys (make-array 52 :element-type '(unsigned-byte 16))))

114

(declare (type idea-round-keys encryption-keys decryption-keys))

115

(dotimes (i 8)

116

(setf (aref encryption-keys i) (ub16ref/be key (* i 2))))

117

(do ((j 1 (1+ (mod j 8)))

118

(k 8 (1+ k))

119

(offset 0))

120

((>= k 52) (values encryption-keys (idea-invert-key encryption-keys

121

                                                            decryption-keys)))

122

(setf (aref encryption-keys (+ j 7 offset))

123

(ldb (byte 16 0)

124

(logior (ash (aref encryption-keys (+ (mod j 8) offset)) 9)

125

                          (ash (aref encryption-keys (+ (mod (1+ j) 8) offset)) -7))))

126

(incf offset (if (= j 8) 8 0)))))

127

128

(defmethod schedule-key ((cipher idea) key)

129

(declare (type (simple-array (unsigned-byte 8) (16)) key))

130

(multiple-value-bind (encryption-keys decryption-keys)

131

(idea-key-schedule key)

132

(setf (encryption-keys cipher) encryption-keys

133

(decryption-keys cipher) decryption-keys)

134

cipher))

135

136

(defcipher idea

137

(:encrypt-function idea-encrypt-block)

138

(:decrypt-function idea-decrypt-block)

139

(:block-length 8)

140

(:key-length (:fixed 16)))