1 unit SHA512;
2
3 {512 bit Secure Hash Function}
4
5
6 interface
7
8 (*************************************************************************
9
10 DESCRIPTION : SHA512 - 512 bit Secure Hash Function
11
12 REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP
13
14 EXTERNAL DATA : ---
15
16 MEMORY USAGE : ---
17
18 DISPLAY MODE : ---
19
20 REFERENCES : - Latest specification of Secure Hash Standard:
21 http://csrc.nist.gov/publications/fips/fips180-4/fips-180-4.pdf
22 - Test vectors and intermediate values:
23 http://csrc.nist.gov/groups/ST/toolkit/documents/Examples/SHA_All.pdf
24 * http://disastry.dhs.org/pgp/pgp263iamulti06.zip
25
26
27 Version Date Author Modification
28 ------- -------- ------- ------------------------------------------
29 0.10 19.11.02 W.Ehrhardt Reference implementation (TP7, D1-D6, FPC, VP)
30 0.11 19.11.02 we TP5/5.5/6
31 0.12 19.11.02 we BASM: Add64
32 0.13 19.11.02 we S[x] := S[x-1] with .L and .H
33 0.14 19.11.02 we Maj/Ch inline
34 0.15 19.11.02 we BASM: RR2
35 0.16 20.11.02 we BIT32: RR2 inline
36 0.17 20.11.02 we BASM16: Sum0/1, Sig0/1
37 0.18 20.11.02 we BASM16: Add64 inline()
38 0.19 20.11.02 we BIT16: $F-
39 0.20 20.11.02 we 128 bit UpdateLen, K array of TW64
40 0.21 20.11.02 we Ref: Add64 opt, removd RR2 in Sum0/1, Sig0/1
41 0.22 21.11.02 we Ref: Add64/RB more opt, interface SHA512UpdateXL
42 0.23 24.11.02 we Opt. UpdateLen, BASM16: RA inline()
43 3.00 01.12.03 we Common version 3.0
44 3.01 22.12.03 we TP5/5.5: shl/shr inline
45 3.02 22.12.03 we Changed Add64 def, TP5/5.5: Add64 inline
46 3.03 24.12.03 we Changed Ch() and Maj()
47 3.04 14.01.04 we Int64 support (default for D4+)
48 3.05 15.01.04 we Bit32: inline Sum/Sig0/1
49 3.06 22.01.04 we Inc64
50 3.07 05.03.04 we Update fips180-2 URL, no Add64 for Int64
51 3.08 04.01.05 we Bugfix SHA512Final
52 3.09 04.01.05 we Bugfix Int64 version of SHA512Compress
53 3.10 26.02.05 we With {$ifdef StrictLong}
54 3.11 05.05.05 we $R- for StrictLong, D9: errors if $R+ even if warnings off
55 3.12 17.12.05 we Force $I- in SHA512File
56 3.13 15.01.06 we uses Hash unit and THashDesc
57 3.14 15.01.06 we BugFix for UseInt64
58 3.15 18.01.06 we Descriptor fields HAlgNum, HSig
59 3.16 22.01.06 we Removed HSelfTest from descriptor
60 3.17 11.02.06 we Descriptor as typed const
61 3.18 07.08.06 we $ifdef BIT32: (const fname: shortstring...)
62 3.19 22.02.07 we values for OID vector
63 3.20 30.06.07 we Use conditional define FPC_ProcVar
64 3.21 29.09.07 we Bugfix for message bit lengths >= 2^32
65 3.22 04.10.07 we FPC: {$asmmode intel}
66 3.23 03.05.08 we Bit-API: SHA512FinalBits/Ex
67 3.24 05.05.08 we THashDesc constant with HFinalBit field
68 3.25 12.11.08 we Uses BTypes, Ptr2Inc and/or Str255/Str127
69 3.26 11.03.12 we Updated references
70 3.27 26.12.12 we D17 and PurePascal
71 3.28 16.08.15 we Removed $ifdef DLL / stdcall
72 3.29 15.05.17 we adjust OID to new MaxOIDLen
73 3.30 29.11.17 we SHA512File - fname: string
74
75 **************************************************************************)
76
77
78 (*-------------------------------------------------------------------------
79 (C) Copyright 2002-2017 Wolfgang Ehrhardt
80
81 This software is provided 'as-is', without any express or implied warranty.
82 In no event will the authors be held liable for any damages arising from
83 the use of this software.
84
85 Permission is granted to anyone to use this software for any purpose,
86 including commercial applications, and to alter it and redistribute it
87 freely, subject to the following restrictions:
88
89 1. The origin of this software must not be misrepresented; you must not
90 claim that you wrote the original software. If you use this software in
91 a product, an acknowledgment in the product documentation would be
92 appreciated but is not required.
93
94 2. Altered source versions must be plainly marked as such, and must not be
95 misrepresented as being the original software.
96
97 3. This notice may not be removed or altered from any source distribution.
98 ----------------------------------------------------------------------------*)
99
100
101 { [*] Janis Jagars, known to the PGP community as "Disastry",
102 perished on October 31, 2002 while on vacation in Nepal. }
103
104 { NOTE: FIPS Ch and May functions can be optimized. Wei Dai (Crypto++ V 3.1)
105 credits Rich Schroeppel (rcs@cs.arizona.edu), V 5.1 does not!?}
106
107
108 {$i STD.INC}
109
110 {$ifdef BIT64}
111 {$ifndef PurePascal}
112 {$define PurePascal}
113 {$endif}
114 {$endif}
115
116 {$ifdef PurePascal}
117 {$define UseInt64}
118 {$else}
119 {$ifdef D4Plus}
120 {$define UseInt64}
121 {$endif}
122 {$ifdef FPC}
123 {$define UseInt64}
124 {$endif}
125 {$endif}
126
127
128 uses
129 BTypes,Hash;
130
131
132 procedure SHA512Init(var Context: THashContext);
133 {-initialize context}
134
135 procedure SHA512Update(var Context: THashContext; Msg: pointer; Len: word);
136 {-update context with Msg data}
137
138 procedure SHA512UpdateXL(var Context: THashContext; Msg: pointer; Len: longint);
139 {-update context with Msg data}
140
141 procedure SHA512Final(var Context: THashContext; var Digest: TSHA512Digest);
142 {-finalize SHA512 calculation, clear context}
143
144 procedure SHA512FinalEx(var Context: THashContext; var Digest: THashDigest);
145 {-finalize SHA512 calculation, clear context}
146
147 procedure SHA512FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer);
148 {-finalize SHA512 calculation with bitlen bits from BData (big-endian), clear context}
149
150 procedure SHA512FinalBits(var Context: THashContext; var Digest: TSHA512Digest; BData: byte; bitlen: integer);
151 {-finalize SHA512 calculation with bitlen bits from BData (big-endian), clear context}
152
SHA512SelfTestnull153 function SHA512SelfTest: boolean;
154 {-self test for string from SHA512 document}
155
156 procedure SHA512Full(var Digest: TSHA512Digest; Msg: pointer; Len: word);
157 {-SHA512 of Msg with init/update/final}
158
159 procedure SHA512FullXL(var Digest: TSHA512Digest; Msg: pointer; Len: longint);
160 {-SHA512 of Msg with init/update/final}
161
162 procedure SHA512File({$ifdef CONST} const {$endif} fname: string;
163 var Digest: TSHA512Digest; var buf; bsize: word; var Err: word);
164 {-SHA512 of file, buf: buffer with at least bsize bytes}
165
166
167
168 implementation
169
170
171
172 {$ifdef BIT16}
173 {$F-}
174 {$endif}
175
176 const
177 SHA512_BlockLen = 128;
178
179 {Internal types for type casting}
180 type
181 TW64 = packed record
182 L,H: longint;
183 end;
184
185
186 {2.16.840.1.101.3.4.2.3}
187 {joint-iso-itu-t(2) country(16) us(840) organization(1) gov(101) csor(3) nistAlgorithm(4) hashAlgs(2) sha512(3)}
188 const
189 SHA512_OID : TOID_Vec = (2,16,840,1,101,3,4,2,3,-1,-1); {Len=9}
190
191 {$ifndef VER5X}
192 const
193 SHA512_Desc: THashDesc = (
194 HSig : C_HashSig;
195 HDSize : sizeof(THashDesc);
196 HDVersion : C_HashVers;
197 HBlockLen : SHA512_BlockLen;
198 HDigestlen: sizeof(TSHA512Digest);
199 {$ifdef FPC_ProcVar}
200 HInit : @SHA512Init;
201 HFinal : @SHA512FinalEx;
202 HUpdateXL : @SHA512UpdateXL;
203 {$else}
204 HInit : SHA512Init;
205 HFinal : SHA512FinalEx;
206 HUpdateXL : SHA512UpdateXL;
207 {$endif}
208 HAlgNum : longint(_SHA512);
209 HName : 'SHA512';
210 HPtrOID : @SHA512_OID;
211 HLenOID : 9;
212 HFill : 0;
213 {$ifdef FPC_ProcVar}
214 HFinalBit : @SHA512FinalBitsEx;
215 {$else}
216 HFinalBit : SHA512FinalBitsEx;
217 {$endif}
218 HReserved : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
219 );
220 {$else}
221 var
222 SHA512_Desc: THashDesc;
223 {$endif}
224
225
226 {$ifndef BIT16}
227
228 {$ifdef PurePascal}
229 {---------------------------------------------------------------------------}
RBnull230 function RB(A: longint): longint; {$ifdef HAS_INLINE} inline; {$endif}
231 {-reverse byte order in longint}
232 begin
233 RB := ((A and $FF) shl 24) or ((A and $FF00) shl 8) or ((A and $FF0000) shr 8) or ((A and longint($FF000000)) shr 24);
234 end;
235 {$else}
236 {---------------------------------------------------------------------------}
RBnull237 function RB(A: longint): longint; assembler;
238 {-reverse byte order in longint}
239 asm
240 {$ifdef LoadArgs}
241 mov eax,[A]
242 {$endif}
243 xchg al,ah
244 rol eax,16
245 xchg al,ah
246 end;
247 {---------------------------------------------------------------------------}
248 procedure Inc64(var Z: TW64; const X: TW64); assembler;
249 {-Inc a 64 bit integer}
250 asm
251 {$ifdef LoadArgs}
252 mov eax,[Z]
253 mov edx,[X]
254 {$endif}
255 mov ecx, [edx]
256 add [eax], ecx
257 mov ecx, [edx+4]
258 adc [eax+4],ecx
259 end;
260 {$endif}
261
262
263 {$ifndef UseInt64}
264 {---------------------------------------------------------------------------}
265 procedure Add64(var Z: TW64; const X,Y: TW64);
266 {-Add two 64 bit integers}
267 begin
268 asm
269 mov ecx, [X]
270 mov eax, [ecx]
271 mov edx, [ecx+4]
272 mov ecx, [Y]
273 add eax, [ecx]
274 adc edx, [ecx+4]
275 mov ecx, [Z]
276 mov [ecx], eax
277 mov [ecx+4], edx
278 end;
279 end;
280 {$endif}
281
282
283 {$else}
284
285 {*** 16 bit ***}
286
287 (**** TP5-7/Delphi1 for 386+ *****)
288
289 {$ifndef BASM16}
290
291 (*** TP 5/5.5 ***)
292
293 {---------------------------------------------------------------------------}
RBnull294 function RB(A: longint): longint;
295 {-reverse byte order in longint}
296 inline(
297 $58/ {pop ax }
298 $5A/ {pop dx }
299 $86/$C6/ {xchg dh,al}
300 $86/$E2); {xchg dl,ah}
301
302
303 {---------------------------------------------------------------------------}
ISHRnull304 function ISHR(x: longint; c: integer): longint;
305 {-Shift x right}
306 inline(
307 $59/ { pop cx }
308 $58/ { pop ax }
309 $5A/ { pop dx }
310 $D1/$EA/ {L:shr dx,1 }
311 $D1/$D8/ { rcr ax,1 }
312 $49/ { dec cx }
313 $75/$F9); { jne L }
314
315
316 {---------------------------------------------------------------------------}
ISHR0null317 function ISHR0(x: longint; c: integer): longint;
318 {-Shift x right, c+16}
319 inline(
320 $59/ { pop cx }
321 $58/ { pop ax }
322 $58/ { pop ax }
323 $33/$D2/ { xor dx,dx}
324 $D1/$EA/ {L:shr dx,1 }
325 $D1/$D8/ { rcr ax,1 }
326 $49/ { dec cx }
327 $75/$F9); { jne L }
328
329
330 {---------------------------------------------------------------------------}
ISHLnull331 function ISHL(x: longint; c: integer): longint;
332 {-Shift x left}
333 inline(
334 $59/ { pop cx }
335 $58/ { pop ax }
336 $5A/ { pop dx }
337 $D1/$E0/ {L:shl ax,1 }
338 $D1/$D2/ { rcl dx,1 }
339 $49/ { dec cx }
340 $75/$F9); { jne L }
341
342
343 {---------------------------------------------------------------------------}
ISHL0null344 function ISHL0(x: longint; c: integer): longint;
345 {-Shift x left, c+16}
346 inline(
347 $59/ { pop cx }
348 $5A/ { pop dx }
349 $58/ { pop ax }
350 $33/$C0/ { xor ax,ax}
351 $D1/$E0/ {L:shl ax,1 }
352 $D1/$D2/ { rcl dx,1 }
353 $49/ { dec cx }
354 $75/$F9); { jne L }
355
356
357 {---------------------------------------------------------------------------}
358 procedure Add64(var Z: TW64; var X,Y: TW64);
359 {-Add two 64 bit integers: Z:=X+Y}
360 inline(
361 $8C/$DF/ {mov di,ds }
362 $5E/ {pop si }
363 $1F/ {pop ds }
364 $8B/$04/ {mov ax,[si] }
365 $8B/$5C/$02/ {mov bx,[si+02]}
366 $8B/$4C/$04/ {mov cx,[si+04]}
367 $8B/$54/$06/ {mov dx,[si+06]}
368 $5E/ {pop si }
369 $1F/ {pop ds }
370 $03/$04/ {add ax,[si] }
371 $13/$5C/$02/ {adc bx,[si+02]}
372 $13/$4C/$04/ {adc cx,[si+04]}
373 $13/$54/$06/ {adc dx,[si+06]}
374 $5E/ {pop si }
375 $1F/ {pop ds }
376 $89/$04/ {mov [si],ax }
377 $89/$5C/$02/ {mov [si+02],bx}
378 $89/$4C/$04/ {mov [si+04],cx}
379 $89/$54/$06/ {mov [si+06],dx}
380 $8E/$DF); {mov ds,di }
381
382
383 {---------------------------------------------------------------------------}
384 procedure Inc64(var Z: TW64; var X: TW64);
385 {-Inc a 64 bit integer}
386 inline(
387 $8C/$DF/ {mov di,ds }
388 $5E/ {pop si }
389 $1F/ {pop ds }
390 $8B/$04/ {mov ax,[si] }
391 $8B/$5C/$02/ {mov bx,[si+02]}
392 $8B/$4C/$04/ {mov cx,[si+04]}
393 $8B/$54/$06/ {mov dx,[si+06]}
394 $5E/ {pop si }
395 $1F/ {pop ds }
396 $01/$04/ {add [si],ax }
397 $11/$5C/$02/ {adc [si+02],bx}
398 $11/$4C/$04/ {adc [si+04],cx}
399 $11/$54/$06/ {adc [si+06],dx}
400 $8E/$DF); {mov ds,di }
401
402
403 {---------------------------------------------------------------------------}
404 procedure Sum0(var X: TW64; var R: TW64);
405 {-Big-Sigma-0 function, 'preproccessed' for shift counts > 16}
406 begin
407 R.L := (ISHR0(X.L,12) or ISHL(X.H,4)) xor (ISHR(X.H,2) or ISHL0(X.L,14)) xor (ISHR(X.H,7) or ISHL0(X.L,9));
408 R.H := (ISHR0(X.H,12) or ISHL(X.L,4)) xor (ISHR(X.L,2) or ISHL0(X.H,14)) xor (ISHR(X.L,7) or ISHL0(X.H,9));
409 end;
410
411
412 {---------------------------------------------------------------------------}
413 procedure Sum1(var X: TW64; var R: TW64);
414 {-Big-Sigma-1 function, 'preproccessed' for shift counts > 16}
415 begin
416 R.L := (ISHR(X.L,14) or ISHL0(X.H,2)) xor (ISHR0(X.L,2) or ISHL(X.H,14)) xor (ISHR(X.H,9) or ISHL0(X.L,7));
417 R.H := (ISHR(X.H,14) or ISHL0(X.L,2)) xor (ISHR0(X.H,2) or ISHL(X.L,14)) xor (ISHR(X.L,9) or ISHL0(X.H,7));
418 end;
419
420
421 {---------------------------------------------------------------------------}
422 procedure Sig0(var X: TW64; var R: TW64);
423 {-Small-Sigma-0 function, 'preproccessed' for shift counts > 16}
424 begin
425 R.L := (ISHR(X.L,1) or ISHL0(X.H,15)) xor (ISHR(X.L,8) or ISHL0(X.H,8)) xor (ISHR(X.L,7) or ISHL0(X.H,9));
426 R.H := (ISHR(X.H,1) or ISHL0(X.L,15)) xor (ISHR(X.H,8) or ISHL0(X.L,8)) xor ISHR(X.H,7);
427 end;
428
429
430 {---------------------------------------------------------------------------}
431 procedure Sig1(var X: TW64; var R: TW64);
432 {-Small-Sigma-1 function, 'preproccessed' for shift counts > 31}
433 begin
434 R.L := (ISHR0(X.L,3) or ISHL(X.H,13)) xor (ISHR0(X.H,13) or ISHL(X.L,3)) xor (ISHR(X.L,6) or ISHL0(X.H,10));
435 R.H := (ISHR0(X.H,3) or ISHL(X.L,13)) xor (ISHR0(X.L,13) or ISHL(X.H,3)) xor ISHR(X.H,6);
436 end;
437
438
439 {$else}
440
441
442 (**** TP 6/7/Delphi1 for 386+ *****)
443
444
445 {---------------------------------------------------------------------------}
RBnull446 function RB(A: longint): longint;
447 {-reverse byte order in longint}
448 inline(
449 $58/ {pop ax }
450 $5A/ {pop dx }
451 $86/$C6/ {xchg dh,al}
452 $86/$E2); {xchg dl,ah}
453
454
455 {---------------------------------------------------------------------------}
456 procedure Add64(var Z: TW64; {$ifdef CONST} const {$else} var {$endif} X,Y: TW64);
457 {-Add two 64 bit integers}
458 inline(
459 $8C/$D9/ {mov cx,ds }
460 $5B/ {pop bx }
461 $1F/ {pop ds }
462 $66/$8B/$07/ {mov eax,[bx] }
463 $66/$8B/$57/$04/ {mov edx,[bx+04]}
464 $5B/ {pop bx }
465 $1F/ {pop ds }
466 $66/$03/$07/ {add eax,[bx] }
467 $66/$13/$57/$04/ {adc edx,[bx+04]}
468 $5B/ {pop bx }
469 $1F/ {pop ds }
470 $66/$89/$07/ {mov [bx],eax }
471 $66/$89/$57/$04/ {mov [bx+04],edx}
472 $8E/$D9); {mov ds,cx }
473
474
475 {---------------------------------------------------------------------------}
476 procedure Inc64(var Z: TW64; {$ifdef CONST} const {$else} var {$endif} X: TW64);
477 {-Inc a 64 bit integer}
478 inline(
479
480 (*
481 {slower on Pentium 4}
482 $8C/$D9/ {mov cx,ds }
483 $5B/ {pop bx }
484 $1F/ {pop ds }
485 $66/$8B/$07/ {mov eax,[bx] }
486 $66/$8B/$57/$04/ {mov edx,[bx+04]}
487 $5B/ {pop bx }
488 $1F/ {pop ds }
489 $66/$01/$07/ {add [bx],eax }
490 $66/$11/$57/$04/ {adc [bx+04],edx}
491 $8E/$D9); {mov ds,cx }
492 *)
493 $8C/$D9/ {mov cx,ds }
494 $5B/ {pop bx }
495 $1F/ {pop ds }
496 $66/$8B/$07/ {mov eax,[bx] }
497 $66/$8B/$57/$04/ {mov edx,[bx+04]}
498 $5B/ {pop bx }
499 $1F/ {pop ds }
500 $66/$03/$07/ {add eax,[bx] }
501 $66/$13/$57/$04/ {adc edx,[bx+04]}
502 $66/$89/$07/ {mov [bx],eax }
503 $66/$89/$57/$04/ {mov [bx+04],edx}
504 $8E/$D9); {mov ds,cx }
505
506
507 {--------------------------------------------------------------------------}
508 procedure Sum0({$ifdef CONST} const {$else} var {$endif} X: TW64; var R: TW64); assembler;
509 {-Big-Sigma-0 function, 'preproccessed' for shift counts > 31}
510 asm
511 { R.L := ((X.L shr 28) or (X.H shl 4)) xor ((X.H shr 2) or (X.L shl 30)) xor ((X.H shr 7) or (X.L shl 25));
512 R.H := ((X.H shr 28) or (X.L shl 4)) xor ((X.L shr 2) or (X.H shl 30)) xor ((X.L shr 7) or (X.H shl 25));}
513 les bx,[X]
514 db $66; mov si,es:[bx] {X.L}
515 db $66; mov di,es:[bx+4] {X.H}
516
517 db $66; mov ax,si {(X.L shr 28) or (X.H shl 4)}
518 db $66; mov dx,di
519 db $66; shr ax,28
520 db $66; shl dx,4
521 db $66; or ax,dx
522 db $66; mov cx,ax
523
524 db $66; mov ax,di {(X.H shr 2) or (X.L shl 30)}
525 db $66; mov dx,si
526 db $66; shr ax,2
527 db $66; shl dx,30
528 db $66; or ax,dx
529 db $66; xor cx,ax
530
531 db $66; mov ax,di {(X.H shr 7) or (X.L shl 25)}
532 db $66; mov dx,si
533 db $66; shr ax,7
534 db $66; shl dx,25
535 db $66; or ax,dx
536 db $66; xor ax,cx
537
538 les bx,[R]
539 db $66; mov es:[bx],ax
540
541 db $66; mov ax,di {(X.H shr 28) or (X.L shl 4)}
542 db $66; mov dx,si
543 db $66; shr ax,28
544 db $66; shl dx,4
545 db $66; or ax,dx
546 db $66; mov cx,ax
547
548 db $66; mov ax,si {(X.L shr 2) or (X.H shl 30)}
549 db $66; mov dx,di
550 db $66; shr ax,2
551 db $66; shl dx,30
552 db $66; or ax,dx
553 db $66; xor cx,ax
554
555 db $66; mov ax,si {(X.L shr 7) or (X.H shl 25)}
556 db $66; mov dx,di
557 db $66; shr ax,7
558 db $66; shl dx,25
559 db $66; or ax,dx
560 db $66; xor ax,cx
561
562 db $66; mov es:[bx+4],ax
563 end;
564
565
566 {---------------------------------------------------------------------------}
567 procedure Sum1({$ifdef CONST} const {$else} var {$endif} X: TW64; var R: TW64); assembler;
568 {-Big-Sigma-1 function, 'preproccessed' for shift counts > 31}
569 asm
570 { R.L := ((X.L shr 14) or (X.H shl 18)) xor ((X.L shr 18) or (X.H shl 14)) xor ((X.H shr 9) or (X.L shl 23));
571 R.H := ((X.H shr 14) or (X.L shl 18)) xor ((X.H shr 18) or (X.L shl 14)) xor ((X.L shr 9) or (X.H shl 23));}
572 les bx,[X]
573 db $66; mov si,es:[bx] {X.L}
574 db $66; mov di,es:[bx+4] {X.H}
575
576 db $66; mov ax,si {(X.L shr 14) or (X.H shl 18)}
577 db $66; mov dx,di
578 db $66; shr ax,14
579 db $66; shl dx,18
580 db $66; or ax,dx
581 db $66; mov cx,ax
582
583 db $66; mov ax,si {(X.L shr 18) or (X.H shl 14)}
584 db $66; mov dx,di
585 db $66; shr ax,18
586 db $66; shl dx,14
587 db $66; or ax,dx
588 db $66; xor cx,ax
589
590 db $66; mov ax,di {(X.H shr 9) or (X.L shl 23)}
591 db $66; mov dx,si
592 db $66; shr ax,9
593 db $66; shl dx,23
594 db $66; or ax,dx
595 db $66; xor ax,cx
596
597 les bx,[R]
598 db $66; mov es:[bx],ax
599
600 db $66; mov ax,di {(X.H shr 14) or (X.L shl 18)}
601 db $66; mov dx,si
602 db $66; shr ax,14
603 db $66; shl dx,18
604 db $66; or ax,dx
605 db $66; mov cx,ax
606
607 db $66; mov ax,di {(X.H shr 18) or (X.L shl 14)}
608 db $66; mov dx,si
609 db $66; shr ax,18
610 db $66; shl dx,14
611 db $66; or ax,dx
612 db $66; xor cx,ax
613
614 db $66; mov ax,si {(X.L shr 9) or (X.H shl 23)}
615 db $66; mov dx,di
616 db $66; shr ax,9
617 db $66; shl dx,23
618 db $66; or ax,dx
619 db $66; xor ax,cx
620
621 db $66; mov es:[bx+4],ax
622 end;
623
624
625 {---------------------------------------------------------------------------}
626 procedure Sig0({$ifdef CONST} const {$else} var {$endif} X: TW64; var R: TW64); assembler;
627 {-Small-Sigma-0 function, 'preproccessed' for shift counts > 31}
628 asm
629 { R.L := ((X.L shr 1) or (X.H shl 31)) xor ((X.L shr 8) or (X.H shl 24)) xor ((X.L shr 7) or (X.H shl 25));
630 R.H := ((X.H shr 1) or (X.L shl 31)) xor ((X.H shr 8) or (X.L shl 24)) xor (X.H shr 7);}
631 les bx,[X]
632 db $66; mov si,es:[bx] {X.L}
633 db $66; mov di,es:[bx+4] {X.H}
634
635 db $66; mov ax,si {(X.L shr 1) or (X.H shl 31)}
636 db $66; mov dx,di
637 db $66; shr ax,1
638 db $66; shl dx,31
639 db $66; or ax,dx
640 db $66; mov cx,ax
641
642 db $66; mov ax,si {(X.L shr 8) or (X.H shl 24)}
643 db $66; mov dx,di
644 db $66; shr ax,8
645 db $66; shl dx,24
646 db $66; or ax,dx
647 db $66; xor cx,ax
648
649 db $66; mov ax,si {(X.L shr 7) or (X.H shl 25)}
650 db $66; mov dx,di
651 db $66; shr ax,7
652 db $66; shl dx,25
653 db $66; or ax,dx
654 db $66; xor ax,cx
655
656 les bx,[R]
657 db $66; mov es:[bx],ax
658
659 db $66; mov ax,di {(X.H shr 1) or (X.L shl 31)}
660 db $66; mov dx,si
661 db $66; shr ax,1
662 db $66; shl dx,31
663 db $66; or ax,dx
664 db $66; mov cx,ax
665
666 db $66; mov ax,di {(X.H shr 8) or (X.L shl 24)}
667 db $66; mov dx,si
668 db $66; shr ax,8
669 db $66; shl dx,24
670 db $66; or ax,dx
671 db $66; xor ax,cx
672
673 db $66; shr di,7 {(X.H shr 7)}
674 db $66; xor ax,di
675
676 db $66; mov es:[bx+4],ax
677 end;
678
679
680 {---------------------------------------------------------------------------}
681 procedure Sig1({$ifdef CONST} const {$else} var {$endif} X: TW64; var R: TW64); assembler;
682 {-Small-Sigma-1 function, 'preproccessed' for shift counts > 31}
683 asm
684 { R.L := ((X.L shr 19) or (X.H shl 13)) xor ((X.H shr 29) or (X.L shl 3)) xor ((X.L shr 6) or (X.H shl 26));
685 R.H := ((X.H shr 19) or (X.L shl 13)) xor ((X.L shr 29) or (X.H shl 3)) xor (X.H shr 6);}
686 les bx,[X]
687 db $66; mov si,es:[bx] {X.L}
688 db $66; mov di,es:[bx+4] {X.H}
689
690 db $66; mov ax,si {(X.L shr 19) or (X.H shl 13)}
691 db $66; mov dx,di
692 db $66; shr ax,19
693 db $66; shl dx,13
694 db $66; or ax,dx
695 db $66; mov cx,ax
696
697 db $66; mov ax,di {(X.H shr 29) or (X.L shl 3)}
698 db $66; mov dx,si
699 db $66; shr ax,29
700 db $66; shl dx,3
701 db $66; or ax,dx
702 db $66; xor cx,ax
703
704 db $66; mov ax,si {(X.L shr 6) or (X.H shl 26)}
705 db $66; mov dx,di
706 db $66; shr ax,6
707 db $66; shl dx,26
708 db $66; or ax,dx
709 db $66; xor ax,cx
710
711 les bx,[R]
712 db $66; mov es:[bx],ax
713
714 db $66; mov ax,di {(X.H shr 19) or (X.L shl 13)}
715 db $66; mov dx,si
716 db $66; shr ax,19
717 db $66; shl dx,13
718 db $66; or ax,dx
719 db $66; mov cx,ax
720
721 db $66; mov ax,si {(X.L shr 29) or (X.H shl 3)}
722 db $66; mov dx,di
723 db $66; shr ax,29
724 db $66; shl dx,3
725 db $66; or ax,dx
726 db $66; xor ax,cx
727
728 db $66; shr di,6 {(X.H shr 6)}
729 db $66; xor ax,di
730
731 db $66; mov es:[bx+4],ax
732 end;
733
734
735 {$endif BASM16}
736
737 {$endif BIT16}
738
739
740 {$ifdef UseInt64}
741
742 {---------------------------------------------------------------------------}
743 procedure SHA512Compress(var Data: THashContext);
744 {-Actual hashing function}
745 type
746 THash64 = array[0..7] of int64;
747 TBuf64 = array[0..79] of int64;
748 THLA64 = array[0..79] of TW64;
749 {$ifdef StrictLong}
750 {$warnings off}
751 {$R-} {avoid D9 errors!}
752 {$endif}
753
754 {Use the round constant construct from non-int64 because}
755 {Delphi 2 does not compile even though code is not used }
756 {and FPC does not know int64 constants }
757
758 const
759 KT: array[0..79] of TW64 = (
760 (L:$d728ae22; H:$428a2f98), (L:$23ef65cd; H:$71374491),
761 (L:$ec4d3b2f; H:$b5c0fbcf), (L:$8189dbbc; H:$e9b5dba5),
762 (L:$f348b538; H:$3956c25b), (L:$b605d019; H:$59f111f1),
763 (L:$af194f9b; H:$923f82a4), (L:$da6d8118; H:$ab1c5ed5),
764 (L:$a3030242; H:$d807aa98), (L:$45706fbe; H:$12835b01),
765 (L:$4ee4b28c; H:$243185be), (L:$d5ffb4e2; H:$550c7dc3),
766 (L:$f27b896f; H:$72be5d74), (L:$3b1696b1; H:$80deb1fe),
767 (L:$25c71235; H:$9bdc06a7), (L:$cf692694; H:$c19bf174),
768 (L:$9ef14ad2; H:$e49b69c1), (L:$384f25e3; H:$efbe4786),
769 (L:$8b8cd5b5; H:$0fc19dc6), (L:$77ac9c65; H:$240ca1cc),
770 (L:$592b0275; H:$2de92c6f), (L:$6ea6e483; H:$4a7484aa),
771 (L:$bd41fbd4; H:$5cb0a9dc), (L:$831153b5; H:$76f988da),
772 (L:$ee66dfab; H:$983e5152), (L:$2db43210; H:$a831c66d),
773 (L:$98fb213f; H:$b00327c8), (L:$beef0ee4; H:$bf597fc7),
774 (L:$3da88fc2; H:$c6e00bf3), (L:$930aa725; H:$d5a79147),
775 (L:$e003826f; H:$06ca6351), (L:$0a0e6e70; H:$14292967),
776 (L:$46d22ffc; H:$27b70a85), (L:$5c26c926; H:$2e1b2138),
777 (L:$5ac42aed; H:$4d2c6dfc), (L:$9d95b3df; H:$53380d13),
778 (L:$8baf63de; H:$650a7354), (L:$3c77b2a8; H:$766a0abb),
779 (L:$47edaee6; H:$81c2c92e), (L:$1482353b; H:$92722c85),
780 (L:$4cf10364; H:$a2bfe8a1), (L:$bc423001; H:$a81a664b),
781 (L:$d0f89791; H:$c24b8b70), (L:$0654be30; H:$c76c51a3),
782 (L:$d6ef5218; H:$d192e819), (L:$5565a910; H:$d6990624),
783 (L:$5771202a; H:$f40e3585), (L:$32bbd1b8; H:$106aa070),
784 (L:$b8d2d0c8; H:$19a4c116), (L:$5141ab53; H:$1e376c08),
785 (L:$df8eeb99; H:$2748774c), (L:$e19b48a8; H:$34b0bcb5),
786 (L:$c5c95a63; H:$391c0cb3), (L:$e3418acb; H:$4ed8aa4a),
787 (L:$7763e373; H:$5b9cca4f), (L:$d6b2b8a3; H:$682e6ff3),
788 (L:$5defb2fc; H:$748f82ee), (L:$43172f60; H:$78a5636f),
789 (L:$a1f0ab72; H:$84c87814), (L:$1a6439ec; H:$8cc70208),
790 (L:$23631e28; H:$90befffa), (L:$de82bde9; H:$a4506ceb),
791 (L:$b2c67915; H:$bef9a3f7), (L:$e372532b; H:$c67178f2),
792 (L:$ea26619c; H:$ca273ece), (L:$21c0c207; H:$d186b8c7),
793 (L:$cde0eb1e; H:$eada7dd6), (L:$ee6ed178; H:$f57d4f7f),
794 (L:$72176fba; H:$06f067aa), (L:$a2c898a6; H:$0a637dc5),
795 (L:$bef90dae; H:$113f9804), (L:$131c471b; H:$1b710b35),
796 (L:$23047d84; H:$28db77f5), (L:$40c72493; H:$32caab7b),
797 (L:$15c9bebc; H:$3c9ebe0a), (L:$9c100d4c; H:$431d67c4),
798 (L:$cb3e42b6; H:$4cc5d4be), (L:$fc657e2a; H:$597f299c),
799 (L:$3ad6faec; H:$5fcb6fab), (L:$4a475817; H:$6c44198c)
800 );
801 {$ifdef StrictLong}
802 {$warnings on}
803 {$ifdef RangeChecks_on}
804 {$R+}
805 {$endif}
806 {$endif}
807
808 var
809 i,j: integer;
810 t0,t1: int64;
811 A,B,C,D,E,F,G,H: int64;
812 W: TBuf64;
813 K: TBuf64 absolute KT;
814 begin
815 {Assign old working hash to variables a..h}
816 A := THash64(Data.Hash)[0];
817 B := THash64(Data.Hash)[1];
818 C := THash64(Data.Hash)[2];
819 D := THash64(Data.Hash)[3];
820 E := THash64(Data.Hash)[4];
821 F := THash64(Data.Hash)[5];
822 G := THash64(Data.Hash)[6];
823 H := THash64(Data.Hash)[7];
824
825 {Message schedule}
826 {Part 1: Transfer buffer with little -> big endian conversion}
827 j := 0;
828 for i:=0 to 15 do begin
829 {Old shl 32 version was buggy, use helper record}
830 THLA64(W)[i].H := RB(THashBuf32(Data.Buffer)[j]);
831 THLA64(W)[i].L := RB(THashBuf32(Data.Buffer)[j+1]);
832 inc(j,2);
833 end;
834
835 {Part 2: Calculate remaining "expanded message blocks"}
836 for i:=16 to 79 do begin
837 W[i] := (((W[i-2] shr 19) or (W[i-2] shl 45)) xor ((W[i-2] shr 61) or (W[i-2] shl 3)) xor (W[i-2] shr 6))
838 + W[i-7]
839 + (((W[i-15] shr 1) or (W[i-15] shl 63)) xor ((W[i-15] shr 8) or (W[i-15] shl 56)) xor (W[i-15] shr 7))
840 + W[i-16];
841 end;
842
843 {SHA512 compression function, partial unroll}
844 {line length must be < 128 for 16bit compilers even if code is not used}
845
846 i := 0;
847 while i<79 do begin
848 t0:=H+((E shr 14 or E shl 50)xor(E shr 18 or E shl 46)xor(E shr 41 or E shl 23))+((E and (F xor G)) xor G)+K[i ]+W[i ];
849 t1:=((A shr 28 or A shl 36)xor(A shr 34 or A shl 30)xor(A shr 39 or A shl 25))+((A or B) and C or A and B);
850 D :=D+t0;
851 H :=t0+t1;
852 t0:=G+((D shr 14 or D shl 50)xor(D shr 18 or D shl 46)xor(D shr 41 or D shl 23))+((D and (E xor F)) xor F)+K[i+1]+W[i+1];
853 t1:=((H shr 28 or H shl 36)xor(H shr 34 or H shl 30)xor(H shr 39 or H shl 25))+((H or A) and B or H and A);
854 C :=C+t0;
855 G :=t0+t1;
856 t0:=F+((C shr 14 or C shl 50)xor(C shr 18 or C shl 46)xor(C shr 41 or C shl 23))+((C and (D xor E)) xor E)+K[i+2]+W[i+2];
857 t1:=((G shr 28 or G shl 36)xor(G shr 34 or G shl 30)xor(G shr 39 or G shl 25))+((G or H) and A or G and H);
858 B :=B+t0;
859 F :=t0+t1;
860 t0:=E+((B shr 14 or B shl 50)xor(B shr 18 or B shl 46)xor(B shr 41 or B shl 23))+((B and (C xor D)) xor D)+K[i+3]+W[i+3];
861 t1:=((F shr 28 or F shl 36)xor(F shr 34 or F shl 30)xor(F shr 39 or F shl 25))+((F or G) and H or F and G);
862 A :=A+t0;
863 E :=t0+t1;
864 t0:=D+((A shr 14 or A shl 50)xor(A shr 18 or A shl 46)xor(A shr 41 or A shl 23))+((A and (B xor C)) xor C)+K[i+4]+W[i+4];
865 t1:=((E shr 28 or E shl 36)xor(E shr 34 or E shl 30)xor(E shr 39 or E shl 25))+((E or F) and G or E and F);
866 H :=H+t0;
867 D :=t0+t1;
868 t0:=C+((H shr 14 or H shl 50)xor(H shr 18 or H shl 46)xor(H shr 41 or H shl 23))+((H and (A xor B)) xor B)+K[i+5]+W[i+5];
869 t1:=((D shr 28 or D shl 36)xor(D shr 34 or D shl 30)xor(D shr 39 or D shl 25))+((D or E) and F or D and E);
870 G :=G+t0;
871 C :=t0+t1;
872 t0:=B+((G shr 14 or G shl 50)xor(G shr 18 or G shl 46)xor(G shr 41 or G shl 23))+((G and (H xor A)) xor A)+K[i+6]+W[i+6];
873 t1:=((C shr 28 or C shl 36)xor(C shr 34 or C shl 30)xor(C shr 39 or C shl 25))+((C or D) and E or C and D);
874 F :=F+t0;
875 B :=t0+t1;
876 t0:=A+((F shr 14 or F shl 50)xor(F shr 18 or F shl 46)xor(F shr 41 or F shl 23))+((F and (G xor H)) xor H)+K[i+7]+W[i+7];
877 t1:=((B shr 28 or B shl 36)xor(B shr 34 or B shl 30)xor(B shr 39 or B shl 25))+((B or C) and D or B and C);
878 E :=E+t0;
879 A :=t0+t1;
880 inc(i,8);
881 end;
882
883 {Calculate new working hash}
884 inc(THash64(Data.Hash)[0], A);
885 inc(THash64(Data.Hash)[1], B);
886 inc(THash64(Data.Hash)[2], C);
887 inc(THash64(Data.Hash)[3], D);
888 inc(THash64(Data.Hash)[4], E);
889 inc(THash64(Data.Hash)[5], F);
890 inc(THash64(Data.Hash)[6], G);
891 inc(THash64(Data.Hash)[7], H);
892 end;
893
894
895 {---------------------------------------------------------------------------}
896 procedure UpdateLen(var Context: THashContext; Len: longint; IsByteLen: boolean);
897 {-Update 128 bit message bit length, Len = byte length if IsByteLen}
898 var
899 t0,t1: TW64;
900 i: integer;
901 begin
902 if IsByteLen then int64(t0) := 8*int64(Len)
903 else int64(t0) := int64(Len);
904 t1.L := Context.MLen[0];
905 t1.H := 0;
906 Inc(int64(t0),int64(t1));
907 Context.MLen[0] := t0.L;
908 for i:=1 to 3 do begin
909 if t0.H=0 then exit;
910 t1.L := Context.MLen[i];
911 t0.L := t0.H;
912 t0.H := 0;
913 Inc(int64(t0),int64(t1));
914 Context.MLen[i] := t0.L;
915 end;
916 end;
917
918
919 {$else}
920
921 {---------------------------------------------------------------------------}
922 procedure SHA512Compress(var Data: THashContext);
923 {-Actual hashing function}
924 type
925 THash64 = array[0..7] of TW64;
926 TBuf64 = array[0..79] of TW64;
927 var
928 i,j: integer;
929 t,t0,t1: TW64;
930 S: THash64;
931 W: TBuf64;
932 const
933 {$ifdef StrictLong}
934 {$warnings off}
935 {$R-} {avoid D9 errors!}
936 {$endif}
937 K: array[0..79] of TW64 = (
938 (L:$d728ae22; H:$428a2f98), (L:$23ef65cd; H:$71374491),
939 (L:$ec4d3b2f; H:$b5c0fbcf), (L:$8189dbbc; H:$e9b5dba5),
940 (L:$f348b538; H:$3956c25b), (L:$b605d019; H:$59f111f1),
941 (L:$af194f9b; H:$923f82a4), (L:$da6d8118; H:$ab1c5ed5),
942 (L:$a3030242; H:$d807aa98), (L:$45706fbe; H:$12835b01),
943 (L:$4ee4b28c; H:$243185be), (L:$d5ffb4e2; H:$550c7dc3),
944 (L:$f27b896f; H:$72be5d74), (L:$3b1696b1; H:$80deb1fe),
945 (L:$25c71235; H:$9bdc06a7), (L:$cf692694; H:$c19bf174),
946 (L:$9ef14ad2; H:$e49b69c1), (L:$384f25e3; H:$efbe4786),
947 (L:$8b8cd5b5; H:$0fc19dc6), (L:$77ac9c65; H:$240ca1cc),
948 (L:$592b0275; H:$2de92c6f), (L:$6ea6e483; H:$4a7484aa),
949 (L:$bd41fbd4; H:$5cb0a9dc), (L:$831153b5; H:$76f988da),
950 (L:$ee66dfab; H:$983e5152), (L:$2db43210; H:$a831c66d),
951 (L:$98fb213f; H:$b00327c8), (L:$beef0ee4; H:$bf597fc7),
952 (L:$3da88fc2; H:$c6e00bf3), (L:$930aa725; H:$d5a79147),
953 (L:$e003826f; H:$06ca6351), (L:$0a0e6e70; H:$14292967),
954 (L:$46d22ffc; H:$27b70a85), (L:$5c26c926; H:$2e1b2138),
955 (L:$5ac42aed; H:$4d2c6dfc), (L:$9d95b3df; H:$53380d13),
956 (L:$8baf63de; H:$650a7354), (L:$3c77b2a8; H:$766a0abb),
957 (L:$47edaee6; H:$81c2c92e), (L:$1482353b; H:$92722c85),
958 (L:$4cf10364; H:$a2bfe8a1), (L:$bc423001; H:$a81a664b),
959 (L:$d0f89791; H:$c24b8b70), (L:$0654be30; H:$c76c51a3),
960 (L:$d6ef5218; H:$d192e819), (L:$5565a910; H:$d6990624),
961 (L:$5771202a; H:$f40e3585), (L:$32bbd1b8; H:$106aa070),
962 (L:$b8d2d0c8; H:$19a4c116), (L:$5141ab53; H:$1e376c08),
963 (L:$df8eeb99; H:$2748774c), (L:$e19b48a8; H:$34b0bcb5),
964 (L:$c5c95a63; H:$391c0cb3), (L:$e3418acb; H:$4ed8aa4a),
965 (L:$7763e373; H:$5b9cca4f), (L:$d6b2b8a3; H:$682e6ff3),
966 (L:$5defb2fc; H:$748f82ee), (L:$43172f60; H:$78a5636f),
967 (L:$a1f0ab72; H:$84c87814), (L:$1a6439ec; H:$8cc70208),
968 (L:$23631e28; H:$90befffa), (L:$de82bde9; H:$a4506ceb),
969 (L:$b2c67915; H:$bef9a3f7), (L:$e372532b; H:$c67178f2),
970 (L:$ea26619c; H:$ca273ece), (L:$21c0c207; H:$d186b8c7),
971 (L:$cde0eb1e; H:$eada7dd6), (L:$ee6ed178; H:$f57d4f7f),
972 (L:$72176fba; H:$06f067aa), (L:$a2c898a6; H:$0a637dc5),
973 (L:$bef90dae; H:$113f9804), (L:$131c471b; H:$1b710b35),
974 (L:$23047d84; H:$28db77f5), (L:$40c72493; H:$32caab7b),
975 (L:$15c9bebc; H:$3c9ebe0a), (L:$9c100d4c; H:$431d67c4),
976 (L:$cb3e42b6; H:$4cc5d4be), (L:$fc657e2a; H:$597f299c),
977 (L:$3ad6faec; H:$5fcb6fab), (L:$4a475817; H:$6c44198c)
978 );
979 {$ifdef StrictLong}
980 {$warnings on}
981 {$ifdef RangeChecks_on}
982 {$R+}
983 {$endif}
984 {$endif}
985 begin
986
987 {Assign old working hash to variables a..h=S[0]..S[7]}
988 S := THash64(Data.Hash);
989
990 {Message schedule}
991 {Part 1: Transfer buffer with little -> big endian conversion}
992 j := 0;
993 for i:=0 to 15 do begin
994 W[i].H:= RB(THashBuf32(Data.Buffer)[j]);
995 W[i].L:= RB(THashBuf32(Data.Buffer)[j+1]);
996 inc(j,2);
997 end;
998
999 {Part 2: Calculate remaining "expanded message blocks"}
1000 for i:=16 to 79 do begin
1001 {W[i]:= Sig1(W[i-2]) + W[i-7] + Sig0(W[i-15]) + W[i-16];}
1002 {$ifndef BIT16}
1003 t.L := W[i-2].L;
1004 t.H := W[i-2].H;
1005 t0.L := ((t.L shr 19) or (t.H shl 13)) xor ((t.H shr 29) or (t.L shl 3)) xor ((t.L shr 6) or (t.H shl 26));
1006 t0.H := ((t.H shr 19) or (t.L shl 13)) xor ((t.L shr 29) or (t.H shl 3)) xor (t.H shr 6);
1007 Inc64(t0,W[i-7]);
1008 t.L := W[i-15].L;
1009 t.H := W[i-15].H;
1010 t1.L := ((t.L shr 1) or (t.H shl 31)) xor ((t.L shr 8) or (t.H shl 24)) xor ((t.L shr 7) or (t.H shl 25));
1011 t1.H := ((t.H shr 1) or (t.L shl 31)) xor ((t.H shr 8) or (t.L shl 24)) xor (t.H shr 7);
1012 Inc64(t0,t1);
1013 Add64(W[i], W[i-16], t0);
1014 {$else}
1015 Sig1(W[i-2], t0);
1016 Inc64(t0,W[i-7]);
1017 Sig0(W[i-15], t);
1018 Inc64(t0,t);
1019 Add64(W[i], W[i-16], t0);
1020 {$endif}
1021 end;
1022
1023 {SHA512 compression function}
1024 for i:=0 to 79 do begin
1025 {t0:= S[7] + Sum1(S[4]) + Ch(S[4],S[5],S[6]) + K[i] + W[i];}
1026 {$ifndef BIT16}
1027 t0.L := (S[4].L shr 14 or S[4].H shl 18) xor (S[4].L shr 18 or S[4].H shl 14) xor (S[4].H shr 9 or S[4].L shl 23);
1028 t0.H := (S[4].H shr 14 or S[4].L shl 18) xor (S[4].H shr 18 or S[4].L shl 14) xor (S[4].L shr 9 or S[4].H shl 23);
1029 {$else}
1030 Sum1(S[4],t0);
1031 {$endif}
1032 Inc64(t0, S[7]);
1033 t.L := ((S[5].L xor S[6].L) and S[4].L) xor S[6].L;
1034 t.H := ((S[5].H xor S[6].H) and S[4].H) xor S[6].H;
1035 Inc64(t0, t);
1036 Inc64(t0, K[i]);
1037 Inc64(t0, W[i]);
1038
1039 {t1:= Sum0(S[0]) + Maj(S[0],S[1],S[2]));}
1040 {$ifndef BIT16}
1041 t1.L := (S[0].L shr 28 or S[0].H shl 4) xor (S[0].H shr 2 or S[0].L shl 30) xor (S[0].H shr 7 or S[0].L shl 25);
1042 t1.H := (S[0].H shr 28 or S[0].L shl 4) xor (S[0].L shr 2 or S[0].H shl 30) xor (S[0].L shr 7 or S[0].H shl 25);
1043 {$else}
1044 Sum0(S[0],t1);
1045 {$endif}
1046 t.L := ((S[0].L or S[1].L) and S[2].L) or (S[0].L and S[1].L);
1047 t.h := ((S[0].H or S[1].H) and S[2].H) or (S[0].H and S[1].H);
1048
1049 Inc64(t1, t);
1050 S[7].L := S[6].L;
1051 S[7].H := S[6].H;
1052 S[6].L := S[5].L;
1053 S[6].H := S[5].H;
1054 S[5].H := S[4].H;
1055 S[5].L := S[4].L;
1056 Add64(S[4],t0, S[3]);
1057 S[3].L := S[2].L;
1058 S[3].H := S[2].H;
1059 S[2].L := S[1].L;
1060 S[2].H := S[1].H;
1061 S[1].L := S[0].L;
1062 S[1].H := S[0].H;
1063 Add64(S[0],t0,t1);
1064 end;
1065 {Calculate new working hash}
1066 for i:=0 to 7 do Inc64(THash64(Data.Hash)[i], S[i]);
1067 end;
1068
1069
1070 {---------------------------------------------------------------------------}
1071 procedure UpdateLen(var Context: THashContext; Len: longint; IsByteLen: boolean);
1072 {-Update 128 bit message bit length, Len = byte length if IsByteLen}
1073 var
1074 t0,t1: TW64;
1075 i: integer;
1076 begin
1077 if IsByteLen then begin
1078 {Calculate bit length increment = 8*Len}
1079 if Len<=$0FFFFFFF then begin
1080 {safe to multiply without overflow}
1081 t0.L := 8*Len;
1082 t0.H := 0;
1083 end
1084 else begin
1085 t0.L := Len;
1086 t0.H := 0;
1087 Inc64(t0,t0);
1088 Inc64(t0,t0);
1089 Inc64(t0,t0);
1090 end;
1091 end
1092 else begin
1093 t0.L := Len;
1094 t0.H := 0;
1095 end;
1096 {Update 128 bit length}
1097 t1.L := Context.MLen[0];
1098 t1.H := 0;
1099 Inc64(t0,t1);
1100 Context.MLen[0] := t0.L;
1101 for i:=1 to 3 do begin
1102 {propagate carry into higher bits}
1103 if t0.H=0 then exit;
1104 t1.L := Context.MLen[i];
1105 t0.L := t0.H;
1106 t0.H := 0;
1107 Inc64(t0,t1);
1108 Context.MLen[i] := t0.L;
1109 end;
1110 end;
1111
1112 {$endif}
1113
1114
1115 {---------------------------------------------------------------------------}
1116 procedure SHA512Init(var Context: THashContext);
1117 {-initialize context}
1118 {$ifdef StrictLong}
1119 {$warnings off}
1120 {$R-} {avoid D9 errors!}
1121 {$endif}
1122 const
1123 SIV: THashState = ($f3bcc908, $6a09e667, $84caa73b, $bb67ae85,
1124 $fe94f82b, $3c6ef372, $5f1d36f1, $a54ff53a,
1125 $ade682d1, $510e527f, $2b3e6c1f, $9b05688c,
1126 $fb41bd6b, $1f83d9ab, $137e2179, $5be0cd19);
1127 {$ifdef StrictLong}
1128 {$warnings on}
1129 {$ifdef RangeChecks_on}
1130 {$R+}
1131 {$endif}
1132 {$endif}
1133 begin
1134 {Clear context, buffer=0!!}
1135 fillchar(Context,sizeof(Context),0);
1136 Context.Hash := SIV;
1137 end;
1138
1139
1140 {---------------------------------------------------------------------------}
1141 procedure SHA512UpdateXL(var Context: THashContext; Msg: pointer; Len: longint);
1142 {-update context with Msg data}
1143 begin
1144 {Update message bit length}
1145 UpdateLen(Context, Len, true);
1146
1147 while Len > 0 do begin
1148 {fill block with msg data}
1149 Context.Buffer[Context.Index]:= pByte(Msg)^;
1150 inc(Ptr2Inc(Msg));
1151 inc(Context.Index);
1152 dec(Len);
1153 if Context.Index=SHA512_BlockLen then begin
1154 {If 512 bit transferred, compress a block}
1155 Context.Index:= 0;
1156 SHA512Compress(Context);
1157 while Len>=SHA512_BlockLen do begin
1158 move(Msg^,Context.Buffer,SHA512_BlockLen);
1159 SHA512Compress(Context);
1160 inc(Ptr2Inc(Msg),SHA512_BlockLen);
1161 dec(Len,SHA512_BlockLen);
1162 end;
1163 end;
1164 end;
1165 end;
1166
1167
1168 {---------------------------------------------------------------------------}
1169 procedure SHA512Update(var Context: THashContext; Msg: pointer; Len: word);
1170 {-update context with Msg data}
1171 begin
1172 SHA512UpdateXL(Context, Msg, Len);
1173 end;
1174
1175
1176 {---------------------------------------------------------------------------}
1177 procedure SHA512FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer);
1178 {-finalize SHA512 calculation with bitlen bits from BData (big-endian), clear context}
1179 var
1180 i: integer;
1181 begin
1182 {Message padding}
1183 {append bits from BData and a single '1' bit}
1184 if (bitlen>0) and (bitlen<=7) then begin
1185 Context.Buffer[Context.Index]:= (BData and BitAPI_Mask[bitlen]) or BitAPI_PBit[bitlen];
1186 UpdateLen(Context, bitlen, false);
1187 end
1188 else Context.Buffer[Context.Index]:= $80;
1189
1190 for i:=Context.Index+1 to 127 do Context.Buffer[i] := 0;
1191 {2. Compress if more than 448 bits, (no room for 64 bit length}
1192 if Context.Index>= 112 then begin
1193 SHA512Compress(Context);
1194 fillchar(Context.Buffer,sizeof(Context.Buffer),0);
1195 end;
1196 {Write 128 bit msg length into the last bits of the last block}
1197 {(in big endian format) and do a final compress}
1198 THashBuf32(Context.Buffer)[28]:= RB(Context.MLen[3]);
1199 THashBuf32(Context.Buffer)[29]:= RB(Context.MLen[2]);
1200 THashBuf32(Context.Buffer)[30]:= RB(Context.MLen[1]);
1201 THashBuf32(Context.Buffer)[31]:= RB(Context.MLen[0]);
1202 SHA512Compress(Context);
1203 {Hash -> Digest to little endian format}
1204 for i:=0 to 15 do THashDig32(Digest)[i]:= RB(Context.Hash[i xor 1]);
1205 {Clear context}
1206 fillchar(Context,sizeof(Context),0);
1207 end;
1208
1209
1210 {---------------------------------------------------------------------------}
1211 procedure SHA512FinalBits(var Context: THashContext; var Digest: TSHA512Digest; BData: byte; bitlen: integer);
1212 {-finalize SHA512 calculation with bitlen bits from BData (big-endian), clear context}
1213 var
1214 tmp: THashDigest;
1215 begin
1216 SHA512FinalBitsEx(Context, tmp, BData, bitlen);
1217 move(tmp, Digest, sizeof(Digest));
1218 end;
1219
1220
1221 {---------------------------------------------------------------------------}
1222 procedure SHA512FinalEx(var Context: THashContext; var Digest: THashDigest);
1223 {-finalize SHA512 calculation, clear context}
1224 begin
1225 SHA512FinalBitsEx(Context,Digest,0,0);
1226 end;
1227
1228
1229 {---------------------------------------------------------------------------}
1230 procedure SHA512Final(var Context: THashContext; var Digest: TSHA512Digest);
1231 {-finalize SHA512 calculation, clear context}
1232 var
1233 tmp: THashDigest;
1234 begin
1235 SHA512FinalBitsEx(Context, tmp, 0, 0);
1236 move(tmp,Digest,sizeof(Digest));
1237 end;
1238
1239
1240 {---------------------------------------------------------------------------}
SHA512SelfTestnull1241 function SHA512SelfTest: boolean;
1242 {-self test for string from SHA512 document}
1243 const
1244 s1: string[3] = 'abc';
1245 s2: string[112] = 'abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn'
1246 +'hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu';
1247
1248 D1: TSHA512Digest = ($dd, $af, $35, $a1, $93, $61, $7a, $ba,
1249 $cc, $41, $73, $49, $ae, $20, $41, $31,
1250 $12, $e6, $fa, $4e, $89, $a9, $7e, $a2,
1251 $0a, $9e, $ee, $e6, $4b, $55, $d3, $9a,
1252 $21, $92, $99, $2a, $27, $4f, $c1, $a8,
1253 $36, $ba, $3c, $23, $a3, $fe, $eb, $bd,
1254 $45, $4d, $44, $23, $64, $3c, $e8, $0e,
1255 $2a, $9a, $c9, $4f, $a5, $4c, $a4, $9f );
1256
1257 D2: TSHA512Digest = ($8e, $95, $9b, $75, $da, $e3, $13, $da,
1258 $8c, $f4, $f7, $28, $14, $fc, $14, $3f,
1259 $8f, $77, $79, $c6, $eb, $9f, $7f, $a1,
1260 $72, $99, $ae, $ad, $b6, $88, $90, $18,
1261 $50, $1d, $28, $9e, $49, $00, $f7, $e4,
1262 $33, $1b, $99, $de, $c4, $b5, $43, $3a,
1263 $c7, $d3, $29, $ee, $b6, $dd, $26, $54,
1264 $5e, $96, $e5, $5b, $87, $4b, $e9, $09 );
1265
1266 D3: TSHA512Digest = ($b4, $59, $4e, $b1, $29, $59, $fc, $2e,
1267 $69, $79, $b6, $78, $35, $54, $29, $9c,
1268 $c0, $36, $9f, $44, $08, $3a, $8b, $09,
1269 $55, $ba, $ef, $d8, $83, $0c, $da, $22,
1270 $89, $4b, $0b, $46, $c0, $ed, $49, $49,
1271 $0e, $39, $1a, $d9, $9a, $f8, $56, $cc,
1272 $1b, $d9, $6f, $23, $8c, $7f, $2a, $17,
1273 $cf, $37, $ae, $b7, $e7, $93, $39, $5a);
1274
1275 D4: TSHA512Digest = ($46, $4a, $e5, $27, $7a, $3d, $9e, $35,
1276 $14, $46, $90, $ac, $ef, $57, $18, $f2,
1277 $17, $e3, $28, $56, $27, $26, $20, $8f,
1278 $b1, $53, $bd, $31, $64, $1a, $fa, $9e,
1279 $ab, $d6, $44, $90, $8d, $18, $b1, $86,
1280 $68, $20, $ed, $a6, $14, $2e, $98, $37,
1281 $2e, $ca, $db, $bd, $15, $53, $51, $c9,
1282 $af, $c1, $8b, $17, $8f, $58, $4b, $82);
1283 var
1284 Context: THashContext;
1285 Digest : TSHA512Digest;
1286
SingleTestnull1287 function SingleTest(s: Str127; TDig: TSHA512Digest): boolean;
1288 {-do a single test, const not allowed for VER<7}
1289 { Two sub tests: 1. whole string, 2. one update per char}
1290 var
1291 i: integer;
1292 begin
1293 SingleTest := false;
1294 {1. Hash complete string}
1295 SHA512Full(Digest, @s[1],length(s));
1296 {Compare with known value}
1297 if not HashSameDigest(@SHA512_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit;
1298 {2. one update call for all chars}
1299 SHA512Init(Context);
1300 for i:=1 to length(s) do SHA512Update(Context,@s[i],1);
1301 SHA512Final(Context,Digest);
1302 {Compare with known value}
1303 if not HashSameDigest(@SHA512_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit;
1304 SingleTest := true;
1305 end;
1306
1307 begin
1308 SHA512SelfTest := false;
1309 {1 Zero bit from NESSIE test vectors}
1310 SHA512Init(Context);
1311 SHA512FinalBits(Context,Digest,0,1);
1312 if not HashSameDigest(@SHA512_Desc, PHashDigest(@Digest), PHashDigest(@D3)) then exit;
1313 {4 highest bits of $50, D4 calculated with program shatest from RFC 4634}
1314 SHA512Init(Context);
1315 SHA512FinalBits(Context,Digest,$50,4);
1316 if not HashSameDigest(@SHA512_Desc, PHashDigest(@Digest), PHashDigest(@D4)) then exit;
1317 {strings from SHA512 document}
1318 SHA512SelfTest := SingleTest(s1, D1) and SingleTest(s2, D2)
1319 end;
1320
1321
1322 {---------------------------------------------------------------------------}
1323 procedure SHA512FullXL(var Digest: TSHA512Digest; Msg: pointer; Len: longint);
1324 {-SHA512 of Msg with init/update/final}
1325 var
1326 Context: THashContext;
1327 begin
1328 SHA512Init(Context);
1329 SHA512UpdateXL(Context, Msg, Len);
1330 SHA512Final(Context, Digest);
1331 end;
1332
1333
1334 {---------------------------------------------------------------------------}
1335 procedure SHA512Full(var Digest: TSHA512Digest; Msg: pointer; Len: word);
1336 {-SHA512 of Msg with init/update/final}
1337 begin
1338 SHA512FullXL(Digest, Msg, Len);
1339 end;
1340
1341
1342 {---------------------------------------------------------------------------}
1343 procedure SHA512File({$ifdef CONST} const {$endif} fname: string;
1344 var Digest: TSHA512Digest; var buf; bsize: word; var Err: word);
1345 {-SHA512 of file, buf: buffer with at least bsize bytes}
1346 var
1347 tmp: THashDigest;
1348 begin
1349 HashFile(fname, @SHA512_Desc, tmp, buf, bsize, Err);
1350 move(tmp,Digest,sizeof(Digest));
1351 end;
1352
1353
1354 begin
1355 {$ifdef VER5X}
1356 fillchar(SHA512_Desc, sizeof(SHA512_Desc), 0);
1357 with SHA512_Desc do begin
1358 HSig := C_HashSig;
1359 HDSize := sizeof(THashDesc);
1360 HDVersion := C_HashVers;
1361 HBlockLen := SHA512_BlockLen;
1362 HDigestlen:= sizeof(TSHA512Digest);
1363 HInit := SHA512Init;
1364 HFinal := SHA512FinalEx;
1365 HUpdateXL := SHA512UpdateXL;
1366 HAlgNum := longint(_SHA512);
1367 HName := 'SHA512';
1368 HPtrOID := @SHA512_OID;
1369 HLenOID := 9;
1370 HFinalBit := SHA512FinalBitsEx;
1371 end;
1372 {$endif}
1373 RegisterHash(_SHA512, @SHA512_Desc);
1374 end.
1375