1 unit blake2b;
2 
3 {Blake2B - max 512 bit hash/MAC function}
4 
5 interface
6 
7 (*************************************************************************
8 
9  DESCRIPTION     :  Blake2B - max 512 bit hash/MAC function
10 
11  REQUIREMENTS    :  TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP
12 
13  EXTERNAL DATA   :  ---
14 
15  MEMORY USAGE    :  ---
16 
17  DISPLAY MODE    :  ---
18 
19  REFERENCES      :  - Saarinen et al: The BLAKE2 Cryptographic Hash and Message
20                       Authentication  Code (MAC); https://tools.ietf.org/html/rfc7693
21                     - Aumasson et al: BLAKE2: simpler, smaller, fast as MD5;
22                       https://blake2.net/blake2.pdf
23                     - Official reference code: https://github.com/BLAKE2/BLAKE2
24 
25 
26  Version  Date      Author      Modification
27  -------  --------  -------     ------------------------------------------
28  0.10     06.10.17  W.Ehrhardt  Initial D6 implementation (from Blake2s / RFC code)
29  0.11     06.10.17  we          removed updatelen, max input < 2^64
30  0.12     06.10.17  we          FPC fix
31  0.13     06.10.17  we          blake2b_selftest
32  0.14     06.10.17  we          used int64 instead of u64
33  0.15     07.10.17  we          unroll compress loop for Delphi
34  0.16     07.10.17  we          adjust/assert context size
35  0.17     03.11.17  we          Use THashContext and internal blake2b_ctx
36  0.18     04.11.17  we          Dummy functions for TP5-7, D1-D3, IV with longints
37  0.19     05.11.17  we          Some common code for 64 and 16/32 bit
38  0.20     05.11.17  we          32-Bit BASM
39  0.21     05.11.17  we          16-Bit BASM
40  0.22     21.11.14  eh          Faster blake2b_compress routines from EddyHawk
41  0.23     23.11.14  we          Replace RotR(,16) with word moves for non-int64
42  0.24     24.11.14  we          RotR63 with BASM
43  0.25     24.11.14  we          RotR24 with byte move
44  0.26     24.11.14  we          RotR63, Add64 for VER5X
45 
46 **************************************************************************)
47 
48 (*-------------------------------------------------------------------------
49  (C) Copyright 2017 Wolfgang Ehrhardt
50 
51  This software is provided 'as-is', without any express or implied warranty.
52  In no event will the authors be held liable for any damages arising from
53  the use of this software.
54 
55  Permission is granted to anyone to use this software for any purpose,
56  including commercial applications, and to alter it and redistribute it
57  freely, subject to the following restrictions:
58 
59  1. The origin of this software must not be misrepresented; you must not
60     claim that you wrote the original software. If you use this software in
61     a product, an acknowledgment in the product documentation would be
62     appreciated but is not required.
63 
64  2. Altered source versions must be plainly marked as such, and must not be
65     misrepresented as being the original software.
66 
67  3. This notice may not be removed or altered from any source distribution.
68 ----------------------------------------------------------------------------*)
69 
70 
71 {$i STD.INC}
72 
73 uses
74   BTypes, Hash;
75 
76 const
77   BLAKE2B_BlockLen  = 128;
78   BLAKE2B_MaxDigLen = 64;
79   BLAKE2B_MaxKeyLen = 64;
80 
81 type
82   TBlake2BDigest = packed array[0..BLAKE2B_MaxDigLen-1] of byte;  {max. blake2b digest}
83   TBlake2BBlock  = packed array[0..BLAKE2B_BlockLen-1]  of byte;
84 
85 
blake2b_Initnull86 function  blake2b_Init(var ctx: THashContext; key: pointer; keylen, diglen: word): integer;
87   {-Initialize context for a digest of diglen bytes; keylen=0: no key}
88 
89 procedure blake2b_update(var ctx: THashContext; msg: pointer; mlen: longint);
90   {-Add "mlen" bytes from "msg" into the hash}
91 
92 procedure blake2b_Final(var ctx: THashContext; var Digest: TBlake2BDigest);
93   {-Finalize calculation, generate message digest, clear context}
94 
blake2b_fullnull95 function  blake2b_full(var dig: TBlake2BDigest; diglen: word;
96                            key: pointer; keylen: word;
97                            msg: pointer; mlen: longint): integer;
98   {-Calculate hash digest of Msg with init/update/final}
99 
blake2b_selftestnull100 function  blake2b_selftest: boolean;
101   {-Return true, if self test is OK}
102 
103 
104 implementation
105 
106 
107 {The next comment is copy from blake2b-ref.c}
108 
109 (*
110    BLAKE2 reference source code package - reference C implementations
111 
112    Copyright 2012, Samuel Neves <sneves@dei.uc.pt>.  You may use this under the
113    terms of the CC0, the OpenSSL Licence, or the Apache Public License 2.0, at
114    your option.  The terms of these licenses can be found at:
115 
116    - CC0 1.0 Universal : http://creativecommons.org/publicdomain/zero/1.0
117    - OpenSSL license   : https://www.openssl.org/source/license.html
118    - Apache 2.0        : http://www.apache.org/licenses/LICENSE-2.0
119 
120    More information about the BLAKE2 hash function can be found at
121    https://blake2.net.
122 *)
123 
124 {Initialization Vector, longints for compatibility}
125 const
126   blake2b_ivl: array[0..15] of longint = (
127                  longint($F3BCC908), longint($6A09E667),
128                  longint($84CAA73B), longint($BB67AE85),
129                  longint($FE94F82B), longint($3C6EF372),
130                  longint($5F1D36F1), longint($A54FF53A),
131                  longint($ADE682D1), longint($510E527F),
132                  longint($2B3E6C1F), longint($9B05688C),
133                  longint($FB41BD6B), longint($1F83D9AB),
134                  longint($137E2179), longint($5BE0CD19));
135 
136 const
137   sigma: array[0..11,0..15] of byte = (
138            (  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15 ),
139            ( 14, 10,  4,  8,  9, 15, 13,  6,  1, 12,  0,  2, 11,  7,  5,  3 ),
140            ( 11,  8, 12,  0,  5,  2, 15, 13, 10, 14,  3,  6,  7,  1,  9,  4 ),
141            (  7,  9,  3,  1, 13, 12, 11, 14,  2,  6,  5, 10,  4,  0, 15,  8 ),
142            (  9,  0,  5,  7,  2,  4, 10, 15, 14,  1, 11, 12,  6,  8,  3, 13 ),
143            (  2, 12,  6, 10,  0, 11,  8,  3,  4, 13,  7,  5, 15, 14,  1,  9 ),
144            ( 12,  5,  1, 15, 14, 13,  4, 10,  0,  7,  6,  3,  9,  2,  8, 11 ),
145            ( 13, 11,  7, 14, 12,  1,  3,  9,  5,  0, 15,  4,  8,  6,  2, 10 ),
146            (  6, 15, 14,  9, 11,  3,  0,  8, 12,  2, 13,  7,  1,  4, 10,  5 ),
147            ( 10,  2,  8,  4,  7,  6,  1,  5, 15, 11,  9, 14,  3, 12, 13 , 0 ),
148            (  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15 ),
149            ( 14, 10,  4,  8,  9, 15, 13,  6,  1, 12,  0,  2, 11,  7,  5,  3 )
150          );
151 
152 
153 {$ifdef HAS_INT64}
154 
155 type
156   blake2b_ctx = packed record
157                   h: packed array[0..7] of int64;
158                   t: packed array[0..1] of int64;
159                   b: TBlake2BBlock;
160                   c: longint;
161                   outlen: longint;
162                   fill4: packed array[217..HASHCTXSIZE] of byte;
163                 end;
164 
165 {---------------------------------------------------------------------------}
166 procedure blake2b_compress(var ctx: blake2b_ctx; last: boolean);
167   {- Compression function, "last" indicates last block}
168 var
169   v,m: array[0..15] of int64;
170   tem: int64;
171   round,k: integer;
172 begin
173   with ctx do begin
174     {init work variables}
175     move(h, v, sizeof(h));
176     move(blake2b_ivl, v[8], sizeof(h));
177     v[12] := v[12] xor t[0];           {low 64 bits of offset}
178     v[13] := v[13] xor t[1];           {high 64 bits}
179     if last then v[14] := not v[14];   {last block flag set}
180 
181     {get little-endian words}
182     move(b, m, sizeof(m));
183 
184     {do 12 rounds}
185     for round:=0 to 11 do begin
186       {** EddyHawk speed-ups **}
187       {use same rearrangements as blake2s' 32/64 bit code}
188       v[ 0] := (v[ 0] + v[ 4]) + m[sigma[round][ 0]];
189       v[ 1] := (v[ 1] + v[ 5]) + m[sigma[round][ 2]];
190       v[ 2] := (v[ 2] + v[ 6]) + m[sigma[round][ 4]];
191       v[ 3] := (v[ 3] + v[ 7]) + m[sigma[round][ 6]];
192 
193       tem   := v[12] xor v[ 0];
194       v[12] := (tem shr 32) or (tem shl (64-32));
195       tem   := v[13] xor v[ 1];
196       v[13] := (tem shr 32) or (tem shl (64-32));
197       tem   := v[14] xor v[ 2];
198       v[14] := (tem shr 32) or (tem shl (64-32));
199       tem   := v[15] xor v[ 3];
200       v[15] := (tem shr 32) or (tem shl (64-32));
201 
202       v[ 8] := v[ 8] + v[12];
203       v[ 9] := v[ 9] + v[13];
204       v[10] := v[10] + v[14];
205       v[11] := v[11] + v[15];
206 
207       tem   := v[ 4] xor v[ 8];
208       v[ 4] := (tem shr 24) or (tem shl (64-24));
209       tem   := v[ 5] xor v[ 9];
210       v[ 5] := (tem shr 24) or (tem shl (64-24));
211       tem   := v[ 6] xor v[10];
212       v[ 6] := (tem shr 24) or (tem shl (64-24));
213       tem   := v[ 7] xor v[11];
214       v[ 7] := (tem shr 24) or (tem shl (64-24));
215 
216       {---}
217 
218       v[ 0] := (v[ 0] + v[ 4]) + m[sigma[round][ 1]];
219       v[ 1] := (v[ 1] + v[ 5]) + m[sigma[round][ 3]];
220       v[ 2] := (v[ 2] + v[ 6]) + m[sigma[round][ 5]];
221       v[ 3] := (v[ 3] + v[ 7]) + m[sigma[round][ 7]];
222 
223       tem   := v[12] xor v[ 0];
224       v[12] := (tem shr 16) or (tem shl (64-16));
225       tem   := v[13] xor v[ 1];
226       v[13] := (tem shr 16) or (tem shl (64-16));
227       tem   := v[14] xor v[ 2];
228       v[14] := (tem shr 16) or (tem shl (64-16));
229       tem   := v[15] xor v[ 3];
230       v[15] := (tem shr 16) or (tem shl (64-16));
231 
232       v[ 8] := v[ 8] + v[12];
233       v[ 9] := v[ 9] + v[13];
234       v[10] := v[10] + v[14];
235       v[11] := v[11] + v[15];
236 
237       tem   := v[ 4] xor v[ 8];
238       v[ 4] := (tem shr 63) or (tem shl (64-63));
239       tem   := v[ 5] xor v[ 9];
240       v[ 5] := (tem shr 63) or (tem shl (64-63));
241       tem   := v[ 6] xor v[10];
242       v[ 6] := (tem shr 63) or (tem shl (64-63));
243       tem   := v[ 7] xor v[11];
244       v[ 7] := (tem shr 63) or (tem shl (64-63));
245 
246       {---}
247 
248       v[ 0] := (v[ 0] + v[ 5]) + m[sigma[round][ 8]];
249       v[ 1] := (v[ 1] + v[ 6]) + m[sigma[round][10]];
250       v[ 2] := (v[ 2] + v[ 7]) + m[sigma[round][12]];
251       v[ 3] := (v[ 3] + v[ 4]) + m[sigma[round][14]];
252 
253       tem   := v[15] xor v[ 0];
254       v[15] := (tem shr 32) or (tem shl (64-32));
255       tem   := v[12] xor v[ 1];
256       v[12] := (tem shr 32) or (tem shl (64-32));
257       tem   := v[13] xor v[ 2];
258       v[13] := (tem shr 32) or (tem shl (64-32));
259       tem   := v[14] xor v[ 3];
260       v[14] := (tem shr 32) or (tem shl (64-32));
261 
262       v[10] := v[10] + v[15];
263       v[11] := v[11] + v[12];
264       v[ 8] := v[ 8] + v[13];
265       v[ 9] := v[ 9] + v[14];
266 
267       tem   := v[ 5] xor v[10];
268       v[ 5] := (tem shr 24) or (tem shl (64-24));
269       tem   := v[ 6] xor v[11];
270       v[ 6] := (tem shr 24) or (tem shl (64-24));
271       tem   := v[ 7] xor v[ 8];
272       v[ 7] := (tem shr 24) or (tem shl (64-24));
273       tem   := v[ 4] xor v[ 9];
274       v[ 4] := (tem shr 24) or (tem shl (64-24));
275 
276       {---}
277 
278       v[ 0] := (v[ 0] + v[ 5]) + m[sigma[round][ 9]];
279       v[ 1] := (v[ 1] + v[ 6]) + m[sigma[round][11]];
280       v[ 2] := (v[ 2] + v[ 7]) + m[sigma[round][13]];
281       v[ 3] := (v[ 3] + v[ 4]) + m[sigma[round][15]];
282 
283       tem   := v[15] xor v[ 0];
284       v[15] := (tem shr 16) or (tem shl (64-16));
285       tem   := v[12] xor v[ 1];
286       v[12] := (tem shr 16) or (tem shl (64-16));
287       tem   := v[13] xor v[ 2];
288       v[13] := (tem shr 16) or (tem shl (64-16));
289       tem   := v[14] xor v[ 3];
290       v[14] := (tem shr 16) or (tem shl (64-16));
291 
292       v[10] := v[10] + v[15];
293       v[11] := v[11] + v[12];
294       v[ 8] := v[ 8] + v[13];
295       v[ 9] := v[ 9] + v[14];
296 
297       tem   := v[ 5] xor v[10];
298       v[ 5] := (tem shr 63) or (tem shl (64-63));
299       tem   := v[ 6] xor v[11];
300       v[ 6] := (tem shr 63) or (tem shl (64-63));
301       tem   := v[ 7] xor v[ 8];
302       v[ 7] := (tem shr 63) or (tem shl (64-63));
303       tem   := v[ 4] xor v[ 9];
304       v[ 4] := (tem shr 63) or (tem shl (64-63));
305     end;
306 
307     {finalization}
308     for k:=0 to 7 do begin
309       h[k] := h[k] xor v[k] xor v[k+8];
310     end;
311   end;
312 end;
313 
314 
315 {---------------------------------------------------------------------------}
316 procedure blake2b_update(var ctx: THashContext; msg: pointer; mlen: longint);
317   {-Add "mlen" bytes from "msg" into the hash}
318 var
319   left,fill: integer;
320 begin
321   with blake2b_ctx(ctx) do begin
322     if mlen > 0 then begin
323       left := c;
324       fill := BLAKE2B_BlockLen - left;
325       if mlen > fill then begin
326         c := 0;
327         if fill>0 then move(msg^, b[left], fill);
328         t[0] := t[0] + BLAKE2B_BlockLen;
329         blake2b_compress(blake2b_ctx(ctx), false);
330         inc(Ptr2Inc(Msg),fill);
331         dec(mlen,fill);
332         while mlen > BLAKE2B_BlockLen do begin
333           move(msg^,b,BLAKE2B_BlockLen);
334           t[0] := t[0] + BLAKE2B_BlockLen;
335           blake2b_compress(blake2b_ctx(ctx), false);  {compress (not last)}
336           inc(Ptr2Inc(Msg),BLAKE2B_BlockLen);
337           dec(mlen,BLAKE2B_BlockLen);
338         end;
339       end;
340       if mlen > 0 then begin
341         move(msg^, b[c], mlen);
342         c := c + mlen;
343       end;
344     end;
345   end;
346 end;
347 
348 
349 {---------------------------------------------------------------------------}
350 procedure blake2b_Final(var ctx: THashContext; var Digest: TBlake2BDigest);
351   {-Finalize calculation, generate message digest, clear context}
352 var
353   i: integer;
354 begin
355   with blake2b_ctx(ctx) do begin
356     t[0] := t[0] + c;
357     while c < BLAKE2B_BlockLen do begin   {fill up with zeros}
358       b[c] := 0;
359       inc(c);
360     end;
361     blake2b_compress(blake2b_ctx(ctx), true);          {final block}
362     {little endian convert and store}
363     fillchar(Digest, sizeof(Digest),0);
364     for i:=0 to outlen-1 do begin
365       Digest[i] := (h[i shr 3] shr (8*(i and 7))) and $FF;
366     end;
367   end;
368 end;
369 
370 
371 {$else}
372 
373 type
374   blake2b_ctx = packed record
375                   h: packed array[0..15] of longint;
376                   t: packed array[0..3] of longint;
377                   b: TBlake2BBlock;
378                   c: longint;
379                   outlen: longint;
380                   fill4: packed array[217..HASHCTXSIZE] of byte;
381                 end;
382 
383 type
384   TW64    = packed record
385               L,H: longint;
386             end;
387   TW16    = packed record
388               w0,w1,w2,w3: word
389             end;
390 
391 {$ifdef BIT16}
392 {$ifdef BASM}
393 
394 {---------------------------------------------------------------------------}
395 procedure Add64(var z: TW64; {$ifdef CONST} const {$else} var {$endif} x: TW64); assembler;
396   {-Inc a 64 bit integer}
397 asm
398           les  bx,[x]
399   db $66; mov  ax,es:[bx]
400   db $66; mov  dx,es:[bx+4]
401           les  bx,[z]
402   db $66; add  es:[bx],ax
403   db $66; adc  es:[bx+4],dx
404 end;
405 
406 
407 {---------------------------------------------------------------------------}
408 procedure RotR63(var x: tw64);
409   {-Rotate right 63 bits = rotate left 1}
410 begin
411   asm
412            les   bx,[x]
413   db $66;  mov   ax,es:[bx]
414   db $66;  mov   dx,es:[bx+4]
415   db $66;  shl   ax,1
416   db $66;  rcl   dx,1
417            adc   ax,0
418   db $66;  mov   es:[bx],ax
419   db $66;  mov   es:[bx+4],dx
420   end;
421 end;
422 
423 
424 {$else}
425 
426 {16-bit compilers without BASM}
427 
428 {---------------------------------------------------------------------------}
429 procedure Add64(var Z: TW64; var X: TW64);
430   {-Inc a 64 bit integer}
431 inline(
432   $8C/$DF/      {mov   di,ds     }
433   $5E/          {pop   si        }
434   $1F/          {pop   ds        }
435   $8B/$04/      {mov   ax,[si]   }
436   $8B/$5C/$02/  {mov   bx,[si+02]}
437   $8B/$4C/$04/  {mov   cx,[si+04]}
438   $8B/$54/$06/  {mov   dx,[si+06]}
439   $5E/          {pop   si        }
440   $1F/          {pop   ds        }
441   $01/$04/      {add   [si],ax   }
442   $11/$5C/$02/  {adc   [si+02],bx}
443   $11/$4C/$04/  {adc   [si+04],cx}
444   $11/$54/$06/  {adc   [si+06],dx}
445   $8E/$DF);     {mov   ds,di     }
446 
447 
448 {---------------------------------------------------------------------------}
449 procedure RotR63(var x: tw64);
450   {-Rotate right 63 bits = rotate left 1}
451 inline(
452   $8C/$D9/      {mov   cx,ds     }
453   $5B/          {pop   bx        }
454   $1F/          {pop   ds        }
455   $8B/$47/$06/  {mov   ax,[bx+06]}
456   $D1/$E0/      {shl   ax,1      }
457   $8B/$07/      {mov   ax,[bx]   }
458   $D1/$D0/      {rcl   ax,1      }
459   $89/$07/      {mov   [bx],ax   }
460   $8B/$47/$02/  {mov   ax,[bx+02]}
461   $D1/$D0/      {rcl   ax,1      }
462   $89/$47/$02/  {mov   [bx+02],ax}
463   $8B/$47/$04/  {mov   ax,[bx+04]}
464   $D1/$D0/      {rcl   ax,1      }
465   $89/$47/$04/  {mov   [bx+04],ax}
466   $8B/$47/$06/  {mov   ax,[bx+06]}
467   $D1/$D0/      {rcl   ax,1      }
468   $89/$47/$06/  {mov   [bx+06],ax}
469   $8E/$D9);     {mov   ds,cx     }
470 {$endif}
471 
472 {$else}
473 
474 {---------------------------------------------------------------------------}
475 procedure Add64(var z: TW64; const x: TW64); assembler;
476   {-Inc a 64 bit integer z := z + x}
477 asm
478   {$ifdef LoadArgs}
479     mov eax,[z]
480     mov edx,[x]
481   {$endif}
482   mov  ecx,[edx]
483   add  [eax],ecx
484   mov  ecx,[edx+4]
485   adc  [eax+4],ecx
486 end;
487 
488 
489 {---------------------------------------------------------------------------}
490 procedure RotR63(var x: tw64); assembler;
491   {-Rotate right 63 bits}
492 asm
493   {$ifdef LoadArgs}
494     mov eax,[x]
495   {$endif}
496     mov   ecx,[eax]
497     mov   edx,[eax+4]
498     shl   ecx,1
499     rcl   edx,1
500     adc   ecx,0
501     mov   [eax],ecx
502     mov   [eax+4],edx
503 end;
504 
505 {$endif}
506 
507 
508 {---------------------------------------------------------------------------}
509 procedure RotR24(var x: tw64);
510   {-Rotate right 24 bits}
511 var
512   a: packed array[0..7] of byte absolute x;
513   b0,b1,b2: byte;
514 begin
515   b0 := a[0];
516   b1 := a[1];
517   b2 := a[2];
518   a[0] := a[3];
519   a[1] := a[4];
520   a[2] := a[5];
521   a[3] := a[6];
522   a[4] := a[7];
523   a[5] := b0;
524   a[6] := b1;
525   a[7] := b2;
526 end;
527 
528 
529 {---------------------------------------------------------------------------}
530 procedure inct01(var ctx: THashContext; cnt: longint);
531   {-Increment byte counter in ctx}
532 begin
533   with blake2b_ctx(ctx) do begin
534     if t[0] < 0 then begin
535       {Overflow if t[0]+cnt changes sign}
536       inc(t[0], cnt);
537       if t[0] >= 0 then inc(t[1]);
538     end
539     else inc(t[0], cnt);
540   end;
541 end;
542 
543 
544 {---------------------------------------------------------------------------}
545 procedure blake2b_compress(var ctx: blake2b_ctx; last: boolean);
546   {-Compression function, "last" indicates last block}
547 var
548   v,m: array[0..15] of tw64;
549   tem: longint;
550   round,k: integer;
551   tw: word;
552 begin
553   {get message}
554   with ctx do begin
555     {init work variables}
556     move(h, v, sizeof(h));
557     move(blake2b_ivl, v[8], sizeof(h));
558 
559     v[12].l := v[12].l xor t[0];       {low 64 bits of offset}
560     v[12].h := v[12].h xor t[1];
561     v[13].l := v[13].l xor t[2];       {high 64 bits}
562     v[13].h := v[13].h xor t[3];
563     if last then begin
564       v[14].l := not v[14].l;   {last block flag set}
565       v[14].h := not v[14].h;
566     end;
567 
568     {get little-endian words}
569     move(b, m, sizeof(m));
570 
571     {do 12 rounds}
572     for round:=0 to 11 do begin
573       {** EddyHawk speed-ups **}
574       {replaces G64 with partial unroll}
575       {replaces rotr64 by 32 with swap & temp var}
576       { integrates xor-ing into that swapping}
577       {splits 1 BLAKE2b round into quarter-rounds}
578       { regroups them}
579       {further splitting/regroupings, seems a bit better}
580       {moves message addition to the front, seems a bit better}
581 
582       add64(v[0],m[sigma[round][2*0]]);
583       add64(v[1],m[sigma[round][2*1]]);
584       add64(v[2],m[sigma[round][2*2]]);
585       add64(v[3],m[sigma[round][2*3]]);
586       add64(v[0],v[4]);
587       add64(v[1],v[5]);
588       add64(v[2],v[6]);
589       add64(v[3],v[7]);
590 
591       tem := v[12].L xor v[0].L;
592       v[12].L := v[12].H xor v[0].H;
593       v[12].H := tem;
594       tem := v[13].L xor v[1].L;
595       v[13].L := v[13].H xor v[1].H;
596       v[13].H := tem;
597       tem := v[14].L xor v[2].L;
598       v[14].L := v[14].H xor v[2].H;
599       v[14].H := tem;
600       tem := v[15].L xor v[3].L;
601       v[15].L := v[15].H xor v[3].H;
602       v[15].H := tem;
603 
604       add64(v[ 8],v[12]);
605       add64(v[ 9],v[13]);
606       add64(v[10],v[14]);
607       add64(v[11],v[15]);
608 
609       v[4].L := v[4].L xor v[ 8].L;
610       v[5].L := v[5].L xor v[ 9].L;
611       v[6].L := v[6].L xor v[10].L;
612       v[7].L := v[7].L xor v[11].L;
613       v[4].H := v[4].H xor v[ 8].H;
614       v[5].H := v[5].H xor v[ 9].H;
615       v[6].H := v[6].H xor v[10].H;
616       v[7].H := v[7].H xor v[11].H;
617 
618       RotR24(v[4]);
619       RotR24(v[5]);
620       RotR24(v[6]);
621       RotR24(v[7]);
622 
623       {---}
624 
625       add64(v[0],m[sigma[round][2*0+1]]);
626       add64(v[1],m[sigma[round][2*1+1]]);
627       add64(v[2],m[sigma[round][2*2+1]]);
628       add64(v[3],m[sigma[round][2*3+1]]);
629       add64(v[0],v[4]);
630       add64(v[1],v[5]);
631       add64(v[2],v[6]);
632       add64(v[3],v[7]);
633 
634       v[12].L := v[12].L xor v[ 0].L;
635       v[13].L := v[13].L xor v[ 1].L;
636       v[14].L := v[14].L xor v[ 2].L;
637       v[15].L := v[15].L xor v[ 3].L;
638       v[12].H := v[12].H xor v[ 0].H;
639       v[13].H := v[13].H xor v[ 1].H;
640       v[14].H := v[14].H xor v[ 2].H;
641       v[15].H := v[15].H xor v[ 3].H;
642 
643       {WE V0.23: Replace RotR(,16) with word moves}
644       {RotR(v[12],16);}
645       with TW16(v[12]) do begin
646         tw := w0;
647         w0 := w1;
648         w1 := w2;
649         w2 := w3;
650         w3 := tw;
651       end;
652       {RotR(v[13],16);}
653       with TW16(v[13]) do begin
654         tw := w0;
655         w0 := w1;
656         w1 := w2;
657         w2 := w3;
658         w3 := tw;
659       end;
660       {RotR(v[14],16);}
661       with TW16(v[14]) do begin
662         tw := w0;
663         w0 := w1;
664         w1 := w2;
665         w2 := w3;
666         w3 := tw;
667       end;
668       {RotR(v[15],16);}
669       with TW16(v[15]) do begin
670         tw := w0;
671         w0 := w1;
672         w1 := w2;
673         w2 := w3;
674         w3 := tw;
675       end;
676 
677       add64(v[ 8],v[12]);
678       add64(v[ 9],v[13]);
679       add64(v[10],v[14]);
680       add64(v[11],v[15]);
681 
682       v[4].L := v[4].L xor v[ 8].L;
683       v[5].L := v[5].L xor v[ 9].L;
684       v[6].L := v[6].L xor v[10].L;
685       v[7].L := v[7].L xor v[11].L;
686       v[4].H := v[4].H xor v[ 8].H;
687       v[5].H := v[5].H xor v[ 9].H;
688       v[6].H := v[6].H xor v[10].H;
689       v[7].H := v[7].H xor v[11].H;
690 
691       RotR63(v[4]);
692       RotR63(v[5]);
693       RotR63(v[6]);
694       RotR63(v[7]);
695       {---}
696 
697       add64(v[0],m[sigma[round][2*4]]);
698       add64(v[1],m[sigma[round][2*5]]);
699       add64(v[2],m[sigma[round][2*6]]);
700       add64(v[3],m[sigma[round][2*7]]);
701       add64(v[0],v[5]);
702       add64(v[1],v[6]);
703       add64(v[2],v[7]);
704       add64(v[3],v[4]);
705 
706       tem := v[15].L xor v[0].L;
707       v[15].L := v[15].H xor v[0].H;
708       v[15].H := tem;
709       tem := v[12].L xor v[1].L;
710       v[12].L := v[12].H xor v[1].H;
711       v[12].H := tem;
712       tem := v[13].L xor v[2].L;
713       v[13].L := v[13].H xor v[2].H;
714       v[13].H := tem;
715       tem := v[14].L xor v[3].L;
716       v[14].L := v[14].H xor v[3].H;
717       v[14].H := tem;
718 
719       add64(v[10],v[15]);
720       add64(v[11],v[12]);
721       add64(v[ 8],v[13]);
722       add64(v[ 9],v[14]);
723 
724       v[5].L := v[5].L xor v[10].L;
725       v[6].L := v[6].L xor v[11].L;
726       v[7].L := v[7].L xor v[ 8].L;
727       v[4].L := v[4].L xor v[ 9].L;
728       v[5].H := v[5].H xor v[10].H;
729       v[6].H := v[6].H xor v[11].H;
730       v[7].H := v[7].H xor v[ 8].H;
731       v[4].H := v[4].H xor v[ 9].H;
732 
733       RotR24(v[5]);
734       RotR24(v[6]);
735       RotR24(v[7]);
736       RotR24(v[4]);
737 
738 
739       add64(v[0],m[sigma[round][2*4+1]]);
740       add64(v[1],m[sigma[round][2*5+1]]);
741       add64(v[2],m[sigma[round][2*6+1]]);
742       add64(v[3],m[sigma[round][2*7+1]]);
743       add64(v[0],v[5]);
744       add64(v[1],v[6]);
745       add64(v[2],v[7]);
746       add64(v[3],v[4]);
747 
748       v[15].L := v[15].L xor v[ 0].L;
749       v[12].L := v[12].L xor v[ 1].L;
750       v[13].L := v[13].L xor v[ 2].L;
751       v[14].L := v[14].L xor v[ 3].L;
752       v[15].H := v[15].H xor v[ 0].H;
753       v[12].H := v[12].H xor v[ 1].H;
754       v[13].H := v[13].H xor v[ 2].H;
755       v[14].H := v[14].H xor v[ 3].H;
756 
757       {WE V0.23: Replace RotR(,16) with word moves}
758       {RotR(v[15],16);}
759       with TW16(v[15]) do begin
760         tw := w0;
761         w0 := w1;
762         w1 := w2;
763         w2 := w3;
764         w3 := tw;
765       end;
766       {RotR(v[12],16);}
767       with TW16(v[12]) do begin
768         tw := w0;
769         w0 := w1;
770         w1 := w2;
771         w2 := w3;
772         w3 := tw;
773       end;
774       {RotR(v[13],16);}
775       with TW16(v[13]) do begin
776         tw := w0;
777         w0 := w1;
778         w1 := w2;
779         w2 := w3;
780         w3 := tw;
781       end;
782       {RotR(v[14],16);}
783       with TW16(v[14]) do begin
784         tw := w0;
785         w0 := w1;
786         w1 := w2;
787         w2 := w3;
788         w3 := tw;
789       end;
790 
791       add64(v[10],v[15]);
792       add64(v[11],v[12]);
793       add64(v[ 8],v[13]);
794       add64(v[ 9],v[14]);
795 
796       v[5].L := v[5].L xor v[10].L;
797       v[6].L := v[6].L xor v[11].L;
798       v[7].L := v[7].L xor v[ 8].L;
799       v[4].L := v[4].L xor v[ 9].L;
800       v[5].H := v[5].H xor v[10].H;
801       v[6].H := v[6].H xor v[11].H;
802       v[7].H := v[7].H xor v[ 8].H;
803       v[4].H := v[4].H xor v[ 9].H;
804 
805       RotR63(v[5]);
806       RotR63(v[6]);
807       RotR63(v[7]);
808       RotR63(v[4]);
809     end;
810 
811     {finalization}
812     for k:=0 to 7 do begin
813       h[2*k]   := h[2*k]   xor v[k].l xor v[k+8].l;
814       h[2*k+1] := h[2*k+1] xor v[k].h xor v[k+8].h;
815     end;
816   end;
817 end;
818 
819 
820 {---------------------------------------------------------------------------}
821 procedure blake2b_update(var ctx: THashContext; msg: pointer; mlen: longint);
822   {-Add "mlen" bytes from "msg" into the hash}
823 var
824   left,fill: integer;
825 begin
826   with blake2b_ctx(ctx) do begin
827     if mlen > 0 then begin
828       left := c;
829       fill := BLAKE2B_BlockLen - left;
830       if mlen > fill then begin
831         c := 0;
832         if fill>0 then move(msg^, b[left], fill);
833         inct01(ctx, BLAKE2B_BlockLen);
834         blake2b_compress(blake2b_ctx(ctx), false);
835         inc(Ptr2Inc(Msg),fill);
836         dec(mlen,fill);
837         while mlen > BLAKE2B_BlockLen do begin
838           move(msg^,b,BLAKE2B_BlockLen);
839           inct01(ctx, BLAKE2B_BlockLen);
840           blake2b_compress(blake2b_ctx(ctx), false);  {compress (not last)}
841           inc(Ptr2Inc(Msg),BLAKE2B_BlockLen);
842           dec(mlen,BLAKE2B_BlockLen);
843         end;
844       end;
845       if mlen > 0 then begin
846         move(msg^, b[c], mlen);
847         c := c + mlen;
848       end;
849     end;
850   end;
851 end;
852 
853 
854 {---------------------------------------------------------------------------}
855 procedure blake2b_Final(var ctx: THashContext; var Digest: TBlake2BDigest);
856   {-Finalize calculation, generate message digest, clear context}
857 begin
858   with blake2b_ctx(ctx) do begin
859     inct01(ctx, c);
860     while c < BLAKE2B_BlockLen do begin   {fill up with zeros}
861       b[c] := 0;
862       inc(c);
863     end;
864     blake2b_compress(blake2b_ctx(ctx), true);  {final block}
865     {little endian convert and store}
866     fillchar(Digest, sizeof(Digest),0);
867     move(h, Digest, outlen);
868   end;
869 end;
870 {$endif}
871 
872 
873 {---------------------------------------------------------------------------}
blake2b_Initnull874 function  blake2b_Init(var ctx: THashContext; key: pointer; keylen, diglen: word): integer;
875   {-Initialize context for a digest of diglen bytes; keylen=0: no key}
876 var
877   tb: TBlake2BBlock;
878 begin
879   if (diglen=0) or (diglen > BLAKE2B_MaxDigLen) or (keylen > BLAKE2B_MaxKeyLen) then begin
880     blake2b_Init := -1;  {illegal parameters}
881     exit;
882   end;
883   blake2b_Init := 0;
884   fillchar(ctx, sizeof(ctx), 0);
885   with blake2b_ctx(ctx) do begin
886     move(blake2b_ivl, h, sizeof(h));
887     outlen := diglen;
888     {Fill the lowest 32 bit of h, same for 16/32/64 bit}
889     h[0] := h[0] xor (($01010000) xor (keylen shl 8) xor outlen);
890     if keylen > 0 then begin
891       fillchar(tb, sizeof(tb),0);
892       move(key^, tb, keylen);
893       blake2b_update(ctx, @tb, BLAKE2B_BlockLen);
894     end;
895   end;
896 end;
897 
898 
899 {---------------------------------------------------------------------------}
blake2b_fullnull900 function blake2b_full(var dig: TBlake2BDigest; diglen: word;
901                           key: pointer; keylen: word;
902                           msg: pointer; mlen: longint): integer;
903   {-Calculate hash digest of Msg with init/update/final}
904 var
905   ctx: THashContext;
906 begin
907   if blake2b_init(ctx, key, keylen, diglen) <> 0 then begin
908     blake2b_full := -1;
909   end
910   else begin
911     blake2b_update(ctx, msg, mlen);
912     blake2b_final(ctx, dig);
913     blake2b_full := 0;
914   end;
915 end;
916 
917 
918 {---------------------------------------------------------------------------}
blake2b_selftestnull919 function blake2b_selftest: boolean;
920   {-Return true, if self test is OK}
921   procedure selftest_seq(outp: pbyte;  len, seed: integer);
922   var
923     t,a,b: longint;
924     i: integer;
925   begin
926     a := longint($DEAD4BAD) * seed;
927     b := 1;
928     for i:=1 to len do begin
929       t := a+b;
930       a := b;
931       b := t;
932       outp^ := (t shr 24) and $FF;
933       inc(Ptr2Inc(outp));
934     end;
935   end;
936 const
937   {Grand hash of hash results}
938   blake2b_res: array[0..31] of byte = (
939                  $C2, $3A, $78, $00, $D9, $81, $23, $BD,
940                  $10, $F5, $06, $C6, $1E, $29, $DA, $56,
941                  $03, $D7, $63, $B8, $BB, $AD, $2E, $73,
942                  $7F, $5E, $76, $5A, $7B, $CC, $D4, $75
943                );
944   {Parameter sets}
945   b2s_md_len: array[0..3] of integer = (20, 32, 48, 64);
946   b2s_in_len: array[0..5] of integer = (0,  3,  128, 129, 255, 1024);
947 var
948   i,j, outlen, inlen: integer;
949   md, key: TBlake2BDigest;
950   ctx: THashContext;
951   inb: array[0..1023] of byte;
952 begin
953   blake2b_selftest := false;
954   {256-bit hash for testing}
955   if blake2b_init(ctx, nil, 0, 32) <> 0 then exit;
956   for i:=0 to 3 do begin
957     outlen := b2s_md_len[i];
958     for j:=0 to 5 do begin
959       inlen := b2s_in_len[j];
960       selftest_seq(pbyte(@inb), inlen, inlen);      {unkeyed hash}
961       if blake2b_full(md, outlen, nil, 0, @inb, inlen) <> 0 then exit;
962       blake2b_update(ctx, @md, outlen);             {hash the hash}
963       selftest_seq(pbyte(@key), outlen, outlen);    {keyed hash}
964       if blake2b_full(md, outlen, @key, outlen, @inb, inlen) <> 0 then exit;
965       blake2b_update(ctx, @md, outlen);             {hash the hash}
966     end;
967   end;
968   {Compute and compare the hash of hashes.}
969   blake2b_final(ctx, md);
970   for i:=0 to 31 do begin
971     if md[i] <> blake2b_res[i] then exit;
972   end;
973   blake2b_selftest := true;
974 end;
975 
976 
977 begin
978   {$ifdef HAS_ASSERT}
979     assert(sizeof(blake2b_ctx)=HASHCTXSIZE , '** Invalid sizeof(blake2b_ctx)');
980   {$endif}
981 end.
982 
983