1 unit TF_Base;
2
3 (*************************************************************************
4
5 DESCRIPTION : Twofish basic routines
6
7 REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17, FPC, VP
8
9 EXTERNAL DATA : ---
10
11 MEMORY USAGE : 4.5 KB static data
12
13 DISPLAY MODE : ---
14
15 REFERENCES : [1] Schneier et al, Twofish: A 128-Bit Block Cipher
16 http://www.schneier.com/paper-twofish-paper.pdf
17 [2] Source code and test vectors available from the Twofish
18 page http://www.schneier.com/twofish.html
19 [3] Wei Dai's public domain twofish.cpp in
20 Crypto++ Library 5.2.1 from http://www.cryptopp.com
21
22 Version Date Author Modification
23 ------- -------- ------- ------------------------------------------
24 0.01 27.05.06 W.Ehrhardt Initial BP7 key init
25 0.02 27.05.06 we Bug fix 192 bit key
26 0.03 27.05.06 we Encrypt, bug fix rs_mul, other compilers
27 0.04 28.05.06 we Decrypt
28 0.05 28.05.06 we Removed r in rs_mul
29 0.06 28.05.06 we Encr: Rearranged PHT/Rotate, strict ascending RK access
30 0.07 28.05.06 we Encr: BIT32 with shr and mask
31 0.08 28.05.06 we Decrypt routines
32 0.09 28.05.06 we BASM16: RotL1, RotR1
33 0.10 28.05.06 we Inline: RotL1, RotR1 for 16 bit
34 0.11 28.05.06 we Space reduction for round key calculation
35 0.12 28.05.06 we Add some comments
36 0.13 28.05.06 we Tableless Reed-Solomon
37 0.14 28.05.06 we Removed r from rs_mul
38 0.15 28.05.06 we BIT32 rs_mul like Crypto++
39 0.16 28.05.06 we Code cleaning, comments, tables in .pas
40 0.17 04.06.06 we Removed unused types, some more comments
41 0.18 05.06.06 we BASM16: encrypt with asm
42 0.19 05.06.06 we BASM16: decrypt with asm
43 0.20 10.06.06 we BASM16 encrypt: some improvements
44 0.21 10.06.06 we BIT16: improved Pseudo Hadamard and rotation
45 0.22 16.06.07 we TF_Reset stdcall
46 0.23 06.08.09 we Locally trurn off range checks for byte shifts (for debug)
47 0.24 31.07.10 we TF_Err_CTR_SeekOffset, TF_Err_Invalid_16Bit_Length
48 0.25 02.07.12 we 64-bit adjustments
49 0.26 25.12.12 we {$J+} if needed
50
51 **************************************************************************)
52
53
54
55 (*-------------------------------------------------------------------------
56 (C) Copyright 2006-2012 Wolfgang Ehrhardt
57
58 This software is provided 'as-is', without any express or implied warranty.
59 In no event will the authors be held liable for any damages arising from
60 the use of this software.
61
62 Permission is granted to anyone to use this software for any purpose,
63 including commercial applications, and to alter it and redistribute it
64 freely, subject to the following restrictions:
65
66 1. The origin of this software must not be misrepresented; you must not
67 claim that you wrote the original software. If you use this software in
68 a product, an acknowledgment in the product documentation would be
69 appreciated but is not required.
70
71 2. Altered source versions must be plainly marked as such, and must not be
72 misrepresented as being the original software.
73
74 3. This notice may not be removed or altered from any source distribution.
75 ----------------------------------------------------------------------------*)
76
77 {$i std.inc}
78
79
80 interface
81
82 const
83 TF_Err_Invalid_Key_Size = -1; {Key size in bits not 128, 192, or 256}
84 TF_Err_Invalid_Length = -3; {No full block for cipher stealing}
85 TF_Err_Data_After_Short_Block = -4; {Short block must be last}
86 TF_Err_MultipleIncProcs = -5; {More than one IncProc Setting}
87 TF_Err_NIL_Pointer = -6; {nil pointer to block with nonzero length}
88
89 TF_Err_CTR_SeekOffset = -15; {Negative offset in TF_CTR_Seek}
90 TF_Err_Invalid_16Bit_Length = -20; {Pointer + Offset > $FFFF for 16 bit code}
91
92 type
93 TTFRndKey = packed array[0..39] of longint;
94 TTFSBox = packed array[0..255] of longint;
95 TTFBlock = packed array[0..15] of byte;
96 PTFBlock = ^TTFBlock;
97
98 type
99 TTFIncProc = procedure(var CTR: TTFBlock); {user supplied IncCTR proc}
100 {$ifdef DLL} stdcall; {$endif}
101 type
102 TTFContext = packed record
103 IV : TTFBlock; {IV or CTR }
104 buf : TTFBlock; {Work buffer }
105 bLen : word; {Bytes used in buf }
106 Flag : word; {Bit 1: Short block }
107 IncProc : TTFIncProc; {Increment proc CTR-Mode}
108 RK : TTFRndKey; {Round keys }
109 S0,S1, {Key dependent SBoxes }
110 S2,S3 : TTFSBox; {DO NOT CHANGE SEQUENCE!}
111 end;
112
113 const
114 TFBLKSIZE = sizeof(TTFBlock); {Twofish block size}
115
116
117 {$ifdef CONST}
118
TF_Initnull119 function TF_Init(const Key; KeyBits: word; var ctx: TTFContext): integer;
120 {-Twofish round key and key-dependent sbox initialisation}
121 {$ifdef DLL} stdcall; {$endif}
122
123 procedure TF_Encrypt(var ctx: TTFContext; const BI: TTFBlock; var BO: TTFBlock);
124 {-encrypt one block (in ECB mode)}
125 {$ifdef DLL} stdcall; {$endif}
126
127 procedure TF_Decrypt(var ctx: TTFContext; const BI: TTFBlock; var BO: TTFBlock);
128 {-decrypt one block (in ECB mode)}
129 {$ifdef DLL} stdcall; {$endif}
130
131 procedure TF_XorBlock(const B1, B2: TTFBlock; var B3: TTFBlock);
132 {-xor two blocks, result in third}
133 {$ifdef DLL} stdcall; {$endif}
134
135 {$else}
136
TF_Initnull137 function TF_Init(var Key; KeyBits: word; var ctx: TTFContext): integer;
138 {-Twofish round key and key-dependent sbox initialisation}
139 {$ifdef DLL} stdcall; {$endif}
140
141 procedure TF_Encrypt(var ctx: TTFContext; var BI: TTFBlock; var BO: TTFBlock);
142 {-encrypt one block (in ECB mode)}
143 {$ifdef DLL} stdcall; {$endif}
144
145 procedure TF_Decrypt(var ctx: TTFContext; var BI: TTFBlock; var BO: TTFBlock);
146 {-decrypt one block (in ECB mode)}
147 {$ifdef DLL} stdcall; {$endif}
148
149 procedure TF_XorBlock(var B1, B2: TTFBlock; var B3: TTFBlock);
150 {-xor two blocks, result in third}
151
152 {$endif}
153
154 procedure TF_Reset(var ctx: TTFContext);
155 {-Clears ctx fields bLen and Flag}
156 {$ifdef DLL} stdcall; {$endif}
157
158 procedure TF_SetFastInit(value: boolean);
159 {-set FastInit variable}
160 {$ifdef DLL} stdcall; {$endif}
161
TF_GetFastInitnull162 function TF_GetFastInit: boolean;
163 {-Returns FastInit variable}
164 {$ifdef DLL} stdcall; {$endif}
165
166
167 implementation
168
169 {$ifdef D4Plus}
170 var
171 {$else}
172 {$ifdef J_OPT} {$J+} {$endif}
173 const
174 {$endif}
175 FastInit : boolean = true; {Clear only necessary context data at init}
176 {IV and buf remain uninitialized}
177
178 type
179 TWA4 = packed array[0..3] of longint; {TF block as array of longint}
180 TWA8 = packed array[0..7] of longint; {longint type cast for key}
181
182
183 {Static tables}
184
185 const
186 q0: array[0..255] of byte = (
187 $A9,$67,$B3,$E8,$04,$FD,$A3,$76,$9A,$92,$80,$78,$E4,$DD,$D1,$38,
188 $0D,$C6,$35,$98,$18,$F7,$EC,$6C,$43,$75,$37,$26,$FA,$13,$94,$48,
189 $F2,$D0,$8B,$30,$84,$54,$DF,$23,$19,$5B,$3D,$59,$F3,$AE,$A2,$82,
190 $63,$01,$83,$2E,$D9,$51,$9B,$7C,$A6,$EB,$A5,$BE,$16,$0C,$E3,$61,
191 $C0,$8C,$3A,$F5,$73,$2C,$25,$0B,$BB,$4E,$89,$6B,$53,$6A,$B4,$F1,
192 $E1,$E6,$BD,$45,$E2,$F4,$B6,$66,$CC,$95,$03,$56,$D4,$1C,$1E,$D7,
193 $FB,$C3,$8E,$B5,$E9,$CF,$BF,$BA,$EA,$77,$39,$AF,$33,$C9,$62,$71,
194 $81,$79,$09,$AD,$24,$CD,$F9,$D8,$E5,$C5,$B9,$4D,$44,$08,$86,$E7,
195 $A1,$1D,$AA,$ED,$06,$70,$B2,$D2,$41,$7B,$A0,$11,$31,$C2,$27,$90,
196 $20,$F6,$60,$FF,$96,$5C,$B1,$AB,$9E,$9C,$52,$1B,$5F,$93,$0A,$EF,
197 $91,$85,$49,$EE,$2D,$4F,$8F,$3B,$47,$87,$6D,$46,$D6,$3E,$69,$64,
198 $2A,$CE,$CB,$2F,$FC,$97,$05,$7A,$AC,$7F,$D5,$1A,$4B,$0E,$A7,$5A,
199 $28,$14,$3F,$29,$88,$3C,$4C,$02,$B8,$DA,$B0,$17,$55,$1F,$8A,$7D,
200 $57,$C7,$8D,$74,$B7,$C4,$9F,$72,$7E,$15,$22,$12,$58,$07,$99,$34,
201 $6E,$50,$DE,$68,$65,$BC,$DB,$F8,$C8,$A8,$2B,$40,$DC,$FE,$32,$A4,
202 $CA,$10,$21,$F0,$D3,$5D,$0F,$00,$6F,$9D,$36,$42,$4A,$5E,$C1,$E0);
203
204 const
205 q1: array[0..255] of byte = (
206 $75,$F3,$C6,$F4,$DB,$7B,$FB,$C8,$4A,$D3,$E6,$6B,$45,$7D,$E8,$4B,
207 $D6,$32,$D8,$FD,$37,$71,$F1,$E1,$30,$0F,$F8,$1B,$87,$FA,$06,$3F,
208 $5E,$BA,$AE,$5B,$8A,$00,$BC,$9D,$6D,$C1,$B1,$0E,$80,$5D,$D2,$D5,
209 $A0,$84,$07,$14,$B5,$90,$2C,$A3,$B2,$73,$4C,$54,$92,$74,$36,$51,
210 $38,$B0,$BD,$5A,$FC,$60,$62,$96,$6C,$42,$F7,$10,$7C,$28,$27,$8C,
211 $13,$95,$9C,$C7,$24,$46,$3B,$70,$CA,$E3,$85,$CB,$11,$D0,$93,$B8,
212 $A6,$83,$20,$FF,$9F,$77,$C3,$CC,$03,$6F,$08,$BF,$40,$E7,$2B,$E2,
213 $79,$0C,$AA,$82,$41,$3A,$EA,$B9,$E4,$9A,$A4,$97,$7E,$DA,$7A,$17,
214 $66,$94,$A1,$1D,$3D,$F0,$DE,$B3,$0B,$72,$A7,$1C,$EF,$D1,$53,$3E,
215 $8F,$33,$26,$5F,$EC,$76,$2A,$49,$81,$88,$EE,$21,$C4,$1A,$EB,$D9,
216 $C5,$39,$99,$CD,$AD,$31,$8B,$01,$18,$23,$DD,$1F,$4E,$2D,$F9,$48,
217 $4F,$F2,$65,$8E,$78,$5C,$58,$19,$8D,$E5,$98,$57,$67,$7F,$05,$64,
218 $AF,$63,$B6,$FE,$F5,$B7,$3C,$A5,$CE,$E9,$68,$44,$E0,$4D,$43,$69,
219 $29,$2E,$AC,$15,$59,$A8,$0A,$9E,$6E,$47,$DF,$34,$35,$6A,$CF,$DC,
220 $22,$C9,$C0,$9B,$89,$D4,$ED,$AB,$12,$A2,$0D,$52,$BB,$02,$2F,$A9,
221 $D7,$61,$1E,$B4,$50,$04,$F6,$C2,$16,$25,$86,$56,$55,$09,$BE,$91);
222
223 {$ifdef StrictLong}
224 {$warnings off}
225 {$R-} {avoid D9+ errors!}
226 {$endif}
227
228 const
229 mds0: array[0..255] of longint = (
230 $BCBC3275,$ECEC21F3,$202043C6,$B3B3C9F4,$DADA03DB,$02028B7B,$E2E22BFB,$9E9EFAC8,
231 $C9C9EC4A,$D4D409D3,$18186BE6,$1E1E9F6B,$98980E45,$B2B2387D,$A6A6D2E8,$2626B74B,
232 $3C3C57D6,$93938A32,$8282EED8,$525298FD,$7B7BD437,$BBBB3771,$5B5B97F1,$474783E1,
233 $24243C30,$5151E20F,$BABAC6F8,$4A4AF31B,$BFBF4887,$0D0D70FA,$B0B0B306,$7575DE3F,
234 $D2D2FD5E,$7D7D20BA,$666631AE,$3A3AA35B,$59591C8A,$00000000,$CDCD93BC,$1A1AE09D,
235 $AEAE2C6D,$7F7FABC1,$2B2BC7B1,$BEBEB90E,$E0E0A080,$8A8A105D,$3B3B52D2,$6464BAD5,
236 $D8D888A0,$E7E7A584,$5F5FE807,$1B1B1114,$2C2CC2B5,$FCFCB490,$3131272C,$808065A3,
237 $73732AB2,$0C0C8173,$79795F4C,$6B6B4154,$4B4B0292,$53536974,$94948F36,$83831F51,
238 $2A2A3638,$C4C49CB0,$2222C8BD,$D5D5F85A,$BDBDC3FC,$48487860,$FFFFCE62,$4C4C0796,
239 $4141776C,$C7C7E642,$EBEB24F7,$1C1C1410,$5D5D637C,$36362228,$6767C027,$E9E9AF8C,
240 $4444F913,$1414EA95,$F5F5BB9C,$CFCF18C7,$3F3F2D24,$C0C0E346,$7272DB3B,$54546C70,
241 $29294CCA,$F0F035E3,$0808FE85,$C6C617CB,$F3F34F11,$8C8CE4D0,$A4A45993,$CACA96B8,
242 $68683BA6,$B8B84D83,$38382820,$E5E52EFF,$ADAD569F,$0B0B8477,$C8C81DC3,$9999FFCC,
243 $5858ED03,$19199A6F,$0E0E0A08,$95957EBF,$70705040,$F7F730E7,$6E6ECF2B,$1F1F6EE2,
244 $B5B53D79,$09090F0C,$616134AA,$57571682,$9F9F0B41,$9D9D803A,$111164EA,$2525CDB9,
245 $AFAFDDE4,$4545089A,$DFDF8DA4,$A3A35C97,$EAEAD57E,$353558DA,$EDEDD07A,$4343FC17,
246 $F8F8CB66,$FBFBB194,$3737D3A1,$FAFA401D,$C2C2683D,$B4B4CCF0,$32325DDE,$9C9C71B3,
247 $5656E70B,$E3E3DA72,$878760A7,$15151B1C,$F9F93AEF,$6363BFD1,$3434A953,$9A9A853E,
248 $B1B1428F,$7C7CD133,$88889B26,$3D3DA65F,$A1A1D7EC,$E4E4DF76,$8181942A,$91910149,
249 $0F0FFB81,$EEEEAA88,$161661EE,$D7D77321,$9797F5C4,$A5A5A81A,$FEFE3FEB,$6D6DB5D9,
250 $7878AEC5,$C5C56D39,$1D1DE599,$7676A4CD,$3E3EDCAD,$CBCB6731,$B6B6478B,$EFEF5B01,
251 $12121E18,$6060C523,$6A6AB0DD,$4D4DF61F,$CECEE94E,$DEDE7C2D,$55559DF9,$7E7E5A48,
252 $2121B24F,$03037AF2,$A0A02665,$5E5E198E,$5A5A6678,$65654B5C,$62624E58,$FDFD4519,
253 $0606F48D,$404086E5,$F2F2BE98,$3333AC57,$17179067,$05058E7F,$E8E85E05,$4F4F7D64,
254 $89896AAF,$10109563,$74742FB6,$0A0A75FE,$5C5C92F5,$9B9B74B7,$2D2D333C,$3030D6A5,
255 $2E2E49CE,$494989E9,$46467268,$77775544,$A8A8D8E0,$9696044D,$2828BD43,$A9A92969,
256 $D9D97929,$8686912E,$D1D187AC,$F4F44A15,$8D8D1559,$D6D682A8,$B9B9BC0A,$42420D9E,
257 $F6F6C16E,$2F2FB847,$DDDD06DF,$23233934,$CCCC6235,$F1F1C46A,$C1C112CF,$8585EBDC,
258 $8F8F9E22,$7171A1C9,$9090F0C0,$AAAA539B,$0101F189,$8B8BE1D4,$4E4E8CED,$8E8E6FAB,
259 $ABABA212,$6F6F3EA2,$E6E6540D,$DBDBF252,$92927BBB,$B7B7B602,$6969CA2F,$3939D9A9,
260 $D3D30CD7,$A7A72361,$A2A2AD1E,$C3C399B4,$6C6C4450,$07070504,$04047FF6,$272746C2,
261 $ACACA716,$D0D07625,$50501386,$DCDCF756,$84841A55,$E1E15109,$7A7A25BE,$1313EF91);
262
263 const
264 mds1: array[0..255] of longint = (
265 $A9D93939,$67901717,$B3719C9C,$E8D2A6A6,$04050707,$FD985252,$A3658080,$76DFE4E4,
266 $9A084545,$92024B4B,$80A0E0E0,$78665A5A,$E4DDAFAF,$DDB06A6A,$D1BF6363,$38362A2A,
267 $0D54E6E6,$C6432020,$3562CCCC,$98BEF2F2,$181E1212,$F724EBEB,$ECD7A1A1,$6C774141,
268 $43BD2828,$7532BCBC,$37D47B7B,$269B8888,$FA700D0D,$13F94444,$94B1FBFB,$485A7E7E,
269 $F27A0303,$D0E48C8C,$8B47B6B6,$303C2424,$84A5E7E7,$54416B6B,$DF06DDDD,$23C56060,
270 $1945FDFD,$5BA33A3A,$3D68C2C2,$59158D8D,$F321ECEC,$AE316666,$A23E6F6F,$82165757,
271 $63951010,$015BEFEF,$834DB8B8,$2E918686,$D9B56D6D,$511F8383,$9B53AAAA,$7C635D5D,
272 $A63B6868,$EB3FFEFE,$A5D63030,$BE257A7A,$16A7ACAC,$0C0F0909,$E335F0F0,$6123A7A7,
273 $C0F09090,$8CAFE9E9,$3A809D9D,$F5925C5C,$73810C0C,$2C273131,$2576D0D0,$0BE75656,
274 $BB7B9292,$4EE9CECE,$89F10101,$6B9F1E1E,$53A93434,$6AC4F1F1,$B499C3C3,$F1975B5B,
275 $E1834747,$E66B1818,$BDC82222,$450E9898,$E26E1F1F,$F4C9B3B3,$B62F7474,$66CBF8F8,
276 $CCFF9999,$95EA1414,$03ED5858,$56F7DCDC,$D4E18B8B,$1C1B1515,$1EADA2A2,$D70CD3D3,
277 $FB2BE2E2,$C31DC8C8,$8E195E5E,$B5C22C2C,$E9894949,$CF12C1C1,$BF7E9595,$BA207D7D,
278 $EA641111,$77840B0B,$396DC5C5,$AF6A8989,$33D17C7C,$C9A17171,$62CEFFFF,$7137BBBB,
279 $81FB0F0F,$793DB5B5,$0951E1E1,$ADDC3E3E,$242D3F3F,$CDA47676,$F99D5555,$D8EE8282,
280 $E5864040,$C5AE7878,$B9CD2525,$4D049696,$44557777,$080A0E0E,$86135050,$E730F7F7,
281 $A1D33737,$1D40FAFA,$AA346161,$ED8C4E4E,$06B3B0B0,$706C5454,$B22A7373,$D2523B3B,
282 $410B9F9F,$7B8B0202,$A088D8D8,$114FF3F3,$3167CBCB,$C2462727,$27C06767,$90B4FCFC,
283 $20283838,$F67F0404,$60784848,$FF2EE5E5,$96074C4C,$5C4B6565,$B1C72B2B,$AB6F8E8E,
284 $9E0D4242,$9CBBF5F5,$52F2DBDB,$1BF34A4A,$5FA63D3D,$9359A4A4,$0ABCB9B9,$EF3AF9F9,
285 $91EF1313,$85FE0808,$49019191,$EE611616,$2D7CDEDE,$4FB22121,$8F42B1B1,$3BDB7272,
286 $47B82F2F,$8748BFBF,$6D2CAEAE,$46E3C0C0,$D6573C3C,$3E859A9A,$6929A9A9,$647D4F4F,
287 $2A948181,$CE492E2E,$CB17C6C6,$2FCA6969,$FCC3BDBD,$975CA3A3,$055EE8E8,$7AD0EDED,
288 $AC87D1D1,$7F8E0505,$D5BA6464,$1AA8A5A5,$4BB72626,$0EB9BEBE,$A7608787,$5AF8D5D5,
289 $28223636,$14111B1B,$3FDE7575,$2979D9D9,$88AAEEEE,$3C332D2D,$4C5F7979,$02B6B7B7,
290 $B896CACA,$DA583535,$B09CC4C4,$17FC4343,$551A8484,$1FF64D4D,$8A1C5959,$7D38B2B2,
291 $57AC3333,$C718CFCF,$8DF40606,$74695353,$B7749B9B,$C4F59797,$9F56ADAD,$72DAE3E3,
292 $7ED5EAEA,$154AF4F4,$229E8F8F,$12A2ABAB,$584E6262,$07E85F5F,$99E51D1D,$34392323,
293 $6EC1F6F6,$50446C6C,$DE5D3232,$68724646,$6526A0A0,$BC93CDCD,$DB03DADA,$F8C6BABA,
294 $C8FA9E9E,$A882D6D6,$2BCF6E6E,$40507070,$DCEB8585,$FE750A0A,$328A9393,$A48DDFDF,
295 $CA4C2929,$10141C1C,$2173D7D7,$F0CCB4B4,$D309D4D4,$5D108A8A,$0FE25151,$00000000,
296 $6F9A1919,$9DE01A1A,$368F9494,$42E6C7C7,$4AECC9C9,$5EFDD2D2,$C1AB7F7F,$E0D8A8A8);
297
298 const
299 mds2: array[0..255] of longint = (
300 $BC75BC32,$ECF3EC21,$20C62043,$B3F4B3C9,$DADBDA03,$027B028B,$E2FBE22B,$9EC89EFA,
301 $C94AC9EC,$D4D3D409,$18E6186B,$1E6B1E9F,$9845980E,$B27DB238,$A6E8A6D2,$264B26B7,
302 $3CD63C57,$9332938A,$82D882EE,$52FD5298,$7B377BD4,$BB71BB37,$5BF15B97,$47E14783,
303 $2430243C,$510F51E2,$BAF8BAC6,$4A1B4AF3,$BF87BF48,$0DFA0D70,$B006B0B3,$753F75DE,
304 $D25ED2FD,$7DBA7D20,$66AE6631,$3A5B3AA3,$598A591C,$00000000,$CDBCCD93,$1A9D1AE0,
305 $AE6DAE2C,$7FC17FAB,$2BB12BC7,$BE0EBEB9,$E080E0A0,$8A5D8A10,$3BD23B52,$64D564BA,
306 $D8A0D888,$E784E7A5,$5F075FE8,$1B141B11,$2CB52CC2,$FC90FCB4,$312C3127,$80A38065,
307 $73B2732A,$0C730C81,$794C795F,$6B546B41,$4B924B02,$53745369,$9436948F,$8351831F,
308 $2A382A36,$C4B0C49C,$22BD22C8,$D55AD5F8,$BDFCBDC3,$48604878,$FF62FFCE,$4C964C07,
309 $416C4177,$C742C7E6,$EBF7EB24,$1C101C14,$5D7C5D63,$36283622,$672767C0,$E98CE9AF,
310 $441344F9,$149514EA,$F59CF5BB,$CFC7CF18,$3F243F2D,$C046C0E3,$723B72DB,$5470546C,
311 $29CA294C,$F0E3F035,$088508FE,$C6CBC617,$F311F34F,$8CD08CE4,$A493A459,$CAB8CA96,
312 $68A6683B,$B883B84D,$38203828,$E5FFE52E,$AD9FAD56,$0B770B84,$C8C3C81D,$99CC99FF,
313 $580358ED,$196F199A,$0E080E0A,$95BF957E,$70407050,$F7E7F730,$6E2B6ECF,$1FE21F6E,
314 $B579B53D,$090C090F,$61AA6134,$57825716,$9F419F0B,$9D3A9D80,$11EA1164,$25B925CD,
315 $AFE4AFDD,$459A4508,$DFA4DF8D,$A397A35C,$EA7EEAD5,$35DA3558,$ED7AEDD0,$431743FC,
316 $F866F8CB,$FB94FBB1,$37A137D3,$FA1DFA40,$C23DC268,$B4F0B4CC,$32DE325D,$9CB39C71,
317 $560B56E7,$E372E3DA,$87A78760,$151C151B,$F9EFF93A,$63D163BF,$345334A9,$9A3E9A85,
318 $B18FB142,$7C337CD1,$8826889B,$3D5F3DA6,$A1ECA1D7,$E476E4DF,$812A8194,$91499101,
319 $0F810FFB,$EE88EEAA,$16EE1661,$D721D773,$97C497F5,$A51AA5A8,$FEEBFE3F,$6DD96DB5,
320 $78C578AE,$C539C56D,$1D991DE5,$76CD76A4,$3EAD3EDC,$CB31CB67,$B68BB647,$EF01EF5B,
321 $1218121E,$602360C5,$6ADD6AB0,$4D1F4DF6,$CE4ECEE9,$DE2DDE7C,$55F9559D,$7E487E5A,
322 $214F21B2,$03F2037A,$A065A026,$5E8E5E19,$5A785A66,$655C654B,$6258624E,$FD19FD45,
323 $068D06F4,$40E54086,$F298F2BE,$335733AC,$17671790,$057F058E,$E805E85E,$4F644F7D,
324 $89AF896A,$10631095,$74B6742F,$0AFE0A75,$5CF55C92,$9BB79B74,$2D3C2D33,$30A530D6,
325 $2ECE2E49,$49E94989,$46684672,$77447755,$A8E0A8D8,$964D9604,$284328BD,$A969A929,
326 $D929D979,$862E8691,$D1ACD187,$F415F44A,$8D598D15,$D6A8D682,$B90AB9BC,$429E420D,
327 $F66EF6C1,$2F472FB8,$DDDFDD06,$23342339,$CC35CC62,$F16AF1C4,$C1CFC112,$85DC85EB,
328 $8F228F9E,$71C971A1,$90C090F0,$AA9BAA53,$018901F1,$8BD48BE1,$4EED4E8C,$8EAB8E6F,
329 $AB12ABA2,$6FA26F3E,$E60DE654,$DB52DBF2,$92BB927B,$B702B7B6,$692F69CA,$39A939D9,
330 $D3D7D30C,$A761A723,$A21EA2AD,$C3B4C399,$6C506C44,$07040705,$04F6047F,$27C22746,
331 $AC16ACA7,$D025D076,$50865013,$DC56DCF7,$8455841A,$E109E151,$7ABE7A25,$139113EF);
332
333 const
334 mds3: array[0..255] of longint = (
335 $D939A9D9,$90176790,$719CB371,$D2A6E8D2,$05070405,$9852FD98,$6580A365,$DFE476DF,
336 $08459A08,$024B9202,$A0E080A0,$665A7866,$DDAFE4DD,$B06ADDB0,$BF63D1BF,$362A3836,
337 $54E60D54,$4320C643,$62CC3562,$BEF298BE,$1E12181E,$24EBF724,$D7A1ECD7,$77416C77,
338 $BD2843BD,$32BC7532,$D47B37D4,$9B88269B,$700DFA70,$F94413F9,$B1FB94B1,$5A7E485A,
339 $7A03F27A,$E48CD0E4,$47B68B47,$3C24303C,$A5E784A5,$416B5441,$06DDDF06,$C56023C5,
340 $45FD1945,$A33A5BA3,$68C23D68,$158D5915,$21ECF321,$3166AE31,$3E6FA23E,$16578216,
341 $95106395,$5BEF015B,$4DB8834D,$91862E91,$B56DD9B5,$1F83511F,$53AA9B53,$635D7C63,
342 $3B68A63B,$3FFEEB3F,$D630A5D6,$257ABE25,$A7AC16A7,$0F090C0F,$35F0E335,$23A76123,
343 $F090C0F0,$AFE98CAF,$809D3A80,$925CF592,$810C7381,$27312C27,$76D02576,$E7560BE7,
344 $7B92BB7B,$E9CE4EE9,$F10189F1,$9F1E6B9F,$A93453A9,$C4F16AC4,$99C3B499,$975BF197,
345 $8347E183,$6B18E66B,$C822BDC8,$0E98450E,$6E1FE26E,$C9B3F4C9,$2F74B62F,$CBF866CB,
346 $FF99CCFF,$EA1495EA,$ED5803ED,$F7DC56F7,$E18BD4E1,$1B151C1B,$ADA21EAD,$0CD3D70C,
347 $2BE2FB2B,$1DC8C31D,$195E8E19,$C22CB5C2,$8949E989,$12C1CF12,$7E95BF7E,$207DBA20,
348 $6411EA64,$840B7784,$6DC5396D,$6A89AF6A,$D17C33D1,$A171C9A1,$CEFF62CE,$37BB7137,
349 $FB0F81FB,$3DB5793D,$51E10951,$DC3EADDC,$2D3F242D,$A476CDA4,$9D55F99D,$EE82D8EE,
350 $8640E586,$AE78C5AE,$CD25B9CD,$04964D04,$55774455,$0A0E080A,$13508613,$30F7E730,
351 $D337A1D3,$40FA1D40,$3461AA34,$8C4EED8C,$B3B006B3,$6C54706C,$2A73B22A,$523BD252,
352 $0B9F410B,$8B027B8B,$88D8A088,$4FF3114F,$67CB3167,$4627C246,$C06727C0,$B4FC90B4,
353 $28382028,$7F04F67F,$78486078,$2EE5FF2E,$074C9607,$4B655C4B,$C72BB1C7,$6F8EAB6F,
354 $0D429E0D,$BBF59CBB,$F2DB52F2,$F34A1BF3,$A63D5FA6,$59A49359,$BCB90ABC,$3AF9EF3A,
355 $EF1391EF,$FE0885FE,$01914901,$6116EE61,$7CDE2D7C,$B2214FB2,$42B18F42,$DB723BDB,
356 $B82F47B8,$48BF8748,$2CAE6D2C,$E3C046E3,$573CD657,$859A3E85,$29A96929,$7D4F647D,
357 $94812A94,$492ECE49,$17C6CB17,$CA692FCA,$C3BDFCC3,$5CA3975C,$5EE8055E,$D0ED7AD0,
358 $87D1AC87,$8E057F8E,$BA64D5BA,$A8A51AA8,$B7264BB7,$B9BE0EB9,$6087A760,$F8D55AF8,
359 $22362822,$111B1411,$DE753FDE,$79D92979,$AAEE88AA,$332D3C33,$5F794C5F,$B6B702B6,
360 $96CAB896,$5835DA58,$9CC4B09C,$FC4317FC,$1A84551A,$F64D1FF6,$1C598A1C,$38B27D38,
361 $AC3357AC,$18CFC718,$F4068DF4,$69537469,$749BB774,$F597C4F5,$56AD9F56,$DAE372DA,
362 $D5EA7ED5,$4AF4154A,$9E8F229E,$A2AB12A2,$4E62584E,$E85F07E8,$E51D99E5,$39233439,
363 $C1F66EC1,$446C5044,$5D32DE5D,$72466872,$26A06526,$93CDBC93,$03DADB03,$C6BAF8C6,
364 $FA9EC8FA,$82D6A882,$CF6E2BCF,$50704050,$EB85DCEB,$750AFE75,$8A93328A,$8DDFA48D,
365 $4C29CA4C,$141C1014,$73D72173,$CCB4F0CC,$09D4D309,$108A5D10,$E2510FE2,$00000000,
366 $9A196F9A,$E01A9DE0,$8F94368F,$E6C742E6,$ECC94AEC,$FDD25EFD,$AB7FC1AB,$D8A8E0D8);
367
368
369 {$ifdef StrictLong}
370 {$warnings on}
371 {$ifdef RangeChecks_on}
372 {$R+}
373 {$endif}
374 {$endif}
375
376
377
378
379 {$ifdef BIT16}
380 {$ifndef BASM16}
381 {---------------------------------------------------------------------------}
RotL1null382 function RotL1(x: longint): longint;
383 {-Rotate left 1}
384 inline(
385 $58/ { pop ax }
386 $5A/ { pop dx }
387 $2B/$C9/ { sub cx,cx}
388 $D1/$D0/ { rcl ax,1 }
389 $D1/$D2/ { rcl dx,1 }
390 $13/$C1); { adc ax,cx}
391
392 {---------------------------------------------------------------------------}
RotR1null393 function RotR1(x: longint): longint;
394 {-Rotate right 1}
395 inline(
396 $58/ { pop ax }
397 $5A/ { pop dx }
398 $8B/$CA/ { mov cx,dx}
399 $D1/$E9/ { shr cx,1 }
400 $D1/$D8/ { rcr ax,1 }
401 $D1/$DA); { rcr dx,1 }
402
403 {---------------------------------------------------------------------------}
RotLnull404 function RotL(x: longint; c: byte): longint;
405 {-Rotate left c bits, room for optimization}
406 { Currently not used, needed with c=8,9 in round key calculation}
407 begin
408 RotL := (x shl c) or (x shr (32-c));
409 end;
410
411 {$endif}
412 {$endif}
413
414
415 {---------------------------------------------------------------------------}
416 procedure TF_Reset(var ctx: TTFContext);
417 {-Clears ctx fields bLen and Flag}
418 begin
419 with ctx do begin
420 bLen :=0;
421 Flag :=0;
422 end;
423 end;
424
425
426 {$ifdef BASM16}
427 {---------------------------------------------------------------------------}
428 procedure TF_XorBlock({$ifdef CONST} const {$else} var {$endif} B1, B2: TTFBlock; var B3: TTFBlock);
429 {-xor two blocks, result in third}
430 begin
431 asm
432 mov di,ds
433 lds si,[B1]
434 db $66; mov ax,[si]
435 db $66; mov bx,[si+4]
436 db $66; mov cx,[si+8]
437 db $66; mov dx,[si+12]
438 lds si,[B2]
439 db $66; xor ax,[si]
440 db $66; xor bx,[si+4]
441 db $66; xor cx,[si+8]
442 db $66; xor dx,[si+12]
443 lds si,[B3]
444 db $66; mov [si],ax
445 db $66; mov [si+4],bx
446 db $66; mov [si+8],cx
447 db $66; mov [si+12],dx
448 mov ds,di
449 end;
450 end;
451
452 {$else}
453
454 {---------------------------------------------------------------------------}
455 procedure TF_XorBlock({$ifdef CONST} const {$else} var {$endif} B1, B2: TTFBlock; var B3: TTFBlock);
456 {-xor two blocks, result in third}
457 var
458 a1: TWA4 absolute B1;
459 a2: TWA4 absolute B2;
460 a3: TWA4 absolute B3;
461 begin
462 a3[0] := a1[0] xor a2[0];
463 a3[1] := a1[1] xor a2[1];
464 a3[2] := a1[2] xor a2[2];
465 a3[3] := a1[3] xor a2[3];
466 end;
467
468 {$endif BASM16}
469
470
471 {--------------------------------------------------------------------------}
472 procedure TF_SetFastInit(value: boolean);
473 {-set FastInit variable}
474 begin
475 FastInit := value;
476 end;
477
478
479 {---------------------------------------------------------------------------}
TF_GetFastInitnull480 function TF_GetFastInit: boolean;
481 {-Returns FastInit variable}
482 begin
483 TF_GetFastInit := FastInit;
484 end;
485
486
487
488 {---------------------------------------------------------------------------}
489 {--------------- E n c r y p t / d e c r y p t -------------------------}
490 {---------------------------------------------------------------------------}
491
492
493 {$ifndef BIT16}
494
495 {---------------------------------------------------------------------------}
496 procedure TF_Encrypt(var ctx: TTFContext; const BI: TTFBlock; var BO: TTFBlock);
497 {-encrypt one block (in ECB mode)}
498 var
499 X,Y: longint;
500 T: TTFBlock;
501 W: TWA4 absolute T;
502 i,j: integer;
503 begin
504 with ctx do begin
505 {Get local copy with input whitening}
506 TF_XorBlock(BI,PTFBlock(@RK)^,T);
507 {perform eight double rounds, this avoids swapping needed for 16 single rounds}
508 for j:=0 to 7 do begin
509 i := 4*j;
510 {first part of double round}
511 X := S0[W[0] and $FF] xor S1[W[0] shr 8 and $FF] xor S2[W[0] shr 16 and $FF] xor S3[W[0] shr 24 and $FF];
512 Y := S0[W[1] shr 24 and $FF] xor S1[W[1] and $FF] xor S2[W[1] shr 8 and $FF] xor S3[W[1] shr 16 and $FF];
513 {Pseudo Hadamard and rotation}
514 W[3]:= (W[3] shl 1) or (W[3] shr 31);
515 W[2]:= W[2] xor (X + Y + RK[i+8]);
516 W[3]:= W[3] xor (X + 2*Y + RK[i+9]);
517 W[2]:= (W[2] shr 1) or (W[2] shl 31);
518 {second part of double round}
519 X := S0[W[2] and $FF] xor S1[W[2] shr 8 and $FF] xor S2[W[2] shr 16 and $FF] xor S3[W[2] shr 24 and $FF];
520 Y := S0[W[3] shr 24 and $FF] xor S1[W[3] and $FF] xor S2[W[3] shr 8 and $FF] xor S3[W[3] shr 16 and $FF];
521 {Pseudo Hadamard and rotation}
522 W[1]:= (W[1] shl 1) or (W[1] shr 31);
523 W[0]:= W[0] xor (X + Y + RK[i+10]);
524 W[1]:= W[1] xor (X + 2*Y + RK[i+11]);
525 W[0]:= (W[0] shr 1) or (W[0] shl 31);
526 end;
527 {Store with final swap and output whitening}
528 TWA4(BO)[0] := W[2] xor RK[4];
529 TWA4(BO)[1] := W[3] xor RK[5];
530 TWA4(BO)[2] := W[0] xor RK[6];
531 TWA4(BO)[3] := W[1] xor RK[7];
532 end;
533 end;
534
535
536 {---------------------------------------------------------------------------}
537 procedure TF_Decrypt(var ctx: TTFContext; {$ifdef CONST} const {$else} var {$endif} BI: TTFBlock; var BO: TTFBlock);
538 {-decrypt one block (in ECB mode)}
539 var
540 X,Y: longint;
541 T: TTFBlock;
542 W: TWA4 absolute T;
543 i,j: integer;
544 begin
545 with ctx do begin
546 {Get local copy with input whitening}
547 TF_XorBlock(BI,PTFBlock(@RK[4])^,T);
548 {perform eight double rounds, this avoids swapping needed for 16 single rounds}
549 for j:=0 to 7 do begin
550 i := 4*j;
551 {first part of double round}
552 X := S0[W[0] and $FF] xor S1[W[0] shr 8 and $FF] xor S2[W[0] shr 16 and $FF] xor S3[W[0] shr 24 and $FF];
553 Y := S0[W[1] shr 24 and $FF] xor S1[W[1] and $FF] xor S2[W[1] shr 8 and $FF] xor S3[W[1] shr 16 and $FF];
554 {Pseudo Hadamard and rotation}
555 W[2]:= (W[2] shl 1) or (W[2] shr 31);
556 W[3]:= W[3] xor (X + 2*Y + RK[39-i]);
557 W[2]:= W[2] xor (X + Y + RK[38-i]);
558 W[3]:= (W[3] shr 1) or (W[3] shl 31);
559 {second part of double round}
560 X := S0[W[2] and $FF] xor S1[W[2] shr 8 and $FF] xor S2[W[2] shr 16 and $FF] xor S3[W[2] shr 24 and $FF];
561 Y := S0[W[3] shr 24 and $FF] xor S1[W[3] and $FF] xor S2[W[3] shr 8 and $FF] xor S3[W[3] shr 16 and $FF];
562 {Pseudo Hadamard and rotation}
563 W[0]:= (W[0] shl 1) or (W[0] shr 31);
564 W[1]:= W[1] xor (X + 2*Y + RK[37-i]);
565 W[0]:= W[0] xor (X + Y + RK[36-i]);
566 W[1]:= (W[1] shr 1) or (W[1] shl 31);
567 end;
568 {Store with final swap and output whitening}
569 TWA4(BO)[0] := TWA4(T)[2] xor RK[0];
570 TWA4(BO)[1] := TWA4(T)[3] xor RK[1];
571 TWA4(BO)[2] := TWA4(T)[0] xor RK[2];
572 TWA4(BO)[3] := TWA4(T)[1] xor RK[3];
573 end;
574 end;
575
576
577 {$else}
578
579 {$ifdef BASM16}
580 {---------------------------------------------------------------------------}
581 procedure TF_Encrypt(var ctx: TTFContext; {$ifdef CONST} const {$else} var {$endif} BI: TTFBlock; var BO: TTFBlock);
582 {-encrypt one block (in ECB mode)}
583 var
584 T: TTFBlock;
585 W: TWA4 absolute T;
586 j: integer;
587 begin
588 with ctx do begin
589 {Get local copy with input whitening}
590 TF_XorBlock(BI,PTFBlock(@RK)^,T);
591 {perform eight double rounds, this avoids swapping needed for 16 single rounds}
592 asm
593 mov [j],8
594 push ds {save ds}
595 lds si,[ctx]
596 lea si,TTFContext[si].S0 {ds:si -> ctx.S0}
597 les di,[ctx]
598 lea di,TTFContext[di].RK+8*4 {es:di -> ctx.RK[8]}
599
600 @@1: {first part of double round}
601 {X := S0[T[00]] xor S1[T[01]] xor S2[T[02]] xor S3[T[03]];}
602 mov bl,byte ptr T[0]
603 sub bh,bh
604 shl bx,2
605 db $66; mov cx,[si+bx]
606 mov bl,byte ptr T[1]
607 sub bh,bh
608 shl bx,2
609 db $66; xor cx,[si+bx+$400]
610 mov bl,byte ptr T[2]
611 sub bh,bh
612 shl bx,2
613 db $66; xor cx,[si+bx+$800]
614 mov bl,byte ptr T[3]
615 sub bh,bh
616 shl bx,2
617 db $66; xor cx,[si+bx+$C00]
618 {Y := S0[T[07]] xor S1[T[04]] xor S2[T[05]] xor S3[T[06]];}
619 mov bl,byte ptr T[7]
620 sub bh,bh
621 shl bx,2
622 db $66; mov dx,[si+bx]
623 mov bl,byte ptr T[4]
624 sub bh,bh
625 shl bx,2
626 db $66; xor dx,[si+bx+$400]
627 mov bl,byte ptr T[5]
628 sub bh,bh
629 shl bx,2
630 db $66; xor dx,[si+bx+$800]
631 mov bl,byte ptr T[6]
632 sub bh,bh
633 shl bx,2
634 db $66; xor dx,[si+bx+$C00]
635
636 {Pseudo Hadamard and rotation}
637 {W[2]:= W[2] xor (X + Y + RK[i+8]);}
638 db $66; mov ax,es:[di]
639 add di,4
640 db $66; add ax,cx
641 db $66; add ax,dx
642 db $66; xor ax,word ptr T[8]
643 {W[2]:= RotR1(W[2]);}
644 db $66; ror ax,1
645 db $66; mov word ptr T[8],ax
646
647 {W[3]:= RotL1(W[3]);}
648 {W[3]:= W[3] xor (X + 2*Y + RK[i+9]);}
649 db $66; mov ax,es:[di]
650 add di,4
651 db $66; add ax,cx
652 db $66; add ax,dx
653 db $66; add ax,dx
654 db $66; mov bx,word ptr T[12]
655 db $66; rol bx,1
656 db $66; xor ax,bx
657 db $66; mov word ptr T[12],ax
658
659 {second part of double round}
660 {X := S0[T[08]] xor S1[T[09]] xor S2[T[10]] xor S3[T[11]];}
661 mov bl,byte ptr T[8]
662 sub bh,bh
663 shl bx,2
664 db $66; mov cx,[si+bx]
665 mov bl,byte ptr T[9]
666 sub bh,bh
667 shl bx,2
668 db $66; xor cx,[si+bx+$400]
669 mov bl,byte ptr T[10]
670 sub bh,bh
671 shl bx,2
672 db $66; xor cx,[si+bx+$800]
673 mov bl,byte ptr T[11]
674 sub bh,bh
675 shl bx,2
676 db $66; xor cx,[si+bx+$C00]
677 {Y := S0[T[15]] xor S1[T[12]] xor S2[T[13]] xor S3[T[14]];}
678 mov bl,byte ptr T[15]
679 sub bh,bh
680 shl bx,2
681 db $66; mov dx,[si+bx]
682 mov bl,byte ptr T[12]
683 sub bh,bh
684 shl bx,2
685 db $66; xor dx,[si+bx+$400]
686 mov bl,byte ptr T[13]
687 sub bh,bh
688 shl bx,2
689 db $66; xor dx,[si+bx+$800]
690 mov bl,byte ptr T[14]
691 sub bh,bh
692 shl bx,2
693 db $66; xor dx,[si+bx+$C00]
694
695 {Pseudo Hadamard and rotation}
696 {W[0]:= W[0] xor (X + Y + RK[i+10]);}
697 db $66; mov ax,es:[di]
698 add di,4
699 db $66; add ax,cx
700 db $66; add ax,dx
701 db $66; xor ax,word ptr T[0]
702 {W[0]:= RotR1(W[0]);}
703 db $66; ror ax,1
704 db $66; mov word ptr T[0],ax
705
706 {W[1]:= RotL1(W[1]);}
707 {W[1]:= W[1] xor (X + 2*Y + RK[i+11]);}
708 db $66; mov ax,es:[di]
709 add di,4
710 db $66; add ax,cx
711 db $66; add ax,dx
712 db $66; add ax,dx
713 db $66; mov bx,word ptr T[4]
714 db $66; rol bx,1
715 db $66; xor ax,bx
716 db $66; mov word ptr T[4],ax
717
718 dec [j]
719 jnz @@1
720
721 pop ds
722 end;
723 {Store with final swap and output whitening}
724 TWA4(BO)[0] := W[2] xor RK[4];
725 TWA4(BO)[1] := W[3] xor RK[5];
726 TWA4(BO)[2] := W[0] xor RK[6];
727 TWA4(BO)[3] := W[1] xor RK[7];
728 end;
729 end;
730
731
732 {---------------------------------------------------------------------------}
733 procedure TF_Decrypt(var ctx: TTFContext; {$ifdef CONST} const {$else} var {$endif} BI: TTFBlock; var BO: TTFBlock);
734 {-decrypt one block (in ECB mode)}
735 var
736 T: TTFBlock;
737 W: TWA4 absolute T;
738 j: integer;
739 begin
740 with ctx do begin
741 {Get local copy with input whitening}
742 TF_XorBlock(BI,PTFBlock(@RK[4])^,T);
743 {perform eight double rounds, this avoids swapping needed for 16 single rounds}
744 asm
745 mov [j],8
746 push ds {save ds}
747 lds si,[ctx]
748 lea si,TTFContext[si].S0 {ds:si -> ctx.S0}
749 les di,[ctx]
750 lea di,TTFContext[di].RK+39*4 {es:di -> ctx.RK[39]}
751 @@1: {first part of double round}
752 {X := S0[T[00]] xor S1[T[01]] xor S2[T[02]] xor S3[T[03]];}
753 mov bl,byte ptr T[0]
754 sub bh,bh
755 shl bx,2
756 db $66; mov cx,[si+bx]
757 mov bl,byte ptr T[1]
758 sub bh,bh
759 shl bx,2
760 db $66; xor cx,[si+bx+$400]
761 mov bl,byte ptr T[2]
762 sub bh,bh
763 shl bx,2
764 db $66; xor cx,[si+bx+$800]
765 mov bl,byte ptr T[3]
766 sub bh,bh
767 shl bx,2
768 db $66; xor cx,[si+bx+$C00]
769 {Y := S0[T[07]] xor S1[T[04]] xor S2[T[05]] xor S3[T[06]];}
770 mov bl,byte ptr T[7]
771 sub bh,bh
772 shl bx,2
773 db $66; mov dx,[si+bx]
774 mov bl,byte ptr T[4]
775 sub bh,bh
776 shl bx,2
777 db $66; xor dx,[si+bx+$400]
778 mov bl,byte ptr T[5]
779 sub bh,bh
780 shl bx,2
781 db $66; xor dx,[si+bx+$800]
782 mov bl,byte ptr T[6]
783 sub bh,bh
784 shl bx,2
785 db $66; xor dx,[si+bx+$C00]
786 {Pseudo Hadamard and rotation}
787 {W[2]:= RotL1(W[2])}
788 db $66; rol word ptr T[8],1
789 {W[3]:= W[3] xor (X + 2*Y + RK[39-i]);}
790 db $66; mov ax,es:[di]
791 sub di,4
792 db $66; add ax,cx
793 db $66; add ax,dx
794 db $66; add ax,dx
795 db $66; xor word ptr T[12],ax
796 {W[2]:= W[2] xor (X + Y + RK[38-i]);}
797 db $66; mov ax,es:[di]
798 sub di,4
799 db $66; add ax,cx
800 db $66; add ax,dx
801 db $66; xor word ptr T[8],ax
802 {W[3]:= RotR1(W[3]);}
803 db $66; ror word ptr T[12],1
804
805 {second part of double round}
806 {X := S0[T[08]] xor S1[T[09]] xor S2[T[10]] xor S3[T[11]];}
807 mov bl,byte ptr T[8]
808 sub bh,bh
809 shl bx,2
810 db $66; mov cx,[si+bx]
811 mov bl,byte ptr T[9]
812 sub bh,bh
813 shl bx,2
814 db $66; xor cx,[si+bx+$400]
815 mov bl,byte ptr T[10]
816 sub bh,bh
817 shl bx,2
818 db $66; xor cx,[si+bx+$800]
819 mov bl,byte ptr T[11]
820 sub bh,bh
821 shl bx,2
822 db $66; xor cx,[si+bx+$C00]
823 {Y := S0[T[15]] xor S1[T[12]] xor S2[T[13]] xor S3[T[14]];}
824 mov bl,byte ptr T[15]
825 sub bh,bh
826 shl bx,2
827 db $66; mov dx,[si+bx]
828 mov bl,byte ptr T[12]
829 sub bh,bh
830 shl bx,2
831 db $66; xor dx,[si+bx+$400]
832 mov bl,byte ptr T[13]
833 sub bh,bh
834 shl bx,2
835 db $66; xor dx,[si+bx+$800]
836 mov bl,byte ptr T[14]
837 sub bh,bh
838 shl bx,2
839 db $66; xor dx,[si+bx+$C00]
840 {Pseudo Hadamard and rotation}
841 {W[0]:= RotL1(W[0]);}
842 db $66; rol word ptr T[0],1
843 {W[1]:= W[1] xor (X + 2*Y + RK[37-i]);}
844 db $66; mov ax,es:[di]
845 sub di,4
846 db $66; add ax,cx
847 db $66; add ax,dx
848 db $66; add ax,dx
849 db $66; xor word ptr T[4],ax
850 {W[0]:= W[0] xor (X + Y + RK[36-i]);}
851 db $66; mov ax,es:[di]
852 sub di,4
853 db $66; add ax,cx
854 db $66; add ax,dx
855 db $66; xor word ptr T[0],ax
856 {W[1]:= RotR1(W[1]);}
857 db $66; ror word ptr T[4],1
858
859 dec [j]
860 jnz @@1
861
862 pop ds
863 end;
864
865 {Store with final swap and output whitening}
866 TWA4(BO)[0] := W[2] xor RK[0];
867 TWA4(BO)[1] := W[3] xor RK[1];
868 TWA4(BO)[2] := W[0] xor RK[2];
869 TWA4(BO)[3] := W[1] xor RK[3];
870 end;
871 end;
872
873
874 {$else}
875
876 {---------------------------------------------------------------------------}
877 procedure TF_Encrypt(var ctx: TTFContext; {$ifdef CONST} const {$else} var {$endif} BI: TTFBlock; var BO: TTFBlock);
878 {-encrypt one block (in ECB mode)}
879 var
880 X,Y: longint;
881 T: TTFBlock;
882 W: TWA4 absolute T;
883 i,j: integer;
884 begin
885 with ctx do begin
886 {Get local copy with input whitening}
887 TF_XorBlock(BI,PTFBlock(@RK)^,T);
888 {perform eight double rounds, this avoids swapping needed for 16 single rounds}
889 for j:=0 to 7 do begin
890 i := 4*j;
891 {first part of double round}
892 X := S0[T[00]] xor S1[T[01]] xor S2[T[02]] xor S3[T[03]];
893 Y := S0[T[07]] xor S1[T[04]] xor S2[T[05]] xor S3[T[06]];
894 {Pseudo Hadamard and rotation}
895 W[2]:= RotR1(W[2] xor (X + Y + RK[i+8]));
896 W[3]:= RotL1(W[3]) xor (X + 2*Y + RK[i+9]);
897 {second part of double round}
898 X := S0[T[08]] xor S1[T[09]] xor S2[T[10]] xor S3[T[11]];
899 Y := S0[T[15]] xor S1[T[12]] xor S2[T[13]] xor S3[T[14]];
900 {Pseudo Hadamard and rotation}
901 W[0]:= RotR1(W[0] xor (X + Y + RK[i+10]));
902 W[1]:= RotL1(W[1]) xor (X + 2*Y + RK[i+11]);
903 end;
904 {Store with final swap and output whitening}
905 TWA4(BO)[0] := W[2] xor RK[4];
906 TWA4(BO)[1] := W[3] xor RK[5];
907 TWA4(BO)[2] := W[0] xor RK[6];
908 TWA4(BO)[3] := W[1] xor RK[7];
909 end;
910 end;
911
912
913
914 {---------------------------------------------------------------------------}
915 procedure TF_Decrypt(var ctx: TTFContext; {$ifdef CONST} const {$else} var {$endif} BI: TTFBlock; var BO: TTFBlock);
916 {-decrypt one block (in ECB mode)}
917 var
918 X,Y: longint;
919 T: TTFBlock;
920 W: TWA4 absolute T;
921 i,j: integer;
922 begin
923 with ctx do begin
924 {Get local copy with input whitening}
925 TF_XorBlock(BI,PTFBlock(@RK[4])^,T);
926 {perform eight double rounds, this avoids swapping needed for 16 single rounds}
927 for j:=0 to 7 do begin
928 i := 4*j;
929 {first part of double round}
930 X := S0[T[00]] xor S1[T[01]] xor S2[T[02]] xor S3[T[03]];
931 Y := S0[T[07]] xor S1[T[04]] xor S2[T[05]] xor S3[T[06]];
932 {Pseudo Hadamard and rotation}
933 W[3]:= RotR1(W[3] xor (X + 2*Y + RK[39-i]));
934 W[2]:= RotL1(W[2]) xor (X + Y + RK[38-i]);
935 {second part of double round}
936 X := S0[T[08]] xor S1[T[09]] xor S2[T[10]] xor S3[T[11]];
937 Y := S0[T[15]] xor S1[T[12]] xor S2[T[13]] xor S3[T[14]];
938 {Pseudo Hadamard and rotation}
939 W[1]:= RotR1(W[1] xor (X + 2*Y + RK[37-i]));
940 W[0]:= RotL1(W[0]) xor (X + Y + RK[36-i]);
941 end;
942 {Store with final swap and output whitening}
943 TWA4(BO)[0] := W[2] xor RK[0];
944 TWA4(BO)[1] := W[3] xor RK[1];
945 TWA4(BO)[2] := W[0] xor RK[2];
946 TWA4(BO)[3] := W[1] xor RK[3];
947 end;
948 end;
949
950 {$endif}
951
952 {$endif}
953
954
955
956 {---------------------------------------------------------------------------}
957 {------------------- K e y s e t u p ------------------------------------}
958 {---------------------------------------------------------------------------}
959
960
961 {Turn off range checking for byte shifts}
962 {$ifopt R+} {$define SetRPlus} {$else} {$undef SetRPlus} {$endif}
963 {$R-}
964
965 {$ifndef BIT16}
966
967 {Reed-Solomon calculation adapted from Wei Dai's Crypto++}
968
969 {---------------------------------------------------------------------------}
rs_modnull970 function rs_mod(c: longint): longint;
971 {-compute c*x^4 mod (x^4 + (a+1/a)*x^3 + a*x^2 + (a+1/a)*x + 1) over GF(256)}
972 var
973 c1,c2: longint;
974 begin
975 if c and $80 = 0 then c2 := c shl 1 else c2 := (c shl 1) xor $14d;
976 if odd(c) then c1 := c2 xor (c shr 1) xor ($14d shr 1)
977 else c1 := c2 xor (c shr 1);
978 rs_mod := c or (c1 shl 8) or (c2 shl 16) or (c1 shl 24);
979 end;
980
981
982 {---------------------------------------------------------------------------}
rs_mulnull983 function rs_mul(a,b: longint): longint;
984 {-compute RS(12,8) code with the above polynomial as generator}
985 { this is equivalent to multiplying by the RS matrix}
986 var
987 i: integer;
988 begin
989 for i:=0 to 7 do begin
990 b := rs_mod(b shr 24) xor (b shl 8) xor (a shr 24);
991 a := a shl 8;
992 end;
993 rs_mul := b;
994 end;
995
996 {$else}
997
998 {---------------------------------------------------------------------------}
999 procedure rs_mod(var x: longint);
1000 {-Special 16 bit version of the above function}
1001 var
1002 c,c1,c2: byte;
1003 y: array[0..3] of byte absolute x;
1004 begin
1005 c := y[3];
1006 if c and $80 = 0 then c2 := c shl 1
1007 else begin
1008 {c2 IS a byte because then $100 bit would be xored to zero with $14D}
1009 c2 := (c shl 1) xor $4d;
1010 end;
1011 if odd(c) then c1 := (c shr 1) xor $A6 xor c2 {Note: $A6 = $14D shr 1}
1012 else c1 := (c shr 1) xor c2;
1013 y[3] := y[2] xor c1;
1014 y[2] := y[1] xor c2;
1015 y[1] := y[0] xor c1;
1016 y[0] := c;
1017 end;
1018
1019
1020 {---------------------------------------------------------------------------}
rs_mulnull1021 function rs_mul(a, b: longint): longint;
1022 {-compute RS(12,8) code with the above polynomial as generator}
1023 { this is equivalent to multiplying by the RS matrix, 16 bit special}
1024 var
1025 i: integer;
1026 begin
1027 for i:=0 to 3 do rs_mod(b);
1028 b := b xor a;
1029 for i:=0 to 3 do rs_mod(b);
1030 rs_mul := b;
1031 end;
1032
1033 {$endif}
1034
1035 {$ifdef SetRPlus}
1036 {$R+}
1037 {$endif}
1038
1039
1040 {---------------------------------------------------------------------------}
TF_Initnull1041 function TF_Init({$ifdef CONST} const {$else} var {$endif} Key; KeyBits: word; var ctx: TTFContext): integer;
1042 {-Twofish round key and key-dependent sbox initialisation}
1043 var
1044 ka: array[0..31] of byte absolute key;
1045 i,j: integer;
1046 X,Y: longint;
1047 S: array[0..15] of byte;
1048 y0,y1,y2,y3,x0,x1,x2,x3: byte;
1049 begin
1050 TF_Init := 0;
1051
1052 if FastInit then begin
1053 {Clear only the necessary context data at init. IV and buf}
1054 {remain uninitialized, other fields are initialized below.}
1055 TF_Reset(ctx);
1056 {$ifdef CONST}
1057 ctx.IncProc := nil;
1058 {$else}
1059 {TP5-6 do not like IncProc := nil;}
1060 fillchar(ctx.IncProc, sizeof(ctx.IncProc), 0);
1061 {$endif}
1062 end
1063 else fillchar(ctx, sizeof(ctx), 0);
1064
1065 if (KeyBits<>128) and (KeyBits<>192) and (KeyBits<>256) then begin
1066 TF_Init := TF_Err_Invalid_Key_Size;
1067 exit;
1068 end;
1069
1070 {Reed-Solomon multiplication}
1071 for i:=0 to pred(KeyBits div 64) do begin
1072 TWA4(S)[i] := rs_mul(TWA8(key)[2*i], TWA8(key)[2*i+1]);
1073 end;
1074
1075 with ctx do begin
1076 {calculate key-dependent sboxes}
1077 if KeyBits=128 then begin
1078 for j:=0 to 255 do begin
1079 S0[j] := mds0[q0[q0[j] xor S[0]] xor S[4]];
1080 S1[j] := mds1[q0[q1[j] xor S[1]] xor S[5]];
1081 S2[j] := mds2[q1[q0[j] xor S[2]] xor S[6]];
1082 S3[j] := mds3[q1[q1[j] xor S[3]] xor S[7]];
1083 end;
1084 end
1085 else if KeyBits=192 then begin
1086 for j:=0 to 255 do begin
1087 S0[j] := mds0[q0[q0[q1[j] xor S[0]] xor S[4]] xor S[ 8]];
1088 S1[j] := mds1[q0[q1[q1[j] xor S[1]] xor S[5]] xor S[ 9]];
1089 S2[j] := mds2[q1[q0[q0[j] xor S[2]] xor S[6]] xor S[10]];
1090 S3[j] := mds3[q1[q1[q0[j] xor S[3]] xor S[7]] xor S[11]];
1091 end;
1092 end
1093 else begin {KeyBits=256}
1094 for j:=0 to 255 do begin
1095 S0[j] := mds0[q0[q0[q1[q1[j] xor S[0]] xor S[4]] xor S[ 8]] xor S[12]];
1096 S1[j] := mds1[q0[q1[q1[q0[j] xor S[1]] xor S[5]] xor S[ 9]] xor S[13]];
1097 S2[j] := mds2[q1[q0[q0[q0[j] xor S[2]] xor S[6]] xor S[10]] xor S[14]];
1098 S3[j] := mds3[q1[q1[q0[q1[j] xor S[3]] xor S[7]] xor S[11]] xor S[15]];
1099 end;
1100 end;
1101 {calculate round keys, see [1], Section 4.3.2: The Function h}
1102 j := 0;
1103 while j<40 do begin
1104 i := j+1;
1105 if KeyBits=128 then begin
1106 x0 := q0[j] xor ka[ 8];
1107 x1 := q1[j] xor ka[ 9];
1108 x2 := q0[j] xor ka[10];
1109 x3 := q1[j] xor ka[11];
1110 y0 := q0[i] xor ka[12];
1111 y1 := q1[i] xor ka[13];
1112 y2 := q0[i] xor ka[14];
1113 y3 := q1[i] xor ka[15];
1114 end
1115 else if KeyBits=192 then begin
1116 x0 := q0[q1[j] xor ka[16]] xor ka[ 8];
1117 x1 := q1[q1[j] xor ka[17]] xor ka[ 9];
1118 x2 := q0[q0[j] xor ka[18]] xor ka[10];
1119 x3 := q1[q0[j] xor ka[19]] xor ka[11];
1120 y0 := q0[q1[i] xor ka[20]] xor ka[12];
1121 y1 := q1[q1[i] xor ka[21]] xor ka[13];
1122 y2 := q0[q0[i] xor ka[22]] xor ka[14];
1123 y3 := q1[q0[i] xor ka[23]] xor ka[15];
1124 end
1125 else begin
1126 x0 := q0[q1[q1[j] xor ka[24]] xor ka[16]] xor ka[ 8];
1127 x1 := q1[q1[q0[j] xor ka[25]] xor ka[17]] xor ka[ 9];
1128 x2 := q0[q0[q0[j] xor ka[26]] xor ka[18]] xor ka[10];
1129 x3 := q1[q0[q1[j] xor ka[27]] xor ka[19]] xor ka[11];
1130 y0 := q0[q1[q1[i] xor ka[28]] xor ka[20]] xor ka[12];
1131 y1 := q1[q1[q0[i] xor ka[29]] xor ka[21]] xor ka[13];
1132 y2 := q0[q0[q0[i] xor ka[30]] xor ka[22]] xor ka[14];
1133 y3 := q1[q0[q1[i] xor ka[31]] xor ka[23]] xor ka[15];
1134 end;
1135 X := mds0[q0[x0] xor ka[0]] xor mds1[q0[x1] xor ka[1]] xor mds2[q1[x2] xor ka[2]] xor mds3[q1[x3] xor ka[3]];
1136 Y := mds0[q0[y0] xor ka[4]] xor mds1[q0[y1] xor ka[5]] xor mds2[q1[y2] xor ka[6]] xor mds3[q1[y3] xor ka[7]];
1137 {$ifdef BASM16}
1138 asm db $66; rol word ptr Y,8 end;
1139 {$else}
1140 Y := (Y shl 8) or (Y shr 24);
1141 {$endif}
1142 inc(X,Y);
1143 inc(Y,X);
1144 RK[j] := X;
1145 {$ifdef BASM16}
1146 asm db $66; rol word ptr Y,9 end;
1147 RK[i] := Y;
1148 {$else}
1149 RK[i] := (Y shl 9) or (Y shr 23);
1150 {$endif}
1151 inc(j,2);
1152 end;
1153 end;
1154 end;
1155
1156
1157
1158 end.
1159