1 {-Test prog for Serpent CTR Seek, (c) we Aug. 2010}
2 
3 program T_SP_CSK;
4 
5 {$i STD.INC}
6 
7 {$ifdef APPCONS}
8   {$apptype console}
9 {$endif}
10 
11 {$ifdef BIT16}
12 {$N+,F+}
13 {$endif}
14 
15 uses
16   {$ifdef WINCRT}
17      wincrt,
18   {$endif}
19   HRTimer,
20   {$ifdef USEDLL}
21     {$ifdef VirtualPascal}
22       SP_Intv;
23     {$else}
24       SP_Intf;
25     {$endif}
26   {$else}
27     sp_base, sp_ctr;
28   {$endif}
29 
30 
31 {USE_INT64: if Int64 and errout available}
32 
33 {$ifdef FPC}
34   {$ifdef VER2}
35     {$define USE_INT64}
36   {$endif}
37 {$endif}
38 {$ifdef CONDITIONALEXPRESSIONS}  {D6+}
39   {$define USE_INT64}
40 {$endif}
41 
42 var
43   ctx1, ctx2: TSPContext;
44   Err: integer;
45   HR: THRTimer;
46 
47 {$ifdef USE_INT64}
48 const
49   BSIZE=$8000;
50 {$else}
51 const
52   BSIZE=8192;
53 {$endif}
54 
55 
56 
57 {---------------------------------------------------------------------------}
58 procedure My_IncMSBFull(var CTR: TSPBlock);
59 {$ifdef USEDLL} stdcall; {$endif}
60   {-Increment CTR[15]..CTR[0]}
61 var
62   j: integer;
63 begin
64   {This is the same as the standard pre-defined function, but it cannot be }
65   {recognized by its @address and therefore the seek loop will be performed}
66   for j:=15 downto 0 do begin
67     if CTR[j]=$FF then CTR[j] := 0
68     else begin
69       inc(CTR[j]);
70       exit;
71     end;
72   end;
73 end;
74 
75 
76 var
77   pbuf, cbuf1, cbuf2: array[0..BSIZE-1] of byte;
78 
79 
80 {---------------------------------------------------------------------------}
81 procedure CheckError;
82 begin
83   if Err<>0 then begin
84     writeln('Error ',Err);
85     halt;
86   end;
87 end;
88 
89 
90 {---------------------------------------------------------------------------}
91 procedure randomtest(userdef: boolean);
92 const
93   key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
94                                    $ab,$f7,$15,$88,$09,$cf,$4f,$3c);
95 
96      CTR : TSPBlock             = ($f0,$f1,$f2,$f3,$f4,$f5,$f6,$f7,
97                                    $f8,$f9,$fa,$fb,$fc,$fd,$fe,$ff);
98 
99   plain  : array[0..63] of byte = ($6b,$c1,$be,$e2,$2e,$40,$9f,$96,
100                                    $e9,$3d,$7e,$11,$73,$93,$17,$2a,
101                                    $ae,$2d,$8a,$57,$1e,$03,$ac,$9c,
102                                    $9e,$b7,$6f,$ac,$45,$af,$8e,$51,
103                                    $30,$c8,$1c,$46,$a3,$5c,$e4,$11,
104                                    $e5,$fb,$c1,$19,$1a,$0a,$52,$ef,
105                                    $f6,$9f,$24,$45,$df,$4f,$9b,$17,
106                                    $ad,$2b,$41,$7b,$e6,$6c,$37,$10);
107 
108   ct_ctr : array[0..63] of byte = ($7c,$2a,$0d,$21,$3f,$77,$84,$c3,
109                                    $b7,$f7,$74,$d0,$dd,$49,$ca,$0b,
110                                    $04,$b5,$17,$cc,$8e,$99,$a1,$7a,
111                                    $95,$8d,$35,$00,$b3,$b2,$5b,$2b,
112                                    $d7,$c7,$58,$e4,$91,$37,$22,$03,
113                                    $83,$d8,$3b,$3e,$85,$31,$31,$73,
114                                    $b5,$e5,$a2,$fa,$70,$66,$aa,$3a,
115                                    $18,$22,$5f,$41,$e9,$be,$12,$7f);
116 var
117   ct: array[0..255] of byte;
118   SO: integer;
119 begin
120 
121   writeln('Known vector test, 128 bit key');
122   Err := SP_CTR_Init(key128, 128, CTR, ctx2);
123   CheckError;
124   if userdef then begin
125     Err := SP_SetIncProc({$ifdef FPC_ProcVar}@{$endif}My_IncMSBFull, ctx2);
126     CheckError;
127   end;
128   for SO:=0 to 63 do begin
129     write('.');
130     Err := SP_CTR_Seek(CTR, SO, 0, ctx2);
131     CheckError;
132     Err := SP_CTR_Encrypt(@plain[SO], @ct[SO], 1, ctx2);
133     if ct[SO]<>ct_ctr[SO] then begin
134       writeln('Diff:  SO=',SO:2,'  ct_ctr[SO]=',ct_ctr[SO]:3,'  ct[SO]=',ct[SO]:3);
135     end;
136   end;
137   writeln(' done');
138 end;
139 
140 
141 {---------------------------------------------------------------------------}
142 procedure bigtest(n: integer);
143 const
144   key128 : array[0..15] of byte = ($2b,$7e,$15,$16,$28,$ae,$d2,$a6,
145                                    $ab,$f7,$15,$88,$09,$cf,$4f,$3c);
146      CTR : TSPBlock =             ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff,
147                                    $ff,$ff,$ff,$ff,$fd,$fc,$fb,$fa);
148 
149 {$ifdef USE_INT64}
150 var
151   ofs: int64;
152 const
153   oma = int64($3FFFFFFF)*$100;  {avoid braindamaged D2 error}
154 {$else}
155 var
156   ofs: longint;
157 const
158   oma = $6FFFFFFF;
159 {$endif}
160 var
161   i: integer;
162 begin
163   for i:=0 to BSIZE-1 do pbuf[i] := random(256);
164   Err := SP_CTR_Init(key128, 128, CTR, ctx1);
165   CheckError;
166   case n of
167     1: begin
168          writeln('IncProc = SP_IncMSBFull,   max. offset = ',oma);
169          {$ifdef USE_INT64}
170            writeln(erroutput, 'IncProc = SP_IncMSBFull,   max. offset = ',oma);
171          {$endif}
172          {$ifdef FPC_ProcVar}
173            err := SP_SetIncProc(@SP_IncMSBFull, ctx1);
174          {$else}
175            err := SP_SetIncProc(SP_IncMSBFull, ctx1);
176          {$endif}
177        end;
178     2: begin
179          writeln('IncProc = SP_IncLSBFull,   max. offset = ',oma);
180          {$ifdef USE_INT64}
181            writeln(erroutput, 'IncProc = SP_IncLSBFull,   max. offset = ',oma);
182          {$endif}
183          {$ifdef FPC_ProcVar}
184            err := SP_SetIncProc(@SP_IncLSBFull, ctx1);
185          {$else}
186            err := SP_SetIncProc(SP_IncLSBFull, ctx1);
187          {$endif}
188        end;
189 
190     3: begin
191          writeln('IncProc = SP_IncMSBPart,   max. offset = ',oma);
192          {$ifdef USE_INT64}
193            writeln(erroutput, 'IncProc = SP_IncMSBPart,   max. offset = ',oma);
194          {$endif}
195          {$ifdef FPC_ProcVar}
196            err := SP_SetIncProc(@SP_IncMSBPart, ctx1);
197          {$else}
198            err := SP_SetIncProc(SP_IncMSBPart, ctx1);
199          {$endif}
200        end;
201 
202     4: begin
203          writeln('IncProc = SP_IncLSBPart,   max. offset = ',oma);
204          {$ifdef USE_INT64}
205            writeln(erroutput, 'IncProc = SP_IncLSBPart,   max. offset = ',oma);
206          {$endif}
207          {$ifdef FPC_ProcVar}
208            err := SP_SetIncProc(@SP_IncLSBPart, ctx1);
209          {$else}
210            err := SP_SetIncProc(SP_IncLSBPart, ctx1);
211          {$endif}
212        end;
213   end;
214 
215   CheckError;
216   ofs := 0;
217   ReStartTimer(HR);
218   repeat
219     for i:=1 to 99 do begin
220       Err := SP_CTR_Encrypt(@pbuf, @cbuf1, BSIZE, ctx1);
221       ofs := ofs + BSIZE;
222     end;
223     {$ifdef USE_INT64}
224       write(erroutput, 100.0*ofs/oma:1:3,'%'#13);
225     {$else}
226       write(100.0*ofs/oma:1:3,'%'#13);
227     {$endif}
228     Err := SP_CTR_Encrypt(@pbuf, @cbuf1, BSIZE, ctx1);
229     CheckError;
230     i := random(BSIZE);
231     Err := SP_CTR_Init(key128, 128, CTR, ctx2);
232     CheckError;
233     case n of
234       1: begin
235            {$ifdef FPC_ProcVar}
236              err := SP_SetIncProc(@SP_IncMSBFull, ctx2);
237            {$else}
238              err := SP_SetIncProc(SP_IncMSBFull, ctx2);
239            {$endif}
240          end;
241       2: begin
242            {$ifdef FPC_ProcVar}
243              err := SP_SetIncProc(@SP_IncLSBFull, ctx2);
244            {$else}
245              err := SP_SetIncProc(SP_IncLSBFull, ctx2);
246            {$endif}
247          end;
248 
249       3: begin
250            {$ifdef FPC_ProcVar}
251              err := SP_SetIncProc(@SP_IncMSBPart, ctx2);
252            {$else}
253              err := SP_SetIncProc(SP_IncMSBPart, ctx2);
254            {$endif}
255          end;
256 
257       4: begin
258            {$ifdef FPC_ProcVar}
259              err := SP_SetIncProc(@SP_IncLSBPart, ctx2);
260            {$else}
261              err := SP_SetIncProc(SP_IncLSBPart, ctx2);
262            {$endif}
263          end;
264       else begin
265              writeln('Invalid n');
266              halt;
267            end;
268     end;
269     CheckError;
270     {$ifdef USE_INT64}
271       Err := SP_CTR_Seek64(CTR, ofs+i, ctx2);
272     {$else}
273       Err := SP_CTR_Seek(CTR, ofs+i, 0, ctx2);
274     {$endif}
275     CheckError;
276     Err := SP_CTR_Encrypt(@pbuf[i], @cbuf2[i], 1, ctx2);
277     CheckError;
278     if cbuf1[i]<>cbuf2[i] then begin
279       writeln('Diff:  Offset=',ofs+i,'  cbuf1[]=',cbuf1[i]:3,'  cbuf2[]=',cbuf2[i]:3);
280       halt;
281     end;
282     ofs := ofs + BSIZE;
283   until ofs>oma;
284   writeln('Done - no differences.');
285   writeln('Time [s]: ', ReadSeconds(HR):1:3);
286 end;
287 
288 var
289   {$ifdef D12Plus}
290     s: string;
291   {$else}
292     s: string[10];
293   {$endif}
294 
295 begin
296   writeln('Test program "Serpent CTR Seek"    (C) 2010  W.Ehrhardt');
297   {$ifdef USEDLL}
298     writeln('DLL Version: ',SP_DLL_Version);
299   {$endif}
300   writeln;
301   writeln('Test using standard SP_IncMSBFull');
302   randomtest(false);
303   writeln;
304   writeln('Test using user-defines My_IncMSBFull');
305   randomtest(true);
306   writeln;
307   StartTimer(HR);
308   s := paramstr(1);
309   if s='big' then begin
310     bigtest(1);
311     bigtest(2);
312     bigtest(3);
313     bigtest(4);
314   end;
315 end.
316