unit EM.sha256; // crc_hash_2018-01-01.zip 에서 sha256.pas 파일을 가져온 것이고, // 필요한 정의는 동일 경로에 있는btypes.pas, hash.pas에서 가져왔다. 18_0621 10:49:56 sunk {SHA256 - 256 bit Secure Hash Function} interface (************************************************************************* DESCRIPTION : SHA256 - 256 bit Secure Hash Function REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP EXTERNAL DATA : --- MEMORY USAGE : --- DISPLAY MODE : --- REFERENCES : - Latest specification of Secure Hash Standard: http://csrc.nist.gov/publications/fips/fips180-4/fips-180-4.pdf - Test vectors and intermediate values: http://csrc.nist.gov/groups/ST/toolkit/documents/Examples/SHA_All.pdf Version Date Author Modification ------- -------- ------- ------------------------------------------ 0.1 03.01.02 W.Ehrhardt Reference implementation 0.2 03.01.02 we BP7 optimization 0.21 03.01.02 we TP6 changes 0.3 03.01.02 we Delphi32 optimization 0.4 03.01.02 we with TW32Buf and assignment via RB in SHA256Compress 0.5 07.01.02 we Opt. Delphi UpdateLen 0.6 23.02.02 we Free Pascal compatibility 0.7 03.03.02 we VirtualPascal compatibility 0.71 03.03.02 we FPC with ASM (intel) 0.72 03.03.02 we TP55 compatibility 0.80 23.07.03 we With SHA256File, SHA256Full 0.81 26.07.03 we With SHA256Full in self test, D6+ - warnings 2.00 26.07.03 we common vers., longint for word32, D4+ - warnings 2.01 04.08.03 we type TSHA256Block for HMAC 2.10 29.08.03 we XL versions for Win32 2.20 27.09.03 we FPC/go32v2 2.30 05.10.03 we STD.INC, TP5.0 2.40 10.10.03 we common version, english comments 2.45 11.10.03 we Speedup: Inline for Maj(), Ch() 2.50 17.11.03 we Speedup in update, don't clear W in compress 2.51 20.11.03 we Full range UpdateLen 3.00 01.12.03 we Common version 3.0 3.01 22.12.03 we TP5/5.5: RB, FS inline 3.02 22.12.03 we TP5/5.5: FS -> FS1, FS2 3.03 22,12.03 we Changed UpdateLen: Definition and TP5/5.5 inline 3.04 22.12.03 we TP5/5.5: inline function ISHR 3.05 22.12.03 we ExpandMessageBlocks/BASM 3.06 24.12.03 we FIPS notation: S[] -> A..H, partial unroll 3.07 05.03.04 we Update fips180-2 URL 3.08 26.02.05 we With {$ifdef StrictLong} 3.09 05.05.05 we $R- for StrictLong, D9: errors if $R+ even if warnings off 3.10 17.12.05 we Force $I- in SHA256File 3.11 15.01.06 we uses Hash unit and THashDesc 3.12 15.01.06 we BugFix for 16 bit without BASM 3.13 18.01.06 we Descriptor fields HAlgNum, HSig 3.14 22.01.06 we Removed HSelfTest from descriptor 3.15 11.02.06 we Descriptor as typed const 3.16 07.08.06 we $ifdef BIT32: (const fname: shortstring...) 3.17 22.02.07 we values for OID vector 3.18 30.06.07 we Use conditional define FPC_ProcVar 3.19 04.10.07 we FPC: {$asmmode intel} 3.20 02.05.08 we Bit-API: SHA256FinalBits/Ex 3.21 05.05.08 we THashDesc constant with HFinalBit field 3.22 12.11.08 we Uses BTypes, Ptr2Inc and/or Str255/Str127 3.23 11.03.12 we Updated references 3.24 26.12.12 we D17 and PurePascal 3.25 16.08.15 we Removed $ifdef DLL / stdcall 3.26 15.05.17 we adjust OID to new MaxOIDLen 3.27 29.11.17 we SHA256File - fname: string **************************************************************************) (*------------------------------------------------------------------------- (C) Copyright 2002-2017 Wolfgang Ehrhardt This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: 1. The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. 2. Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. 3. This notice may not be removed or altered from any source distribution. ----------------------------------------------------------------------------*) {NOTE: FIPS Ch and May functions can be optimized. Wei Dai (Crypto++ 3.1) credits Rich Schroeppel (rcs@cs.arizona.edu), V 5.1 does not!?} {$i STD.INC} {$ifdef BIT64} {$ifndef PurePascal} {$define PurePascal} {$endif} {$endif} {$define UNROLL} {Speedup for all but TP5/5.5 and maybe VP} {$ifdef VER50} {$undef UNROLL} {Only VER50, VER55 uses UNROLL} {$endif} {$ifdef VirtualPascal} {$undef UNROLL} {$endif} //uses // BTypes,Hash; const MaxBlockLen = 128; {Max. block length (buffer size), multiple of 4} MaxDigestLen = 64; {Max. length of hash digest} MaxStateLen = 16; {Max. size of internal state} MaxOIDLen = 11; {Current max. OID length} C_HashSig = $3D7A; {Signature for Hash descriptor} C_HashVers = $00020002; {Version of Hash definitions} HASHCTXSIZE = 448; {Common size of enlarged padded old context} {and new padded SHA3/SHAKE/Keccak context } BitAPI_Mask: array[0..7] of byte = ($00,$80,$C0,$E0,$F0,$F8,$FC,$FE); BitAPI_PBit: array[0..7] of byte = ($80,$40,$20,$10,$08,$04,$02,$01); type Ptr2Inc = pByte; {Type cast to increment untyped pointer} Str127 = string[127]; THashState = packed array[0..MaxStateLen-1] of longint; {Internal state} THashBuffer = packed array[0..MaxBlockLen-1] of byte; {hash buffer block} THashDigest = packed array[0..MaxDigestLen-1] of byte; {hash digest} PHashDigest = ^THashDigest; {pointer to hash digest} THashBuf32 = packed array[0..MaxBlockLen div 4 -1] of longint; {type cast helper} THashDig32 = packed array[0..MaxDigestLen div 4 -1] of longint; {type cast helper} // 원래 이름은 THashContext이고, 범용적인 이름을 피하기 위해 변경 18_0621 10:52:19 sunk TKzHashContext = packed record Hash : THashState; {Working hash} MLen : packed array[0..3] of longint; {max 128 bit msg length} Buffer: THashBuffer; {Block buffer} Index : longint; {Index in buffer} Fill2 : packed array[213..HASHCTXSIZE] of byte; end; TSHA256Digest = packed array[0..31] of byte; {SHA256 digest } TOID_Vec = packed array[1..MaxOIDLen] of longint; {OID vector} POID_Vec = ^TOID_Vec; {ptr to OID vector} HashInitProc = procedure(var Context: TKzHashContext); {-initialize context} HashUpdateXLProc = procedure(var Context: TKzHashContext; Msg: pointer; Len: longint); {-update context with Msg data} HashFinalProc = procedure(var Context: TKzHashContext; var Digest: THashDigest); {-finalize calculation, clear context} HashFinalBitProc = procedure(var Context: TKzHashContext; var Digest: THashDigest; BData: byte; bitlen: integer); {-finalize calculation with bitlen bits from BData, clear context} THashName = string[19]; {Hash algo name type } PHashDesc = ^THashDesc; {Ptr to descriptor } THashDesc = packed record HSig : word; {Signature=C_HashSig } HDSize : word; {sizeof(THashDesc) } HDVersion : longint; {THashDesc Version } HBlockLen : word; {Blocklength of hash, rate div 8 for SHA3} HDigestlen: word; {Digestlength of hash} HInit : HashInitProc; {Init procedure } HFinal : HashFinalProc; {Final procedure } HUpdateXL : HashUpdateXLProc; {Update procedure } HAlgNum : longint; {Algo ID, longint avoids problems with enum size/DLL} HName : THashName; {Name of hash algo } HPtrOID : POID_Vec; {Pointer to OID vec } HLenOID : word; {Length of OID vec } HFill : word; HFinalBit : HashFinalBitProc; {Bit-API Final proc } HReserved : packed array[0..19] of byte; end; procedure SHA256Init(var Context: TKzHashContext); {-initialize context} procedure SHA256Update(var Context: TKzHashContext; Msg: pointer; Len: longint); {-update context with Msg data} procedure SHA256UpdateXL(var Context: TKzHashContext; Msg: pointer; Len: longint); {-update context with Msg data} procedure SHA256Final(var Context: TKzHashContext; var Digest: TSHA256Digest); {-finalize SHA256 calculation, clear context} procedure SHA256FinalEx(var Context: TKzHashContext; var Digest: THashDigest); {-finalize SHA256 calculation, clear context} procedure SHA256FinalBitsEx(var Context: TKzHashContext; var Digest: THashDigest; BData: byte; bitlen: integer); {-finalize SHA256 calculation with bitlen bits from BData (big-endian), clear context} procedure SHA256FinalBits(var Context: TKzHashContext; var Digest: TSHA256Digest; BData: byte; bitlen: integer); {-finalize SHA256 calculation with bitlen bits from BData (big-endian), clear context} function SHA256SelfTest: boolean; {-self test for string from SHA256 document} procedure SHA256Full(var Digest: TSHA256Digest; Msg: pointer; Len: word); {-SHA256 of Msg with init/update/final} procedure SHA256FullXL(var Digest: TSHA256Digest; Msg: pointer; Len: longint); {-SHA256 of Msg with init/update/final} procedure SHA256File({$ifdef CONST} const {$endif} fname: string; var Digest: TSHA256Digest; var buf; bsize: word; var Err: word); {-SHA256 of file, buf: buffer with at least bsize bytes} implementation {$ifdef BIT16} {$F-} {$endif} const SHA256_BlockLen = 64; {Internal types for type casting} type TWorkBuf = array[0..63] of longint; THashAlgorithm = (_MD4, _MD5, _RIPEMD160, _SHA1, _SHA224, _SHA256, _SHA384, _SHA512, _Whirlpool, _SHA512_224, _SHA512_256, _SHA3_224, _SHA3_256, _SHA3_384, _SHA3_512, _Blake2S_224, _Blake2S_256, _Blake2B_384, _Blake2B_512); {Supported hash algorithms} var PHashVec : array[THashAlgorithm] of PHashDesc; {Hash descriptor pointers of all defined hash algorithms} {2.16.840.1.101.3.4.2.1} {joint-iso-itu-t(2) country(16) us(840) organization(1) gov(101) csor(3) nistAlgorithm(4) hashAlgs(2) sha256(1)} const SHA256_OID : TOID_Vec = (2,16,840,1,101,3,4,2,1,-1,-1); {Len=9} {$ifndef VER5X} const SHA256_Desc: THashDesc = ( HSig : C_HashSig; HDSize : sizeof(THashDesc); HDVersion : C_HashVers; HBlockLen : SHA256_BlockLen; HDigestlen: sizeof(TSHA256Digest); {$ifdef FPC_ProcVar} HInit : @SHA256Init; HFinal : @SHA256FinalEx; HUpdateXL : @SHA256UpdateXL; {$else} HInit : SHA256Init; HFinal : SHA256FinalEx; HUpdateXL : SHA256UpdateXL; {$endif} HAlgNum : longint(_SHA256); HName : 'SHA256'; HPtrOID : @SHA256_OID; HLenOID : 9; HFill : 0; {$ifdef FPC_ProcVar} HFinalBit : @SHA256FinalBitsEx; {$else} HFinalBit : SHA256FinalBitsEx; {$endif} HReserved : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ); {$else} var SHA256_Desc: THashDesc; {$endif} function HashSameDigest(PHash: PHashDesc; PD1, PD2: PHashDigest): boolean; {-Return true if same digests, using HDigestlen of PHash} var i: integer; begin HashSameDigest := false; if PHash<>nil then with PHash^ do begin if (HSig=C_HashSig) and (HDigestlen>0) then begin for i:=0 to pred(HDigestlen) do begin if PD1^[i]<>PD2^[i] then exit; end; HashSameDigest := true; end; end; end; procedure HashFile({$ifdef CONST} const {$endif} fname: string; PHash: PHashDesc; var Digest: THashDigest; var buf; bsize: word; var Err: word); {-Calculate hash digest of file, buf: buffer with at least bsize bytes} var {$ifdef VirtualPascal} fms: word; {$else} fms: byte; {$endif} {$ifndef BIT16} L: longint; {$else} L: word; {$endif} var Context: TKzHashContext; f: file; begin if (PHash=nil) or (Phash^.HSig<>C_HashSig) then begin Err := 204; {Invalid pointer} exit; end; fms := FileMode; {$ifdef VirtualPascal} FileMode := $40; {open_access_ReadOnly or open_share_DenyNone;} {$else} FileMode := 0; {$endif} system.assign(f,{$ifdef D12Plus} string {$endif} (fname)); system.reset(f,1); Err := IOResult; FileMode := fms; if Err<>0 then exit; with PHash^ do begin HInit(Context); L := bsize; while (Err=0) and (L=bsize) do begin system.blockread(f,buf,bsize,L); Err := IOResult; HUpdateXL(Context, @buf, L); end; system.close(f); if IOResult=0 then {}; HFinal(Context, Digest); end; end; procedure RegisterHash(AlgId: THashAlgorithm; PHash: PHashDesc); {-Register algorithm with AlgID and Hash descriptor PHash^} begin if (PHash<>nil) and (PHash^.HAlgNum=longint(AlgId)) and (PHash^.HSig=C_HashSig) and (PHash^.HDVersion=C_HashVers) and (PHash^.HDSize=sizeof(THashDesc)) then PHashVec[AlgId] := PHash; end; {$ifndef BIT16} {$ifdef PurePascal} {---------------------------------------------------------------------------} procedure UpdateLen(var whi, wlo: longint; BLen: longint); {-Add BLen to 64 bit value (wlo, whi)} var tmp: int64; begin tmp := int64(cardinal(wlo))+Blen; wlo := longint(tmp and $FFFFFFFF); inc(whi,longint(tmp shr 32)); end; {---------------------------------------------------------------------------} function RB(A: longint): longint; {-reverse byte order in longint} begin 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); end; {$else} {---------------------------------------------------------------------------} function RB(A: longint): longint; assembler; {&frame-} {-reverse byte order in longint} asm {$ifdef LoadArgs} mov eax,[A] {$endif} xchg al,ah rol eax,16 xchg al,ah end; {---------------------------------------------------------------------------} procedure UpdateLen(var whi, wlo: longint; BLen: longint); {-Add BLen to 64 bit value (wlo, whi)} begin asm mov edx, wlo mov ecx, whi mov eax, Blen add [edx], eax adc dword ptr [ecx], 0 end; end; {---------------------------------------------------------------------------} function Sum0(x: longint): longint; assembler; {&frame-} {-Big sigma 0: RotRight(x,2) xor RotRight(x,13) xor RotRight(x,22)} asm {$ifdef LoadArgs} mov eax,[x] {$endif} mov ecx,eax mov edx,eax ror eax,2 ror edx,13 ror ecx,22 xor eax,edx xor eax,ecx end; {---------------------------------------------------------------------------} function Sum1(x: longint): longint; assembler; {&frame-} {-Big sigma 1: RotRight(x,6) xor RotRight(x,11) xor RotRight(x,25)} asm {$ifdef LoadArgs} mov eax,[x] {$endif} mov ecx,eax mov edx,eax ror eax,6 ror edx,11 ror ecx,25 xor eax,edx xor eax,ecx end; {$define USE_ExpandMessageBlocks} {---------------------------------------------------------------------------} procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuf32); {-Calculate "expanded message blocks"} begin asm push esi push edi push ebx mov esi,[W] mov edx,[Buf] {part 1: W[i]:= RB(TW32Buf(Buf)[i])} mov ecx,16 @@1: mov eax,[edx] xchg al,ah rol eax,16 xchg al,ah mov [esi],eax add esi,4 add edx,4 dec ecx jnz @@1 {part2: W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);} mov ecx,48 @@2: mov edi,[esi-7*4] {W[i-7]} mov eax,[esi-2*4] {W[i-2]} mov ebx,eax {Sig1: RR17 xor RR19 xor SRx,10} mov edx,eax ror eax,17 ror edx,19 shr ebx,10 xor eax,edx xor eax,ebx add edi,eax mov eax,[esi-15*4] {W[i-15]} mov ebx,eax {Sig0: RR7 xor RR18 xor SR3} mov edx,eax ror eax,7 ror edx,18 shr ebx,3 xor eax,edx xor eax,ebx add eax,edi add eax,[esi-16*4] {W[i-16]} mov [esi],eax add esi,4 dec ecx jnz @@2 pop ebx pop edi pop esi end; end; {$endif} {$else} {$ifndef BASM16} {TP5/5.5} {$undef USE_ExpandMessageBlocks} {---------------------------------------------------------------------------} procedure UpdateLen(var whi, wlo: longint; BLen: longint); {-Add BLen to 64 bit value (wlo, whi)} inline( $58/ {pop ax } $5A/ {pop dx } $5B/ {pop bx } $07/ {pop es } $26/$01/$07/ {add es:[bx],ax } $26/$11/$57/$02/ {adc es:[bx+02],dx} $5B/ {pop bx } $07/ {pop es } $26/$83/$17/$00/ {adc es:[bx],0 } $26/$83/$57/$02/$00);{adc es:[bx+02],0 } {---------------------------------------------------------------------------} function RB(A: longint): longint; {-reverse byte order in longint} inline( $58/ { pop ax } $5A/ { pop dx } $86/$C6/ { xchg dh,al} $86/$E2); { xchg dl,ah} {---------------------------------------------------------------------------} function FS1(x: longint; c: integer): longint; {-Rotate x right, c<=16!!} inline( $59/ { pop cx } $58/ { pop ax } $5A/ { pop dx } $8B/$DA/ { mov bx,dx} $D1/$EB/ {L:shr bx,1 } $D1/$D8/ { rcr ax,1 } $D1/$DA/ { rcr dx,1 } $49/ { dec cx } $75/$F7); { jne L } {---------------------------------------------------------------------------} function FS2(x: longint; c: integer): longint; {-Rotate x right, c+16, c<16!!} inline( $59/ { pop cx } $5A/ { pop dx } $58/ { pop ax } $8B/$DA/ { mov bx,dx} $D1/$EB/ {L:shr bx,1 } $D1/$D8/ { rcr ax,1 } $D1/$DA/ { rcr dx,1 } $49/ { dec cx } $75/$F7); { jne L } {---------------------------------------------------------------------------} function ISHR(x: longint; c: integer): longint; {-Shift x right} inline( $59/ { pop cx } $58/ { pop ax } $5A/ { pop dx } $D1/$EA/ {L:shr dx,1 } $D1/$D8/ { rcr ax,1 } $49/ { dec cx } $75/$F9); { jne L } {---------------------------------------------------------------------------} function Sig0(x: longint): longint; {-Small sigma 0} begin Sig0 := FS1(x,7) xor FS2(x,18-16) xor ISHR(x,3); end; {---------------------------------------------------------------------------} function Sig1(x: longint): longint; {-Small sigma 1} begin Sig1 := FS2(x,17-16) xor FS2(x,19-16) xor ISHR(x,10); end; {---------------------------------------------------------------------------} function Sum0(x: longint): longint; {-Big sigma 0} begin Sum0 := FS1(x,2) xor FS1(x,13) xor FS2(x,22-16); end; {---------------------------------------------------------------------------} function Sum1(x: longint): longint; {-Big sigma 1} begin Sum1 := FS1(x,6) xor FS1(x,11) xor FS2(x,25-16); end; {$else} {TP 6/7/Delphi1 for 386+} {---------------------------------------------------------------------------} procedure UpdateLen(var whi, wlo: longint; BLen: longint); assembler; {-Add BLen to 64 bit value (wlo, whi)} asm les di,[wlo] db $66; mov ax,word ptr [BLen] db $66; sub dx,dx db $66; add es:[di],ax les di,[whi] db $66; adc es:[di],dx end; {---------------------------------------------------------------------------} function RB(A: longint): longint; assembler; {-reverse byte order in longint} asm mov ax,word ptr [A] mov dx,word ptr [A+2] xchg al,dh xchg ah,dl end; {---------------------------------------------------------------------------} function Sum0(x: longint): longint; assembler; {-Big sigma 0: RotRight(x,2) xor RotRight(x,13) xor RotRight(x,22)} asm db $66; mov ax,word ptr x db $66; mov bx,ax db $66; mov dx,ax db $66; ror ax,2 db $66; ror dx,13 db $66; ror bx,22 db $66; xor ax,dx db $66; xor ax,bx db $66; mov dx,ax db $66; shr dx,16 end; {---------------------------------------------------------------------------} function Sum1(x: longint): longint; assembler; {-Big sigma 1: RotRight(x,6) xor RotRight(x,11) xor RotRight(x,25)} asm db $66; mov ax,word ptr x db $66; mov bx,ax db $66; mov dx,ax db $66; ror ax,6 db $66; ror dx,11 db $66; ror bx,25 db $66; xor ax,dx db $66; xor ax,bx db $66; mov dx,ax db $66; shr dx,16 end; {$define USE_ExpandMessageBlocks} {---------------------------------------------------------------------------} procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuf32); assembler; {-Calculate "expanded message blocks"} asm push ds {part 1: W[i]:= RB(TW32Buf(Buf)[i])} les di,[Buf] lds si,[W] mov cx,16 @@1: db $66; mov ax,es:[di] xchg al,ah db $66; rol ax,16 xchg al,ah db $66; mov [si],ax add si,4 add di,4 dec cx jnz @@1 {part 2: W[i]:= Sig1(W[i-2]) + W[i-7] + Sig0(W[i-15]) + W[i-16];} mov cx,48 @@2: db $66; mov di,[si-7*4] {W[i-7]} db $66; mov ax,[si-2*4] {W[i-2]} db $66; mov bx,ax {Sig1: RR17 xor RR19 xor SRx,10} db $66; mov dx,ax db $66; ror ax,17 db $66; ror dx,19 db $66; shr bx,10 db $66; xor ax,dx db $66; xor ax,bx db $66; add di,ax db $66; mov ax,[si-15*4] {W[i-15]} db $66; mov bx,ax {Sig0: RR7 xor RR18 xor SR3} db $66; mov dx,ax db $66; ror ax,7 db $66; ror dx,18 db $66; shr bx,3 db $66; xor ax,dx db $66; xor ax,bx db $66; add ax,di db $66; add ax,[si-16*4] {W[i-16]} db $66; mov [si],ax add si,4 dec cx jnz @@2 pop ds end; {$endif BASM16} {$endif BIT16} {$ifdef PurePascal} {---------------------------------------------------------------------------} procedure SHA256Compress(var Data: THashContext); {-Actual hashing function} var i: integer; T, A, B, C, D, E, F, G, H: longint; W: TWorkBuf; const {$ifdef StrictLong} {$warnings off} {$R-} {avoid D9 errors!} {$endif} K: array[0..63] of longint = ( $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1, $923f82a4, $ab1c5ed5, $d807aa98, $12835b01, $243185be, $550c7dc3, $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174, $e49b69c1, $efbe4786, $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da, $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147, $06ca6351, $14292967, $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13, $650a7354, $766a0abb, $81c2c92e, $92722c85, $a2bfe8a1, $a81a664b, $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070, $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a, $5b9cca4f, $682e6ff3, $748f82ee, $78a5636f, $84c87814, $8cc70208, $90befffa, $a4506ceb, $bef9a3f7, $c67178f2 ); {$ifdef StrictLong} {$warnings on} {$ifdef RangeChecks_on} {$R+} {$endif} {$endif} begin {-Calculate "expanded message blocks"} {Part 1: Transfer buffer with little -> big endian conversion} for i:= 0 to 15 do W[i] := RB(THashBuf32(Data.Buffer)[i]); {Part 2: Calculate remaining "expanded message blocks"} for i:= 16 to 63 do begin {A=Sig1(W[i-2]), B=Sig0(W[i-15])} A := W[i-2]; A := ((A shr 17) or (A shl 15)) xor ((A shr 19) or (A shl 13)) xor (A shr 10); B := W[i-15]; B := ((B shr 7) or (B shl 25)) xor ((B shr 18) or (B shl 14)) xor (B shr 3); W[i]:= A + W[i-7] + B + W[i-16]; end; {Assign old working hasg to variables A..H} A := Data.Hash[0]; B := Data.Hash[1]; C := Data.Hash[2]; D := Data.Hash[3]; E := Data.Hash[4]; F := Data.Hash[5]; G := Data.Hash[6]; H := Data.Hash[7]; {SHA256 compression function} {partially unrolled loop} i := 0; repeat T := H + (((E shr 6) or (E shl 26)) xor ((E shr 11) or (E shl 21)) xor ((E shr 25) or (E shl 7))) + (((F xor G) and E) xor G) + W[i ] + K[i ]; H := T + (((A shr 2) or (A shl 30)) xor ((A shr 13) or (A shl 19)) xor ((A shr 22) or (A shl 10))) + (((A or B) and C) or (A and B)); inc(D,T); T := G + (((D shr 6) or (D shl 26)) xor ((D shr 11) or (D shl 21)) xor ((D shr 25) or (D shl 7))) + (((E xor F) and D) xor F) + W[i+1] + K[i+1]; G := T + (((H shr 2) or (H shl 30)) xor ((H shr 13) or (H shl 19)) xor ((H shr 22) or (H shl 10))) + (((H or A) and B) or (H and A)); inc(C,T); T := F + (((C shr 6) or (C shl 26)) xor ((C shr 11) or (C shl 21)) xor ((C shr 25) or (C shl 7))) + (((D xor E) and C) xor E) + W[i+2] + K[i+2]; F := T + (((G shr 2) or (G shl 30)) xor ((G shr 13) or (G shl 19)) xor ((G shr 22) or (G shl 10))) + (((G or H) and A) or (G and H)); inc(B,T); T := E + (((B shr 6) or (B shl 26)) xor ((B shr 11) or (B shl 21)) xor ((B shr 25) or (B shl 7))) + (((C xor D) and B) xor D) + W[i+3] + K[i+3]; E := T + (((F shr 2) or (F shl 30)) xor ((F shr 13) or (F shl 19)) xor ((F shr 22) or (F shl 10))) + (((F or G) and H) or (F and G)); inc(A,T); T := D + (((A shr 6) or (A shl 26)) xor ((A shr 11) or (A shl 21)) xor ((A shr 25) or (A shl 7))) + (((B xor C) and A) xor C) + W[i+4] + K[i+4]; D := T + (((E shr 2) or (E shl 30)) xor ((E shr 13) or (E shl 19)) xor ((E shr 22) or (E shl 10))) + (((E or F) and G) or (E and F)); inc(H,T); T := C + (((H shr 6) or (H shl 26)) xor ((H shr 11) or (H shl 21)) xor ((H shr 25) or (H shl 7))) + (((A xor B) and H) xor B) + W[i+5] + K[i+5]; C := T + (((D shr 2) or (D shl 30)) xor ((D shr 13) or (D shl 19)) xor ((D shr 22) or (D shl 10))) + (((D or E) and F) or (D and E)); inc(G,T); T := B + (((G shr 6) or (G shl 26)) xor ((G shr 11) or (G shl 21)) xor ((G shr 25) or (G shl 7))) + (((H xor A) and G) xor A) + W[i+6] + K[i+6]; B := T + (((C shr 2) or (C shl 30)) xor ((C shr 13) or (C shl 19)) xor ((C shr 22) or (C shl 10))) + (((C or D) and E) or (C and D)); inc(F,T); T := A + (((F shr 6) or (F shl 26)) xor ((F shr 11) or (F shl 21)) xor ((F shr 25) or (F shl 7))) + (((G xor H) and F) xor H) + W[i+7] + K[i+7]; A := T + (((B shr 2) or (B shl 30)) xor ((B shr 13) or (B shl 19)) xor ((B shr 22) or (B shl 10))) + (((B or C) and D) or (B and C)); inc(E,T); inc(i,8) until i>63; {Calculate new working hash} inc(Data.Hash[0],A); inc(Data.Hash[1],B); inc(Data.Hash[2],C); inc(Data.Hash[3],D); inc(Data.Hash[4],E); inc(Data.Hash[5],F); inc(Data.Hash[6],G); inc(Data.Hash[7],H); end; {$else} {---------------------------------------------------------------------------} procedure SHA256Compress(var Data: TKzHashContext); {-Actual hashing function} var i: integer; {$ifdef UNROLL} T, {$else} T1,T2: longint; {$endif} A, B, C, D, E, F, G, H: longint; W: TWorkBuf; const {$ifdef StrictLong} {$warnings off} {$R-} {avoid D9 errors!} {$endif} K: array[0..63] of longint = ( $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1, $923f82a4, $ab1c5ed5, $d807aa98, $12835b01, $243185be, $550c7dc3, $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174, $e49b69c1, $efbe4786, $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da, $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147, $06ca6351, $14292967, $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13, $650a7354, $766a0abb, $81c2c92e, $92722c85, $a2bfe8a1, $a81a664b, $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070, $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a, $5b9cca4f, $682e6ff3, $748f82ee, $78a5636f, $84c87814, $8cc70208, $90befffa, $a4506ceb, $bef9a3f7, $c67178f2 ); {$ifdef StrictLong} {$warnings on} {$ifdef RangeChecks_on} {$R+} {$endif} {$endif} begin {-Calculate "expanded message blocks"} {$ifdef USE_ExpandMessageBlocks} {Use BASM-Code} ExpandMessageBlocks(W, THashBuf32(Data.Buffer)); {$else} {Avoid proc call overhead for TP5/5.5} {Part 1: Transfer buffer with little -> big endian conversion} for i:= 0 to 15 do W[i]:= RB(THashBuf32(Data.Buffer)[i]); {Part 2: Calculate remaining "expanded message blocks"} for i:= 16 to 63 do W[i]:= Sig1(W[i-2]) + W[i-7] + Sig0(W[i-15]) + W[i-16]; {$endif} {Assign old working hasg to variables A..H} A := Data.Hash[0]; B := Data.Hash[1]; C := Data.Hash[2]; D := Data.Hash[3]; E := Data.Hash[4]; F := Data.Hash[5]; G := Data.Hash[6]; H := Data.Hash[7]; {SHA256 compression function} {$ifdef UNROLL} {partially unrolled loop} i := 0; repeat T := H + Sum1(E) + (((F xor G) and E) xor G) + W[i ] + K[i ]; H := T + Sum0(A) + (((A or B) and C) or (A and B)); inc(D,T); T := G + Sum1(D) + (((E xor F) and D) xor F) + W[i+1] + K[i+1]; G := T + Sum0(H) + (((H or A) and B) or (H and A)); inc(C,T); T := F + Sum1(C) + (((D xor E) and C) xor E) + W[i+2] + K[i+2]; F := T + Sum0(G) + (((G or H) and A) or (G and H)); inc(B,T); T := E + Sum1(B) + (((C xor D) and B) xor D) + W[i+3] + K[i+3]; E := T + Sum0(F) + (((F or G) and H) or (F and G)); inc(A,T); T := D + Sum1(A) + (((B xor C) and A) xor C) + W[i+4] + K[i+4]; D := T + Sum0(E) + (((E or F) and G) or (E and F)); inc(H,T); T := C + Sum1(H) + (((A xor B) and H) xor B) + W[i+5] + K[i+5]; C := T + Sum0(D) + (((D or E) and F) or (D and E)); inc(G,T); T := B + Sum1(G) + (((H xor A) and G) xor A) + W[i+6] + K[i+6]; B := T + Sum0(C) + (((C or D) and E) or (C and D)); inc(F,T); T := A + Sum1(F) + (((G xor H) and F) xor H) + W[i+7] + K[i+7]; A := T + Sum0(B) + (((B or C) and D) or (B and C)); inc(E,T); inc(i,8) until i>63; {$else} for i:=0 to 63 do begin T1:= H + Sum1(E) + (((F xor G) and E) xor G) + K[i] + W[i]; T2:= Sum0(A) + (((A or B) and C) or (A and B)); H := G; G := F; F := E; E := D + T1; D := C; C := B; B := A; A := T1 + T2; end; {$endif} {Calculate new working hash} inc(Data.Hash[0],A); inc(Data.Hash[1],B); inc(Data.Hash[2],C); inc(Data.Hash[3],D); inc(Data.Hash[4],E); inc(Data.Hash[5],F); inc(Data.Hash[6],G); inc(Data.Hash[7],H); end; {$endif} {---------------------------------------------------------------------------} procedure SHA256Init(var Context: TKzHashContext); {-initialize context} {$ifdef StrictLong} {$warnings off} {$R-} {avoid D9 errors!} {$endif} const SIV: array[0..7] of longint = ($6a09e667, $bb67ae85, $3c6ef372, $a54ff53a, $510e527f, $9b05688c, $1f83d9ab, $5be0cd19); {$ifdef StrictLong} {$warnings on} {$ifdef RangeChecks_on} {$R+} {$endif} {$endif} begin {Clear context, buffer=0!!} fillchar(Context,sizeof(Context),0); move(SIV,Context.Hash,sizeof(SIV)); end; {---------------------------------------------------------------------------} procedure SHA256UpdateXL(var Context: TKzHashContext; Msg: pointer; Len: longint); {-update context with Msg data} var i: integer; begin {Update message bit length} if Len<=$1FFFFFFF then UpdateLen(Context.MLen[1], Context.MLen[0], Len shl 3) else begin for i:=1 to 8 do UpdateLen(Context.MLen[1], Context.MLen[0], Len) end; while Len > 0 do begin {fill block with msg data} Context.Buffer[Context.Index]:= pByte(Msg)^; inc(Ptr2Inc(Msg)); inc(Context.Index); dec(Len); if Context.Index=SHA256_BlockLen then begin {If 512 bit transferred, compress a block} Context.Index:= 0; SHA256Compress(Context); while Len>=SHA256_BlockLen do begin move(Msg^,Context.Buffer,SHA256_BlockLen); SHA256Compress(Context); inc(Ptr2Inc(Msg),SHA256_BlockLen); dec(Len,SHA256_BlockLen); end; end; end; end; {---------------------------------------------------------------------------} procedure SHA256Update(var Context: TKzHashContext; Msg: pointer; Len: longint {word}); // word 형식을 longint으로 변경 18_0621 14:02:57 sunk {-update context with Msg data} begin SHA256UpdateXL(Context, Msg, Len); end; {---------------------------------------------------------------------------} procedure SHA256FinalBitsEx(var Context: TKzHashContext; var Digest: THashDigest; BData: byte; bitlen: integer); {-finalize SHA256 calculation with bitlen bits from BData (big-endian), clear context} var i: integer; begin {Message padding} {append bits from BData and a single '1' bit} if (bitlen>0) and (bitlen<=7) then begin Context.Buffer[Context.Index]:= (BData and BitAPI_Mask[bitlen]) or BitAPI_PBit[bitlen]; UpdateLen(Context.MLen[1], Context.MLen[0], bitlen); end else Context.Buffer[Context.Index]:= $80; for i:=Context.Index+1 to 63 do Context.Buffer[i] := 0; {2. Compress if more than 448 bits, (no room for 64 bit length} if Context.Index>= 56 then begin SHA256Compress(Context); fillchar(Context.Buffer,56,0); end; {Write 64 bit msg length into the last bits of the last block} {(in big endian format) and do a final compress} THashBuf32(Context.Buffer)[14]:= RB(Context.MLen[1]); THashBuf32(Context.Buffer)[15]:= RB(Context.MLen[0]); SHA256Compress(Context); {Hash -> Digest to little endian format} for i:=0 to 7 do THashDig32(Digest)[i]:= RB(Context.Hash[i]); {Clear context} fillchar(Context,sizeof(Context),0); end; {---------------------------------------------------------------------------} procedure SHA256FinalBits(var Context: TKzHashContext; var Digest: TSHA256Digest; BData: byte; bitlen: integer); {-finalize SHA256 calculation with bitlen bits from BData (big-endian), clear context} var tmp: THashDigest; begin SHA256FinalBitsEx(Context, tmp, BData, bitlen); move(tmp, Digest, sizeof(Digest)); end; {---------------------------------------------------------------------------} procedure SHA256FinalEx(var Context: TKzHashContext; var Digest: THashDigest); {-finalize SHA256 calculation, clear context} begin SHA256FinalBitsEx(Context,Digest,0,0); end; {---------------------------------------------------------------------------} procedure SHA256Final(var Context: TKzHashContext; var Digest: TSHA256Digest); {-finalize SHA256 calculation, clear context} var tmp: THashDigest; begin SHA256FinalBitsEx(Context, tmp, 0, 0); move(tmp, Digest, sizeof(Digest)); end; {---------------------------------------------------------------------------} function SHA256SelfTest: boolean; {-self test for string from SHA256 document} const s1: string[ 3] = 'abc'; s2: string[56] = 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'; D1: TSHA256Digest = ($ba,$78,$16,$bf,$8f,$01,$cf,$ea,$41,$41,$40,$de,$5d,$ae,$22,$23, $b0,$03,$61,$a3,$96,$17,$7a,$9c,$b4,$10,$ff,$61,$f2,$00,$15,$ad); D2: TSHA256Digest = ($24,$8d,$6a,$61,$d2,$06,$38,$b8,$e5,$c0,$26,$93,$0c,$3e,$60,$39, $a3,$3c,$e4,$59,$64,$ff,$21,$67,$f6,$ec,$ed,$d4,$19,$db,$06,$c1); D3: TSHA256Digest = ($bd,$4f,$9e,$98,$be,$b6,$8c,$6e,$ad,$32,$43,$b1,$b4,$c7,$fe,$d7, $5f,$a4,$fe,$aa,$b1,$f8,$47,$95,$cb,$d8,$a9,$86,$76,$a2,$a3,$75); D4: TSHA256Digest = ($f1,$54,$1d,$eb,$68,$d1,$34,$eb,$a9,$9f,$82,$cf,$d8,$7e,$2a,$b3, $1d,$33,$af,$4b,$6d,$e0,$08,$6a,$9b,$ed,$15,$c2,$ec,$69,$cc,$cb); var Context: TKzHashContext; Digest : TSHA256Digest; function SingleTest(s: Str127; TDig: TSHA256Digest): boolean; {-do a single test, const not allowed for VER<7} { Two sub tests: 1. whole string, 2. one update per char} var i: integer; begin SingleTest := false; {1. Hash complete string} SHA256Full(Digest, @s[1],length(s)); {Compare with known value} if not HashSameDigest(@SHA256_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; {2. one update call for all chars} SHA256Init(Context); for i:=1 to length(s) do SHA256Update(Context,@s[i],1); SHA256Final(Context,Digest); {Compare with known value} if not HashSameDigest(@SHA256_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; SingleTest := true; end; begin SHA256SelfTest := false; {1 Zero bit from NESSIE test vectors} SHA256Init(Context); SHA256FinalBits(Context,Digest,0,1); if not HashSameDigest(@SHA256_Desc, PHashDigest(@Digest), PHashDigest(@D3)) then exit; {4 hightest bits of $50, D4 calculated with program shatest from RFC 4634} SHA256Init(Context); SHA256FinalBits(Context,Digest,$50,4); if not HashSameDigest(@SHA256_Desc, PHashDigest(@Digest), PHashDigest(@D4)) then exit; {strings from SHA256 document} SHA256SelfTest := SingleTest(s1, D1) and SingleTest(s2, D2) end; {---------------------------------------------------------------------------} procedure SHA256FullXL(var Digest: TSHA256Digest; Msg: pointer; Len: longint); {-SHA256 of Msg with init/update/final} var Context: TKzHashContext; begin SHA256Init(Context); SHA256UpdateXL(Context, Msg, Len); SHA256Final(Context, Digest); end; {---------------------------------------------------------------------------} procedure SHA256Full(var Digest: TSHA256Digest; Msg: pointer; Len: word); {-SHA256 of Msg with init/update/final} begin SHA256FullXL(Digest, Msg, Len); end; {---------------------------------------------------------------------------} procedure SHA256File({$ifdef CONST} const {$endif} fname: string; var Digest: TSHA256Digest; var buf; bsize: word; var Err: word); {-SHA256 of file, buf: buffer with at least bsize bytes} var tmp: THashDigest; begin HashFile(fname, @SHA256_Desc, tmp, buf, bsize, Err); move(tmp,Digest,sizeof(Digest)); end; begin {$ifdef VER5X} fillchar(SHA256_Desc, sizeof(SHA256_Desc), 0); with SHA256_Desc do begin HSig := C_HashSig; HDSize := sizeof(THashDesc); HDVersion := C_HashVers; HBlockLen := SHA256_BlockLen; HDigestlen:= sizeof(TSHA256Digest); HInit := SHA256Init; HFinal := SHA256FinalEx; HUpdateXL := SHA256UpdateXL; HAlgNum := longint(_SHA256); HName := 'SHA256'; HPtrOID := @SHA256_OID; HLenOID := 9; HFinalBit := SHA256FinalBitsEx; end; {$endif} RegisterHash(_SHA256, @SHA256_Desc); end.