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

KindCoveredAll%
expression0580 0.0
branch04 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; misty1.lisp -- implementation of the MISTY1 block cipher from RFC 2994
2
 (in-package :crypto)
3
 (in-ironclad-readtable)
4
 
5
 ;;; required tables
6
 (defconst +misty1-s7table+
7
 #8@(#x1B #x32 #x33 #x5A #x3B #x10 #x17 #x54 #x5B #x1A #x72 #x73 #x6B
8
 #x2C #x66 #x49 #x1F #x24 #x13 #x6C #x37 #x2E #x3F #x4A #x5D #x0F
9
 #x40 #x56 #x25 #x51 #x1C #x04 #x0B #x46 #x20 #x0D #x7B #x35 #x44
10
 #x42 #x2B #x1E #x41 #x14 #x4B #x79 #x15 #x6F #x0E #x55 #x09 #x36
11
 #x74 #x0C #x67 #x53 #x28 #x0A #x7E #x38 #x02 #x07 #x60 #x29 #x19
12
 #x12 #x65 #x2F #x30 #x39 #x08 #x68 #x5F #x78 #x2A #x4C #x64 #x45
13
 #x75 #x3D #x59 #x48 #x03 #x57 #x7C #x4F #x62 #x3C #x1D #x21 #x5E
14
 #x27 #x6A #x70 #x4D #x3A #x01 #x6D #x6E #x63 #x18 #x77 #x23 #x05
15
 #x26 #x76 #x00 #x31 #x2D #x7A #x7F #x61 #x50 #x22 #x11 #x06 #x47
16
 #x16 #x52 #x4E #x71 #x3E #x69 #x43 #x34 #x5C #x58 #x7D))
17
 
18
 (defconst +misty1-s9table+
19
 #16@(#x01C3 #x00CB #x0153 #x019F #x01E3 #x00E9 #x00FB #x0035 #x0181 #x00B9
20
 #x0117 #x01EB #x0133 #x0009 #x002D #x00D3 #x00C7 #x014A #x0037 #x007E
21
 #x00EB #x0164 #x0193 #x01D8 #x00A3 #x011E #x0055 #x002C #x001D #x01A2
22
 #x0163 #x0118 #x014B #x0152 #x01D2 #x000F #x002B #x0030 #x013A #x00E5
23
 #x0111 #x0138 #x018E #x0063 #x00E3 #x00C8 #x01F4 #x001B #x0001 #x009D
24
 #x00F8 #x01A0 #x016D #x01F3 #x001C #x0146 #x007D #x00D1 #x0082 #x01EA
25
 #x0183 #x012D #x00F4 #x019E #x01D3 #x00DD #x01E2 #x0128 #x01E0 #x00EC
26
 #x0059 #x0091 #x0011 #x012F #x0026 #x00DC #x00B0 #x018C #x010F #x01F7
27
 #x00E7 #x016C #x00B6 #x00F9 #x00D8 #x0151 #x0101 #x014C #x0103 #x00B8
28
 #x0154 #x012B #x01AE #x0017 #x0071 #x000C #x0047 #x0058 #x007F #x01A4
29
 #x0134 #x0129 #x0084 #x015D #x019D #x01B2 #x01A3 #x0048 #x007C #x0051
30
 #x01CA #x0023 #x013D #x01A7 #x0165 #x003B #x0042 #x00DA #x0192 #x00CE
31
 #x00C1 #x006B #x009F #x01F1 #x012C #x0184 #x00FA #x0196 #x01E1 #x0169
32
 #x017D #x0031 #x0180 #x010A #x0094 #x01DA #x0186 #x013E #x011C #x0060
33
 #x0175 #x01CF #x0067 #x0119 #x0065 #x0068 #x0099 #x0150 #x0008 #x0007
34
 #x017C #x00B7 #x0024 #x0019 #x00DE #x0127 #x00DB #x00E4 #x01A9 #x0052
35
 #x0109 #x0090 #x019C #x01C1 #x0028 #x01B3 #x0135 #x016A #x0176 #x00DF
36
 #x01E5 #x0188 #x00C5 #x016E #x01DE #x01B1 #x00C3 #x01DF #x0036 #x00EE
37
 #x01EE #x00F0 #x0093 #x0049 #x009A #x01B6 #x0069 #x0081 #x0125 #x000B
38
 #x005E #x00B4 #x0149 #x01C7 #x0174 #x003E #x013B #x01B7 #x008E #x01C6
39
 #x00AE #x0010 #x0095 #x01EF #x004E #x00F2 #x01FD #x0085 #x00FD #x00F6
40
 #x00A0 #x016F #x0083 #x008A #x0156 #x009B #x013C #x0107 #x0167 #x0098
41
 #x01D0 #x01E9 #x0003 #x01FE #x00BD #x0122 #x0089 #x00D2 #x018F #x0012
42
 #x0033 #x006A #x0142 #x00ED #x0170 #x011B #x00E2 #x014F #x0158 #x0131
43
 #x0147 #x005D #x0113 #x01CD #x0079 #x0161 #x01A5 #x0179 #x009E #x01B4
44
 #x00CC #x0022 #x0132 #x001A #x00E8 #x0004 #x0187 #x01ED #x0197 #x0039
45
 #x01BF #x01D7 #x0027 #x018B #x00C6 #x009C #x00D0 #x014E #x006C #x0034
46
 #x01F2 #x006E #x00CA #x0025 #x00BA #x0191 #x00FE #x0013 #x0106 #x002F
47
 #x01AD #x0172 #x01DB #x00C0 #x010B #x01D6 #x00F5 #x01EC #x010D #x0076
48
 #x0114 #x01AB #x0075 #x010C #x01E4 #x0159 #x0054 #x011F #x004B #x00C4
49
 #x01BE #x00F7 #x0029 #x00A4 #x000E #x01F0 #x0077 #x004D #x017A #x0086
50
 #x008B #x00B3 #x0171 #x00BF #x010E #x0104 #x0097 #x015B #x0160 #x0168
51
 #x00D7 #x00BB #x0066 #x01CE #x00FC #x0092 #x01C5 #x006F #x0016 #x004A
52
 #x00A1 #x0139 #x00AF #x00F1 #x0190 #x000A #x01AA #x0143 #x017B #x0056
53
 #x018D #x0166 #x00D4 #x01FB #x014D #x0194 #x019A #x0087 #x01F8 #x0123
54
 #x00A7 #x01B8 #x0141 #x003C #x01F9 #x0140 #x002A #x0155 #x011A #x01A1
55
 #x0198 #x00D5 #x0126 #x01AF #x0061 #x012E #x0157 #x01DC #x0072 #x018A
56
 #x00AA #x0096 #x0115 #x00EF #x0045 #x007B #x008D #x0145 #x0053 #x005F
57
 #x0178 #x00B2 #x002E #x0020 #x01D5 #x003F #x01C9 #x01E7 #x01AC #x0044
58
 #x0038 #x0014 #x00B1 #x016B #x00AB #x00B5 #x005A #x0182 #x01C8 #x01D4
59
 #x0018 #x0177 #x0064 #x00CF #x006D #x0100 #x0199 #x0130 #x015A #x0005
60
 #x0120 #x01BB #x01BD #x00E0 #x004F #x00D6 #x013F #x01C4 #x012A #x0015
61
 #x0006 #x00FF #x019B #x00A6 #x0043 #x0088 #x0050 #x015F #x01E8 #x0121
62
 #x0073 #x017E #x00BC #x00C2 #x00C9 #x0173 #x0189 #x01F5 #x0074 #x01CC
63
 #x01E6 #x01A8 #x0195 #x001F #x0041 #x000D #x01BA #x0032 #x003D #x01D1
64
 #x0080 #x00A8 #x0057 #x01B9 #x0162 #x0148 #x00D9 #x0105 #x0062 #x007A
65
 #x0021 #x01FF #x0112 #x0108 #x01C0 #x00A9 #x011D #x01B0 #x01A6 #x00CD
66
 #x00F3 #x005C #x0102 #x005B #x01D9 #x0144 #x01F6 #x00AD #x00A5 #x003A
67
 #x01CB #x0136 #x017F #x0046 #x00E1 #x001E #x01DD #x00E6 #x0137 #x01FA
68
 #x0185 #x008C #x008F #x0040 #x01B5 #x00BE #x0078 #x0000 #x00AC #x0110
69
 #x015E #x0124 #x0002 #x01BC #x00A2 #x00EA #x0070 #x01FC #x0116 #x015C
70
 #x004C #x01C2))
71
 
72
 ;;; types and context definition
73
 (deftype misty1-round-keys () '(simple-array (unsigned-byte 16) (32)))
74
 
75
 (defclass misty1 (cipher 8-byte-block-mixin)
76
   ((round-keys :accessor round-keys :type misty1-round-keys)))
77
 
78
 ;;; block functions and key expansion
79
 ;; Declaring these inline produces screwy results in SBCL (bug?).
80
 (declaim (notinline fi fl fl-inv fo))
81
 
82
 (defun fi (fi-in fi-key)
83
   (declare (type (unsigned-byte 16) fi-in fi-key))
84
   (let ((d9 (ash fi-in -7))
85
         (d7 (logand fi-in #x7f)))
86
     (declare (type (unsigned-byte 16) d9 d7))
87
     (setf d9 (logxor d7 (aref +misty1-s9table+ d9))
88
           d7 (logxor d9 (aref +misty1-s7table+ d7)))
89
     (setf d7 (logand d7 #x7f))
90
     (setf d7 (logxor d7 (ash fi-key -9))
91
           d9 (logxor d9 (logand fi-key #x1ff)))
92
     (setf d9 (logxor d7 (aref +misty1-s9table+ d9)))
93
     (ldb (byte 16 0) (logior (ash d7 9) d9))))
94
 
95
 (defun fl (d0 d1 keys round)
96
   (declare (type misty1-round-keys keys))
97
   (declare (type (unsigned-byte 16) d0 d1))
98
   (cond
99
     ((evenp round)
100
      (let* ((d1 (logxor d1 (logand d0 (aref keys (truncate round 2)))))
101
             (d0 (logxor d0 (logior d1 (aref keys (+ (mod (+ (truncate round 2) 6) 8) 8))))))
102
        (values d0 d1)))
103
     (t
104
      (let* ((d1 (logxor d1 (logand d0 (aref keys (+ (mod (+ (truncate (1- round) 2) 2) 8) 8)))))
105
             (d0 (logxor d0 (logior d1 (aref keys (mod (+ (truncate (1- round) 2) 4) 8))))))
106
        (values d0 d1)))))
107
 
108
 (defun fl-inv (d0 d1 keys round)
109
   (declare (type misty1-round-keys keys))
110
   (declare (type (unsigned-byte 16) d0 d1))
111
   (cond
112
     ((evenp round)
113
      (let* ((d0 (logxor d0 (logior d1 (aref keys (+ (mod (+ (truncate round 2) 6) 8) 8)))))
114
             (d1 (logxor d1 (logand d0 (aref keys (truncate round 2))))))
115
        (values d0 d1)))
116
     (t
117
      (let* ((d0 (logxor d0 (logior d1 (aref keys (mod (+ (truncate (1- round) 2) 4) 8)))))
118
             (d1 (logxor d1 (logand d0 (aref keys (+ (mod (+ (truncate (1- round) 2) 2) 8) 8))))))
119
        (values d0 d1)))))
120
 
121
 (defun fo (t0 t1 keys round)
122
   (declare (type misty1-round-keys keys))
123
   (declare (type (unsigned-byte 16) t0 t1))
124
   (setf t0 (logxor t0 (aref keys round))
125
         t0 (fi t0 (aref keys (+ (mod (+ round 5) 8) 8)))
126
         t0 (logxor t0 t1)
127
         t1 (logxor t1 (aref keys (mod (+ round 2) 8)))
128
         t1 (fi t1 (aref keys (+ (mod (+ round 1) 8) 8)))
129
         t1 (logxor t1 t0)
130
         t0 (logxor t0 (aref keys (mod (+ round 7) 8)))
131
         t0 (fi t0 (aref keys (+ (mod (+ round 3) 8) 8)))
132
         t0 (logxor t0 t1)
133
         t1 (logxor t1 (aref keys (mod (+ round 4) 8))))
134
   (values t1 t0))
135
 
136
 (define-block-encryptor misty1 8
137
   (let ((round-keys (round-keys context)))
138
     (with-words ((d00 d01 d10 d11) plaintext plaintext-start :size 2)
139
       #.(loop for i from 0 below 8
140
               if (evenp i)
141
                 collect `(progn
142
                           (multiple-value-setq (d00 d01) (fl d00 d01 round-keys ,i))
143
                           (multiple-value-setq (d10 d11) (fl d10 d11 round-keys (1+ ,i)))
144
                           (multiple-value-bind (t0 t1) (fo d00 d01 round-keys ,i)
145
                             (declare (type (unsigned-byte 16) t0 t1))
146
                             (multiple-value-setq (d10 d11)
147
                               (values (logxor d10 t0) (logxor d11 t1))))) into forms
148
               else
149
                 collect `(multiple-value-bind (t0 t1) (fo d10 d11 round-keys ,i)
150
                           (declare (type (unsigned-byte 16) t0 t1))
151
                           (multiple-value-setq (d00 d01)
152
                             (values (logxor d00 t0) (logxor d01 t1)))) into forms
153
               finally (return `(progn
154
                                 ,@forms
155
                                 (multiple-value-setq (d00 d01) (fl d00 d01 round-keys 8))
156
                                 (multiple-value-setq (d10 d11) (fl d10 d11 round-keys 9)))))
157
       (store-words ciphertext ciphertext-start d10 d11 d00 d01))))
158
 
159
 (define-block-decryptor misty1 8
160
   (let ((round-keys (round-keys context)))
161
     (with-words ((d10 d11 d00 d01) ciphertext ciphertext-start :size 2)
162
       #.(loop for i from 7 downto 0
163
               if (evenp i)
164
                 collect `(progn
165
                           (multiple-value-bind (t0 t1) (fo d00 d01 round-keys ,i)
166
                             (declare (type (unsigned-byte 16) t0 t1))
167
                             (multiple-value-setq (d10 d11)
168
                               (values (logxor d10 t0) (logxor d11 t1))))
169
                           (multiple-value-setq (d00 d01) (fl-inv d00 d01 round-keys ,i))
170
                           (multiple-value-setq (d10 d11) (fl-inv d10 d11 round-keys (1+ ,i)))) into forms
171
               else
172
                 collect `(multiple-value-bind (t0 t1) (fo d10 d11 round-keys ,i)
173
                           (declare (type (unsigned-byte 16) t0 t1))
174
                           (multiple-value-setq (d00 d01)
175
                             (values (logxor d00 t0) (logxor d01 t1)))) into forms
176
               finally (return `(progn
177
                                 (multiple-value-setq (d00 d01) (fl-inv d00 d01 round-keys 8))
178
                                 (multiple-value-setq (d10 d11) (fl-inv d10 d11 round-keys 9))
179
                                 ,@forms)))
180
       (store-words plaintext plaintext-start d00 d01 d10 d11))))
181
 
182
 (defun misty1-expand-key (key)
183
   (declare (type (simple-array (unsigned-byte 8) (16)) key))
184
   (let ((key-schedule (make-array 32 :element-type '(unsigned-byte 16))))
185
     (declare (type (simple-array (unsigned-byte 16) (32)) key-schedule))
186
     ;; fill in the expanded key schedule
187
     (loop for i from 0 below 16 by 2
188
           for j from 0 below 8
189
           do (setf (aref key-schedule j) (ub16ref/be key i)))
190
     ;; scramble
191
     (dotimes (i 8 key-schedule)
192
       (setf (aref key-schedule (+ i 8)) (fi (aref key-schedule i)
193
                                           (aref key-schedule (mod (1+ i) 8)))
194
             (aref key-schedule (+ i 16)) (logand (aref key-schedule (+ i 8))
195
                                                #x01ff)
196
             (aref key-schedule (+ i 24)) (ash (aref key-schedule (+ i 8)) -9)))))
197
 
198
 (defmethod schedule-key ((cipher misty1) key)
199
   (let ((round-keys (misty1-expand-key key)))
200
     (setf (round-keys cipher) round-keys)
201
     cipher))
202
 
203
 (defcipher misty1
204
   (:encrypt-function misty1-encrypt-block)
205
   (:decrypt-function misty1-decrypt-block)
206
   (:block-length 8)
207
   (:key-length (:fixed 16)))