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

KindCoveredAll%
expression0362 0.0
branch014 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; sosemanuk.lisp - implementation of the Sosemanuk stream cipher
2
 (in-package :crypto)
3
 
4
 (defconst +sosemanuk-mul-a+
5
   (make-array 256
6
               :element-type '(unsigned-byte 32)
7
               :initial-contents '(#x00000000 #xE19FCF13 #x6B973726 #x8A08F835
8
                                   #xD6876E4C #x3718A15F #xBD10596A #x5C8F9679
9
                                   #x05A7DC98 #xE438138B #x6E30EBBE #x8FAF24AD
10
                                   #xD320B2D4 #x32BF7DC7 #xB8B785F2 #x59284AE1
11
                                   #x0AE71199 #xEB78DE8A #x617026BF #x80EFE9AC
12
                                   #xDC607FD5 #x3DFFB0C6 #xB7F748F3 #x566887E0
13
                                   #x0F40CD01 #xEEDF0212 #x64D7FA27 #x85483534
14
                                   #xD9C7A34D #x38586C5E #xB250946B #x53CF5B78
15
                                   #x1467229B #xF5F8ED88 #x7FF015BD #x9E6FDAAE
16
                                   #xC2E04CD7 #x237F83C4 #xA9777BF1 #x48E8B4E2
17
                                   #x11C0FE03 #xF05F3110 #x7A57C925 #x9BC80636
18
                                   #xC747904F #x26D85F5C #xACD0A769 #x4D4F687A
19
                                   #x1E803302 #xFF1FFC11 #x75170424 #x9488CB37
20
                                   #xC8075D4E #x2998925D #xA3906A68 #x420FA57B
21
                                   #x1B27EF9A #xFAB82089 #x70B0D8BC #x912F17AF
22
                                   #xCDA081D6 #x2C3F4EC5 #xA637B6F0 #x47A879E3
23
                                   #x28CE449F #xC9518B8C #x435973B9 #xA2C6BCAA
24
                                   #xFE492AD3 #x1FD6E5C0 #x95DE1DF5 #x7441D2E6
25
                                   #x2D699807 #xCCF65714 #x46FEAF21 #xA7616032
26
                                   #xFBEEF64B #x1A713958 #x9079C16D #x71E60E7E
27
                                   #x22295506 #xC3B69A15 #x49BE6220 #xA821AD33
28
                                   #xF4AE3B4A #x1531F459 #x9F390C6C #x7EA6C37F
29
                                   #x278E899E #xC611468D #x4C19BEB8 #xAD8671AB
30
                                   #xF109E7D2 #x109628C1 #x9A9ED0F4 #x7B011FE7
31
                                   #x3CA96604 #xDD36A917 #x573E5122 #xB6A19E31
32
                                   #xEA2E0848 #x0BB1C75B #x81B93F6E #x6026F07D
33
                                   #x390EBA9C #xD891758F #x52998DBA #xB30642A9
34
                                   #xEF89D4D0 #x0E161BC3 #x841EE3F6 #x65812CE5
35
                                   #x364E779D #xD7D1B88E #x5DD940BB #xBC468FA8
36
                                   #xE0C919D1 #x0156D6C2 #x8B5E2EF7 #x6AC1E1E4
37
                                   #x33E9AB05 #xD2766416 #x587E9C23 #xB9E15330
38
                                   #xE56EC549 #x04F10A5A #x8EF9F26F #x6F663D7C
39
                                   #x50358897 #xB1AA4784 #x3BA2BFB1 #xDA3D70A2
40
                                   #x86B2E6DB #x672D29C8 #xED25D1FD #x0CBA1EEE
41
                                   #x5592540F #xB40D9B1C #x3E056329 #xDF9AAC3A
42
                                   #x83153A43 #x628AF550 #xE8820D65 #x091DC276
43
                                   #x5AD2990E #xBB4D561D #x3145AE28 #xD0DA613B
44
                                   #x8C55F742 #x6DCA3851 #xE7C2C064 #x065D0F77
45
                                   #x5F754596 #xBEEA8A85 #x34E272B0 #xD57DBDA3
46
                                   #x89F22BDA #x686DE4C9 #xE2651CFC #x03FAD3EF
47
                                   #x4452AA0C #xA5CD651F #x2FC59D2A #xCE5A5239
48
                                   #x92D5C440 #x734A0B53 #xF942F366 #x18DD3C75
49
                                   #x41F57694 #xA06AB987 #x2A6241B2 #xCBFD8EA1
50
                                   #x977218D8 #x76EDD7CB #xFCE52FFE #x1D7AE0ED
51
                                   #x4EB5BB95 #xAF2A7486 #x25228CB3 #xC4BD43A0
52
                                   #x9832D5D9 #x79AD1ACA #xF3A5E2FF #x123A2DEC
53
                                   #x4B12670D #xAA8DA81E #x2085502B #xC11A9F38
54
                                   #x9D950941 #x7C0AC652 #xF6023E67 #x179DF174
55
                                   #x78FBCC08 #x9964031B #x136CFB2E #xF2F3343D
56
                                   #xAE7CA244 #x4FE36D57 #xC5EB9562 #x24745A71
57
                                   #x7D5C1090 #x9CC3DF83 #x16CB27B6 #xF754E8A5
58
                                   #xABDB7EDC #x4A44B1CF #xC04C49FA #x21D386E9
59
                                   #x721CDD91 #x93831282 #x198BEAB7 #xF81425A4
60
                                   #xA49BB3DD #x45047CCE #xCF0C84FB #x2E934BE8
61
                                   #x77BB0109 #x9624CE1A #x1C2C362F #xFDB3F93C
62
                                   #xA13C6F45 #x40A3A056 #xCAAB5863 #x2B349770
63
                                   #x6C9CEE93 #x8D032180 #x070BD9B5 #xE69416A6
64
                                   #xBA1B80DF #x5B844FCC #xD18CB7F9 #x301378EA
65
                                   #x693B320B #x88A4FD18 #x02AC052D #xE333CA3E
66
                                   #xBFBC5C47 #x5E239354 #xD42B6B61 #x35B4A472
67
                                   #x667BFF0A #x87E43019 #x0DECC82C #xEC73073F
68
                                   #xB0FC9146 #x51635E55 #xDB6BA660 #x3AF46973
69
                                   #x63DC2392 #x8243EC81 #x084B14B4 #xE9D4DBA7
70
                                   #xB55B4DDE #x54C482CD #xDECC7AF8 #x3F53B5EB)))
71
 
72
 (defconst +sosemanuk-mul-ia+
73
   (make-array 256
74
               :element-type '(unsigned-byte 32)
75
               :initial-contents '(#x00000000 #x180F40CD #x301E8033 #x2811C0FE
76
                                   #x603CA966 #x7833E9AB #x50222955 #x482D6998
77
                                   #xC078FBCC #xD877BB01 #xF0667BFF #xE8693B32
78
                                   #xA04452AA #xB84B1267 #x905AD299 #x88559254
79
                                   #x29F05F31 #x31FF1FFC #x19EEDF02 #x01E19FCF
80
                                   #x49CCF657 #x51C3B69A #x79D27664 #x61DD36A9
81
                                   #xE988A4FD #xF187E430 #xD99624CE #xC1996403
82
                                   #x89B40D9B #x91BB4D56 #xB9AA8DA8 #xA1A5CD65
83
                                   #x5249BE62 #x4A46FEAF #x62573E51 #x7A587E9C
84
                                   #x32751704 #x2A7A57C9 #x026B9737 #x1A64D7FA
85
                                   #x923145AE #x8A3E0563 #xA22FC59D #xBA208550
86
                                   #xF20DECC8 #xEA02AC05 #xC2136CFB #xDA1C2C36
87
                                   #x7BB9E153 #x63B6A19E #x4BA76160 #x53A821AD
88
                                   #x1B854835 #x038A08F8 #x2B9BC806 #x339488CB
89
                                   #xBBC11A9F #xA3CE5A52 #x8BDF9AAC #x93D0DA61
90
                                   #xDBFDB3F9 #xC3F2F334 #xEBE333CA #xF3EC7307
91
                                   #xA492D5C4 #xBC9D9509 #x948C55F7 #x8C83153A
92
                                   #xC4AE7CA2 #xDCA13C6F #xF4B0FC91 #xECBFBC5C
93
                                   #x64EA2E08 #x7CE56EC5 #x54F4AE3B #x4CFBEEF6
94
                                   #x04D6876E #x1CD9C7A3 #x34C8075D #x2CC74790
95
                                   #x8D628AF5 #x956DCA38 #xBD7C0AC6 #xA5734A0B
96
                                   #xED5E2393 #xF551635E #xDD40A3A0 #xC54FE36D
97
                                   #x4D1A7139 #x551531F4 #x7D04F10A #x650BB1C7
98
                                   #x2D26D85F #x35299892 #x1D38586C #x053718A1
99
                                   #xF6DB6BA6 #xEED42B6B #xC6C5EB95 #xDECAAB58
100
                                   #x96E7C2C0 #x8EE8820D #xA6F942F3 #xBEF6023E
101
                                   #x36A3906A #x2EACD0A7 #x06BD1059 #x1EB25094
102
                                   #x569F390C #x4E9079C1 #x6681B93F #x7E8EF9F2
103
                                   #xDF2B3497 #xC724745A #xEF35B4A4 #xF73AF469
104
                                   #xBF179DF1 #xA718DD3C #x8F091DC2 #x97065D0F
105
                                   #x1F53CF5B #x075C8F96 #x2F4D4F68 #x37420FA5
106
                                   #x7F6F663D #x676026F0 #x4F71E60E #x577EA6C3
107
                                   #xE18D0321 #xF98243EC #xD1938312 #xC99CC3DF
108
                                   #x81B1AA47 #x99BEEA8A #xB1AF2A74 #xA9A06AB9
109
                                   #x21F5F8ED #x39FAB820 #x11EB78DE #x09E43813
110
                                   #x41C9518B #x59C61146 #x71D7D1B8 #x69D89175
111
                                   #xC87D5C10 #xD0721CDD #xF863DC23 #xE06C9CEE
112
                                   #xA841F576 #xB04EB5BB #x985F7545 #x80503588
113
                                   #x0805A7DC #x100AE711 #x381B27EF #x20146722
114
                                   #x68390EBA #x70364E77 #x58278E89 #x4028CE44
115
                                   #xB3C4BD43 #xABCBFD8E #x83DA3D70 #x9BD57DBD
116
                                   #xD3F81425 #xCBF754E8 #xE3E69416 #xFBE9D4DB
117
                                   #x73BC468F #x6BB30642 #x43A2C6BC #x5BAD8671
118
                                   #x1380EFE9 #x0B8FAF24 #x239E6FDA #x3B912F17
119
                                   #x9A34E272 #x823BA2BF #xAA2A6241 #xB225228C
120
                                   #xFA084B14 #xE2070BD9 #xCA16CB27 #xD2198BEA
121
                                   #x5A4C19BE #x42435973 #x6A52998D #x725DD940
122
                                   #x3A70B0D8 #x227FF015 #x0A6E30EB #x12617026
123
                                   #x451FD6E5 #x5D109628 #x750156D6 #x6D0E161B
124
                                   #x25237F83 #x3D2C3F4E #x153DFFB0 #x0D32BF7D
125
                                   #x85672D29 #x9D686DE4 #xB579AD1A #xAD76EDD7
126
                                   #xE55B844F #xFD54C482 #xD545047C #xCD4A44B1
127
                                   #x6CEF89D4 #x74E0C919 #x5CF109E7 #x44FE492A
128
                                   #x0CD320B2 #x14DC607F #x3CCDA081 #x24C2E04C
129
                                   #xAC977218 #xB49832D5 #x9C89F22B #x8486B2E6
130
                                   #xCCABDB7E #xD4A49BB3 #xFCB55B4D #xE4BA1B80
131
                                   #x17566887 #x0F59284A #x2748E8B4 #x3F47A879
132
                                   #x776AC1E1 #x6F65812C #x477441D2 #x5F7B011F
133
                                   #xD72E934B #xCF21D386 #xE7301378 #xFF3F53B5
134
                                   #xB7123A2D #xAF1D7AE0 #x870CBA1E #x9F03FAD3
135
                                   #x3EA637B6 #x26A9777B #x0EB8B785 #x16B7F748
136
                                   #x5E9A9ED0 #x4695DE1D #x6E841EE3 #x768B5E2E
137
                                   #xFEDECC7A #xE6D18CB7 #xCEC04C49 #xD6CF0C84
138
                                   #x9EE2651C #x86ED25D1 #xAEFCE52F #xB6F3A5E2)))
139
 
140
 (defmacro sosemanuk-s0 (x0 x1 x2 x3 x4)
141
   `(setf ,x3 (logxor ,x3 ,x0)
142
          ,x4 ,x1
143
          ,x1 (logand ,x1 ,x3)
144
          ,x4 (logxor ,x4 ,x2)
145
          ,x1 (logxor ,x1 ,x0)
146
          ,x0 (logior ,x0 ,x3)
147
          ,x0 (logxor ,x0 ,x4)
148
          ,x4 (logxor ,x4 ,x3)
149
          ,x3 (logxor ,x3 ,x2)
150
          ,x2 (logior ,x2 ,x1)
151
          ,x2 (logxor ,x2 ,x4)
152
          ,x4 (mod32lognot ,x4)
153
          ,x4 (logior ,x4 ,x1)
154
          ,x1 (logxor ,x1 ,x3)
155
          ,x1 (logxor ,x1 ,x4)
156
          ,x3 (logior ,x3 ,x0)
157
          ,x1 (logxor ,x1 ,x3)
158
          ,x4 (logxor ,x4 ,x3)))
159
 
160
 (defmacro sosemanuk-s1 (x0 x1 x2 x3 x4)
161
   `(setf ,x0 (mod32lognot ,x0)
162
          ,x2 (mod32lognot ,x2)
163
          ,x4 ,x0
164
          ,x0 (logand ,x0 ,x1)
165
          ,x2 (logxor ,x2 ,x0)
166
          ,x0 (logior ,x0 ,x3)
167
          ,x3 (logxor ,x3 ,x2)
168
          ,x1 (logxor ,x1 ,x0)
169
          ,x0 (logxor ,x0 ,x4)
170
          ,x4 (logior ,x4 ,x1)
171
          ,x1 (logxor ,x1 ,x3)
172
          ,x2 (logior ,x2 ,x0)
173
          ,x2 (logand ,x2 ,x4)
174
          ,x0 (logxor ,x0 ,x1)
175
          ,x1 (logand ,x1 ,x2)
176
          ,x1 (logxor ,x1 ,x0)
177
          ,x0 (logand ,x0 ,x2)
178
          ,x0 (logxor ,x0 ,x4)))
179
 
180
 (defmacro sosemanuk-s2 (x0 x1 x2 x3 x4)
181
   `(setf ,x4 ,x0
182
          ,x0 (logand ,x0 ,x2)
183
          ,x0 (logxor ,x0 ,x3)
184
          ,x2 (logxor ,x2 ,x1)
185
          ,x2 (logxor ,x2 ,x0)
186
          ,x3 (logior ,x3 ,x4)
187
          ,x3 (logxor ,x3 ,x1)
188
          ,x4 (logxor ,x4 ,x2)
189
          ,x1 ,x3
190
          ,x3 (logior ,x3 ,x4)
191
          ,x3 (logxor ,x3 ,x0)
192
          ,x0 (logand ,x0 ,x1)
193
          ,x4 (logxor ,x4 ,x0)
194
          ,x1 (logxor ,x1 ,x3)
195
          ,x1 (logxor ,x1 ,x4)
196
          ,x4 (mod32lognot ,x4)))
197
 
198
 (defmacro sosemanuk-s3 (x0 x1 x2 x3 x4)
199
   `(setf ,x4 ,x0
200
          ,x0 (logior ,x0 ,x3)
201
          ,x3 (logxor ,x3 ,x1)
202
          ,x1 (logand ,x1 ,x4)
203
          ,x4 (logxor ,x4 ,x2)
204
          ,x2 (logxor ,x2 ,x3)
205
          ,x3 (logand ,x3 ,x0)
206
          ,x4 (logior ,x4 ,x1)
207
          ,x3 (logxor ,x3 ,x4)
208
          ,x0 (logxor ,x0 ,x1)
209
          ,x4 (logand ,x4 ,x0)
210
          ,x1 (logxor ,x1 ,x3)
211
          ,x4 (logxor ,x4 ,x2)
212
          ,x1 (logior ,x1 ,x0)
213
          ,x1 (logxor ,x1 ,x2)
214
          ,x0 (logxor ,x0 ,x3)
215
          ,x2 ,x1
216
          ,x1 (logior ,x1 ,x3)
217
          ,x1 (logxor ,x1 ,x0)))
218
 
219
 (defmacro sosemanuk-s4 (x0 x1 x2 x3 x4)
220
   `(setf ,x1 (logxor ,x1 ,x3)
221
          ,x3 (mod32lognot ,x3)
222
          ,x2 (logxor ,x2 ,x3)
223
          ,x3 (logxor ,x3 ,x0)
224
          ,x4 ,x1
225
          ,x1 (logand ,x1 ,x3)
226
          ,x1 (logxor ,x1 ,x2)
227
          ,x4 (logxor ,x4 ,x3)
228
          ,x0 (logxor ,x0 ,x4)
229
          ,x2 (logand ,x2 ,x4)
230
          ,x2 (logxor ,x2 ,x0)
231
          ,x0 (logand ,x0 ,x1)
232
          ,x3 (logxor ,x3 ,x0)
233
          ,x4 (logior ,x4 ,x1)
234
          ,x4 (logxor ,x4 ,x0)
235
          ,x0 (logior ,x0 ,x3)
236
          ,x0 (logxor ,x0 ,x2)
237
          ,x2 (logand ,x2 ,x3)
238
          ,x0 (mod32lognot ,x0)
239
          ,x4 (logxor ,x4 ,x2)))
240
 
241
 (defmacro sosemanuk-s5 (x0 x1 x2 x3 x4)
242
   `(setf ,x0 (logxor ,x0 ,x1)
243
          ,x1 (logxor ,x1 ,x3)
244
          ,x3 (mod32lognot ,x3)
245
          ,x4 ,x1
246
          ,x1 (logand ,x1 ,x0)
247
          ,x2 (logxor ,x2 ,x3)
248
          ,x1 (logxor ,x1 ,x2)
249
          ,x2 (logior ,x2 ,x4)
250
          ,x4 (logxor ,x4 ,x3)
251
          ,x3 (logand ,x3 ,x1)
252
          ,x3 (logxor ,x3 ,x0)
253
          ,x4 (logxor ,x4 ,x1)
254
          ,x4 (logxor ,x4 ,x2)
255
          ,x2 (logxor ,x2 ,x0)
256
          ,x0 (logand ,x0 ,x3)
257
          ,x2 (mod32lognot ,x2)
258
          ,x0 (logxor ,x0 ,x4)
259
          ,x4 (logior ,x4 ,x3)
260
          ,x2 (logxor ,x2 ,x4)))
261
 
262
 (defmacro sosemanuk-s6 (x0 x1 x2 x3 x4)
263
   `(setf ,x2 (mod32lognot ,x2)
264
          ,x4 ,x3
265
          ,x3 (logand ,x3 ,x0)
266
          ,x0 (logxor ,x0 ,x4)
267
          ,x3 (logxor ,x3 ,x2)
268
          ,x2 (logior ,x2 ,x4)
269
          ,x1 (logxor ,x1 ,x3)
270
          ,x2 (logxor ,x2 ,x0)
271
          ,x0 (logior ,x0 ,x1)
272
          ,x2 (logxor ,x2 ,x1)
273
          ,x4 (logxor ,x4 ,x0)
274
          ,x0 (logior ,x0 ,x3)
275
          ,x0 (logxor ,x0 ,x2)
276
          ,x4 (logxor ,x4 ,x3)
277
          ,x4 (logxor ,x4 ,x0)
278
          ,x3 (mod32lognot ,x3)
279
          ,x2 (logand ,x2 ,x4)
280
          ,x2 (logxor ,x2 ,x3)))
281
 
282
 (defmacro sosemanuk-s7 (x0 x1 x2 x3 x4)
283
   `(setf ,x4 ,x1
284
          ,x1 (logior ,x1 ,x2)
285
          ,x1 (logxor ,x1 ,x3)
286
          ,x4 (logxor ,x4 ,x2)
287
          ,x2 (logxor ,x2 ,x1)
288
          ,x3 (logior ,x3 ,x4)
289
          ,x3 (logand ,x3 ,x0)
290
          ,x4 (logxor ,x4 ,x2)
291
          ,x3 (logxor ,x3 ,x1)
292
          ,x1 (logior ,x1 ,x4)
293
          ,x1 (logxor ,x1 ,x0)
294
          ,x0 (logior ,x0 ,x4)
295
          ,x0 (logxor ,x0 ,x2)
296
          ,x1 (logxor ,x1 ,x4)
297
          ,x2 (logxor ,x2 ,x1)
298
          ,x1 (logand ,x1 ,x0)
299
          ,x1 (logxor ,x1 ,x4)
300
          ,x2 (mod32lognot ,x2)
301
          ,x2 (logior ,x2 ,x0)
302
          ,x4 (logxor ,x4 ,x2)))
303
 
304
 (defmacro sosemanuk-lt (x0 x1 x2 x3)
305
   `(setf ,x0 (rol32 ,x0 13)
306
          ,x2 (rol32 ,x2 3)
307
          ,x1 (logxor ,x1 ,x0 ,x2)
308
          ,x3 (logxor ,x3 ,x2 (mod32ash ,x0 3))
309
          ,x1 (rol32 ,x1 1)
310
          ,x3 (rol32 ,x3 7)
311
          ,x0 (logxor ,x0 ,x1 ,x3)
312
          ,x2 (logxor ,x2 ,x3 (mod32ash ,x1 7))
313
          ,x0 (rol32 ,x0 5)
314
          ,x2 (rol32 ,x2 22)))
315
 
316
 (defclass sosemanuk (stream-cipher)
317
   ((state :accessor sosemanuk-state
318
           :initform (make-array 10 :element-type '(unsigned-byte 32))
319
           :type (simple-array (unsigned-byte 32) (10)))
320
    (state-r :accessor sosemanuk-state-r
321
             :initform (make-array 2 :element-type '(unsigned-byte 32))
322
             :type (simple-array (unsigned-byte 32) (2)))
323
    (keystream-buffer :accessor sosemanuk-keystream-buffer
324
                      :initform (make-array 80 :element-type '(unsigned-byte 8))
325
                      :type (simple-array (unsigned-byte 8) (80)))
326
    (keystream-buffer-remaining :accessor sosemanuk-keystream-buffer-remaining
327
                                :initform 0
328
                                :type (integer 0 80))
329
    (subkeys :accessor sosemanuk-subkeys
330
             :type (or (simple-array (unsigned-byte 32) (100)) null))))
331
 
332
 (defmethod schedule-key ((cipher sosemanuk) key)
333
   (let ((key-length (length key))
334
         (subkeys (make-array 100 :element-type '(unsigned-byte 32)))
335
         (buffer (make-array 32 :element-type '(unsigned-byte 8)))
336
         (w0 0)
337
         (w1 0)
338
         (w2 0)
339
         (w3 0)
340
         (w4 0)
341
         (w5 0)
342
         (w6 0)
343
         (w7 0)
344
         (i 0))
345
     (declare (type (simple-array (unsigned-byte 32) (100)) subkeys)
346
              (type (simple-array (unsigned-byte 8) (32)) buffer)
347
              (type (unsigned-byte 32) w0 w1 w2 w3 w4 w5 w6 w7)
348
              (type fixnum key-length i))
349
     (replace buffer key :end2 key-length)
350
     (when (< key-length 32)
351
       (setf (aref buffer key-length) 1)
352
       (when (< key-length 31)
353
         (fill buffer 0 :start (1+ key-length))))
354
     (setf w0 (ub32ref/le buffer 0)
355
           w1 (ub32ref/le buffer 4)
356
           w2 (ub32ref/le buffer 8)
357
           w3 (ub32ref/le buffer 12)
358
           w4 (ub32ref/le buffer 16)
359
           w5 (ub32ref/le buffer 20)
360
           w6 (ub32ref/le buffer 24)
361
           w7 (ub32ref/le buffer 28))
362
 
363
     (macrolet ((sks (s o0 o1 o2 o3 d0 d1 d2 d3)
364
                  `(let ((r0 ,(symbolicate '#:w o0))
365
                         (r1 ,(symbolicate '#:w o1))
366
                         (r2 ,(symbolicate '#:w o2))
367
                         (r3 ,(symbolicate '#:w o3))
368
                         (r4 0))
369
                     (declare (type (unsigned-byte 32) r0 r1 r2 r3))
370
                     (,s r0 r1 r2 r3 r4)
371
                     (setf (aref subkeys i) ,(symbolicate '#:r d0))
372
                     (incf i)
373
                     (setf (aref subkeys i) ,(symbolicate '#:r d1))
374
                     (incf i)
375
                     (setf (aref subkeys i) ,(symbolicate '#:r d2))
376
                     (incf i)
377
                     (setf (aref subkeys i) ,(symbolicate '#:r d3))
378
                     (incf i)))
379
                (sks0 ()
380
                  `(sks sosemanuk-s0 4 5 6 7 1 4 2 0))
381
                (sks1 ()
382
                  `(sks sosemanuk-s1 0 1 2 3 2 0 3 1))
383
                (sks2 ()
384
                  `(sks sosemanuk-s2 4 5 6 7 2 3 1 4))
385
                (sks3 ()
386
                  `(sks sosemanuk-s3 0 1 2 3 1 2 3 4))
387
                (sks4 ()
388
                  `(sks sosemanuk-s4 4 5 6 7 1 4 0 3))
389
                (sks5 ()
390
                  `(sks sosemanuk-s5 0 1 2 3 1 3 0 2))
391
                (sks6 ()
392
                  `(sks sosemanuk-s6 4 5 6 7 0 1 4 2))
393
                (sks7 ()
394
                  `(sks sosemanuk-s7 0 1 2 3 4 3 1 0))
395
                (wup (wi wi5 wi3 wi1 cc)
396
                  `(setf ,wi (rol32 (logxor ,wi ,wi5 ,wi3 ,wi1 ,cc #x9e3779b9) 11)))
397
                (wup0 (cc)
398
                  `(progn
399
                     (wup w0 w3 w5 w7 ,cc)
400
                     (wup w1 w4 w6 w0 ,(+ cc 1))
401
                     (wup w2 w5 w7 w1 ,(+ cc 2))
402
                     (wup w3 w6 w0 w2 ,(+ cc 3))))
403
                (wup1 (cc)
404
                  `(progn
405
                     (wup w4 w7 w1 w3 ,cc)
406
                     (wup w5 w0 w2 w4 ,(+ cc 1))
407
                     (wup w6 w1 w3 w5 ,(+ cc 2))
408
                     (wup w7 w2 w4 w6 ,(+ cc 3)))))
409
       (wup0 0) (sks3)
410
       (wup1 4) (sks2)
411
       (wup0 8) (sks1)
412
       (wup1 12) (sks0)
413
       (wup0 16) (sks7)
414
       (wup1 20) (sks6)
415
       (wup0 24) (sks5)
416
       (wup1 28) (sks4)
417
       (wup0 32) (sks3)
418
       (wup1 36) (sks2)
419
       (wup0 40) (sks1)
420
       (wup1 44) (sks0)
421
       (wup0 48) (sks7)
422
       (wup1 52) (sks6)
423
       (wup0 56) (sks5)
424
       (wup1 60) (sks4)
425
       (wup0 64) (sks3)
426
       (wup1 68) (sks2)
427
       (wup0 72) (sks1)
428
       (wup1 76) (sks0)
429
       (wup0 80) (sks7)
430
       (wup1 84) (sks6)
431
       (wup0 88) (sks5)
432
       (wup1 92) (sks4)
433
       (wup0 96) (sks3)
434
       (setf (sosemanuk-subkeys cipher) subkeys)))
435
   cipher)
436
 
437
 (defmethod shared-initialize :after ((cipher sosemanuk) slot-names &rest initargs &key initialization-vector &allow-other-keys)
438
   (declare (ignore slot-names initargs))
439
   (let ((state (sosemanuk-state cipher))
440
         (state-r (sosemanuk-state-r cipher))
441
         (subkeys (sosemanuk-subkeys cipher))
442
         (r0 0)
443
         (r1 0)
444
         (r2 0)
445
         (r3 0)
446
         (r4 0))
447
     (declare (type (simple-array (unsigned-byte 32) (*)) state state-r subkeys)
448
              (type (unsigned-byte 32) r0 r1 r2 r3 r4))
449
     (when initialization-vector
450
       (if (= (length initialization-vector) 16)
451
           (setf r0 (ub32ref/le initialization-vector 0)
452
                 r1 (ub32ref/le initialization-vector 4)
453
                 r2 (ub32ref/le initialization-vector 8)
454
                 r3 (ub32ref/le initialization-vector 12))
455
           (error 'invalid-initialization-vector
456
                  :cipher (class-name (class-of cipher))
457
                  :block-length 16)))
458
 
459
     (macrolet ((ka (zc x0 x1 x2 x3)
460
                  `(setf ,x0 (logxor ,x0 (aref subkeys ,zc))
461
                         ,x1 (logxor ,x1 (aref subkeys ,(+ zc 1)))
462
                         ,x2 (logxor ,x2 (aref subkeys ,(+ zc 2)))
463
                         ,x3 (logxor ,x3 (aref subkeys ,(+ zc 3)))))
464
                (fss (zc s i0 i1 i2 i3 i4 o0 o1 o2 o3)
465
                  `(progn
466
                     (ka ,zc
467
                         ,(symbolicate '#:r i0)
468
                         ,(symbolicate '#:r i1)
469
                         ,(symbolicate '#:r i2)
470
                         ,(symbolicate '#:r i3))
471
                     (,s ,(symbolicate '#:r i0)
472
                         ,(symbolicate '#:r i1)
473
                         ,(symbolicate '#:r i2)
474
                         ,(symbolicate '#:r i3)
475
                         ,(symbolicate '#:r i4))
476
                     (sosemanuk-lt ,(symbolicate '#:r o0)
477
                                   ,(symbolicate '#:r o1)
478
                                   ,(symbolicate '#:r o2)
479
                                   ,(symbolicate '#:r o3))))
480
                (fsf (zc s i0 i1 i2 i3 i4 o0 o1 o2 o3)
481
                  `(progn
482
                     (fss ,zc ,s ,i0 ,i1 ,i2 ,i3 ,i4 ,o0 ,o1 ,o2 ,o3)
483
                     (ka ,(+ zc 4)
484
                         ,(symbolicate '#:r o0)
485
                         ,(symbolicate '#:r o1)
486
                         ,(symbolicate '#:r o2)
487
                         ,(symbolicate '#:r o3)))))
488
       (fss 0 sosemanuk-s0 0 1 2 3 4 1 4 2 0)
489
       (fss 4 sosemanuk-s1 1 4 2 0 3 2 1 0 4)
490
       (fss 8 sosemanuk-s2 2 1 0 4 3 0 4 1 3)
491
       (fss 12 sosemanuk-s3 0 4 1 3 2 4 1 3 2)
492
       (fss 16 sosemanuk-s4 4 1 3 2 0 1 0 4 2)
493
       (fss 20 sosemanuk-s5 1 0 4 2 3 0 2 1 4)
494
       (fss 24 sosemanuk-s6 0 2 1 4 3 0 2 3 1)
495
       (fss 28 sosemanuk-s7 0 2 3 1 4 4 1 2 0)
496
       (fss 32 sosemanuk-s0 4 1 2 0 3 1 3 2 4)
497
       (fss 36 sosemanuk-s1 1 3 2 4 0 2 1 4 3)
498
       (fss 40 sosemanuk-s2 2 1 4 3 0 4 3 1 0)
499
       (fss 44 sosemanuk-s3 4 3 1 0 2 3 1 0 2)
500
       (setf (aref state 9) r3
501
             (aref state 8) r1
502
             (aref state 7) r0
503
             (aref state 6) r2)
504
       (fss 48 sosemanuk-s4 3 1 0 2 4 1 4 3 2)
505
       (fss 52 sosemanuk-s5 1 4 3 2 0 4 2 1 3)
506
       (fss 56 sosemanuk-s6 4 2 1 3 0 4 2 0 1)
507
       (fss 60 sosemanuk-s7 4 2 0 1 3 3 1 2 4)
508
       (fss 64 sosemanuk-s0 3 1 2 4 0 1 0 2 3)
509
       (fss 68 sosemanuk-s1 1 0 2 3 4 2 1 3 0)
510
       (setf (aref state-r 0) r2
511
             (aref state 4) r1
512
             (aref state-r 1) r3
513
             (aref state 5) r0)
514
       (fss 72 sosemanuk-s2 2 1 3 0 4 3 0 1 4)
515
       (fss 76 sosemanuk-s3 3 0 1 4 2 0 1 4 2)
516
       (fss 80 sosemanuk-s4 0 1 4 2 3 1 3 0 2)
517
       (fss 84 sosemanuk-s5 1 3 0 2 4 3 2 1 0)
518
       (fss 88 sosemanuk-s6 3 2 1 0 4 3 2 4 1)
519
       (fsf 92 sosemanuk-s7 3 2 4 1 0 0 1 2 3)
520
       (setf (aref state 3) r0
521
             (aref state 2) r1
522
             (aref state 1) r2
523
             (aref state 0) r3))
524
 
525
     (fill subkeys 0)
526
     (setf (sosemanuk-subkeys cipher) nil
527
           (sosemanuk-keystream-buffer-remaining cipher) 0))
528
   cipher)
529
 
530
 (defun sosemanuk-compute-block (state state-r buffer)
531
   (declare (type (simple-array (unsigned-byte 32) (*)) state state-r)
532
            (type (simple-array (unsigned-byte 8) (80)) buffer)
533
            (optimize (speed 3) (space 0) (safety 0) (debug 0)))
534
   (let ((s0 (aref state 0))
535
         (s1 (aref state 1))
536
         (s2 (aref state 2))
537
         (s3 (aref state 3))
538
         (s4 (aref state 4))
539
         (s5 (aref state 5))
540
         (s6 (aref state 6))
541
         (s7 (aref state 7))
542
         (s8 (aref state 8))
543
         (s9 (aref state 9))
544
         (r1 (aref state-r 0))
545
         (r2 (aref state-r 1))
546
         (u0 0)
547
         (u1 0)
548
         (u2 0)
549
         (u3 0)
550
         (u4 0)
551
         (v0 0)
552
         (v1 0)
553
         (v2 0)
554
         (v3 0))
555
     (declare (type (unsigned-byte 32) s0 s1 s2 s3 s4 s5 s6 s7 s8 s9 r1 r2)
556
              (type (unsigned-byte 32) u0 u1 u2 u3 u4 v0 v1 v2 v3))
557
     (macrolet ((mul-a (x)
558
                  `(logxor (mod32ash ,x 8) (aref +sosemanuk-mul-a+ (mod32ash ,x -24))))
559
                (mul-g (x)
560
                  `(logxor (mod32ash ,x -8) (aref +sosemanuk-mul-ia+ (logand ,x 255))))
561
                (xmux (c x y)
562
                  `(if (zerop (logand ,c 1)) ,x (logxor ,x ,y)))
563
                (fsm (x1 x8)
564
                  `(let ((tt 0)
565
                         (or1 0))
566
                     (declare (type (unsigned-byte 32) tt or1))
567
                     (setf tt (xmux r1 ,(symbolicate '#:s x1) ,(symbolicate '#:s x8))
568
                           or1 r1
569
                           r1 (mod32+ r2 tt)
570
                           tt (mod32* or1 #x54655307)
571
                           r2 (rol32 tt 7))))
572
                (lru (x0 x3 x9 dd)
573
                  `(setf ,dd ,(symbolicate '#:s x0)
574
                         ,(symbolicate '#:s x0) (logxor (mul-a ,(symbolicate '#:s x0))
575
                                                        (mul-g ,(symbolicate '#:s x3))
576
                                                        ,(symbolicate '#:s x9))))
577
                (cc1 (x9 ee)
578
                  `(setf ,ee (logxor (mod32+ ,(symbolicate '#:s x9) r1) r2)))
579
                (stp (x0 x1 x3 x8 x9 dd ee)
580
                  `(progn
581
                     (fsm ,x1 ,x8)
582
                     (lru ,x0 ,x3 ,x9 ,dd)
583
                     (cc1 ,x9 ,ee)))
584
                (srd (s x0 x1 x2 x3 ooff)
585
                  `(progn
586
                     (,s u0 u1 u2 u3 u4)
587
                     (setf (ub32ref/le buffer ,ooff) (logxor ,(symbolicate '#:u x0) v0)
588
                           (ub32ref/le buffer ,(+ ooff 4)) (logxor ,(symbolicate '#:u x1) v1)
589
                           (ub32ref/le buffer ,(+ ooff 8)) (logxor ,(symbolicate '#:u x2) v2)
590
                           (ub32ref/le buffer ,(+ ooff 12)) (logxor ,(symbolicate '#:u x3) v3)))))
591
       (stp 0 1 3 8 9 v0 u0)
592
       (stp 1 2 4 9 0 v1 u1)
593
       (stp 2 3 5 0 1 v2 u2)
594
       (stp 3 4 6 1 2 v3 u3)
595
       (srd sosemanuk-s2 2 3 1 4 0)
596
       (stp 4 5 7 2 3 v0 u0)
597
       (stp 5 6 8 3 4 v1 u1)
598
       (stp 6 7 9 4 5 v2 u2)
599
       (stp 7 8 0 5 6 v3 u3)
600
       (srd sosemanuk-s2 2 3 1 4 16)
601
       (stp 8 9 1 6 7 v0 u0)
602
       (stp 9 0 2 7 8 v1 u1)
603
       (stp 0 1 3 8 9 v2 u2)
604
       (stp 1 2 4 9 0 v3 u3)
605
       (srd sosemanuk-s2 2 3 1 4 32)
606
       (stp 2 3 5 0 1 v0 u0)
607
       (stp 3 4 6 1 2 v1 u1)
608
       (stp 4 5 7 2 3 v2 u2)
609
       (stp 5 6 8 3 4 v3 u3)
610
       (srd sosemanuk-s2 2 3 1 4 48)
611
       (stp 6 7 9 4 5 v0 u0)
612
       (stp 7 8 0 5 6 v1 u1)
613
       (stp 8 9 1 6 7 v2 u2)
614
       (stp 9 0 2 7 8 v3 u3)
615
       (srd sosemanuk-s2 2 3 1 4 64)
616
 
617
       (setf (aref state 0) s0
618
             (aref state 1) s1
619
             (aref state 2) s2
620
             (aref state 3) s3
621
             (aref state 4) s4
622
             (aref state 5) s5
623
             (aref state 6) s6
624
             (aref state 7) s7
625
             (aref state 8) s8
626
             (aref state 9) s9
627
             (aref state-r 0) r1
628
             (aref state-r 1) r2)))
629
   (values))
630
 
631
 (define-stream-cryptor sosemanuk
632
   (let ((state (sosemanuk-state context))
633
         (state-r (sosemanuk-state-r context))
634
         (keystream-buffer (sosemanuk-keystream-buffer context))
635
         (keystream-buffer-remaining (sosemanuk-keystream-buffer-remaining context)))
636
     (declare (type (simple-array (unsigned-byte 32) (*)) state state-r)
637
              (type (simple-array (unsigned-byte 8) (80)) keystream-buffer)
638
              (type (integer 0 80) keystream-buffer-remaining))
639
     (unless (zerop length)
640
       (unless (zerop keystream-buffer-remaining)
641
         (let ((size (min length keystream-buffer-remaining)))
642
           (declare (type (integer 0 80) size))
643
           (xor-block size keystream-buffer (- 80 keystream-buffer-remaining)
644
                      plaintext plaintext-start
645
                      ciphertext ciphertext-start)
646
           (decf keystream-buffer-remaining size)
647
           (decf length size)
648
           (incf ciphertext-start size)
649
           (incf plaintext-start size)))
650
       (unless (zerop length)
651
         (loop
652
           (sosemanuk-compute-block state state-r keystream-buffer)
653
           (when (<= length 80)
654
             (xor-block length keystream-buffer 0 plaintext plaintext-start ciphertext ciphertext-start)
655
             (setf (sosemanuk-keystream-buffer-remaining context) (- 80 length))
656
             (return-from sosemanuk-crypt (values)))
657
           (xor-block 80 keystream-buffer 0 plaintext plaintext-start ciphertext ciphertext-start)
658
           (decf length 80)
659
           (incf ciphertext-start 80)
660
           (incf plaintext-start 80)))
661
       (setf (sosemanuk-keystream-buffer-remaining context) keystream-buffer-remaining))
662
     (values)))
663
 
664
 (defcipher sosemanuk
665
   (:mode :stream)
666
   (:crypt-function sosemanuk-crypt)
667
   (:key-length (:variable 16 32 1)))