unit EM.Tocsg.SHA1; // crc_hash_2018-01-01.zip 에서 sha256.pas 파일을 가져온 것이고, // 필요한 정의는 동일 경로에 있는btypes.pas, hash.pas에서 가져왔다. 22_0419 08:30:23 kku {SHA1 - 160 bit Secure Hash Function} interface (************************************************************************* DESCRIPTION : SHA1 - 160 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 ------- -------- ------- ------------------------------------------ 1.00 03.01.02 W.Ehrhardt BP7 implementation 1.01 14.03.02 we D1-D6, FPC, VP 1.02 14.03.02 we TP6 1.03 14.03.02 we TP6/7 386-Code 1.04 14.03.02 we TP5.5 1.10 15.03.02 we self test with 2 strings 1.11 02.01.03 we const SFA with @ for FPC 1.0.6 1.20 23.07.03 we With SHA1File, SHA1Full 1.21 26.07.03 we With SHA1Full in self test 2.00 26.07.03 we common vers., longint for word32, D4+ - warnings 2.01 03.08.03 we type TSHA1Block for HMAC 2.02 23.08.03 we SHA1Compress in interface for prng 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: partial unroll, no function calls 2.50 16.11.03 we Speedup in update, don't clear W in compress 2.51 17.11.03 we BIT16: partial unroll, BIT32: inline rot 2.52 17.11.03 we ExpandMessageBlocks 2.53 18.11.03 we LRot32, RB mit inline() 2.54 20.11.03 we Full range UpdateLen 2.55 30.11.03 we BIT16: {$F-} 2.56 30.11.03 we BIT16: LRot_5, LRot_30 3.00 01.12.03 we Common version 3.0 3.01 22.12.03 we BIT16: Two INCs 3.02 22.12.03 we BASM16: asm Lrot30 3.03 22.12.03 we TP5/5.5: LRot, RA inline 3.04 22,12.03 we Changed UpdateLen: Definition and TP5/5.5 inline 3.05 05.03.04 we Update fips180-2 URL 3.06 26.02.05 we With {$ifdef StrictLong} 3.07 05.05.05 we Use longint() in SH1Init to avoid D9 errors if $R+ 3.08 17.12.05 we Force $I- in SHA1File 3.09 08.01.06 we SHA1Compress removed from interface 3.10 15.01.06 we uses Hash unit and THashDesc 3.11 18.01.06 we Descriptor fields HAlgNum, HSig 3.12 22.01.06 we Removed HSelfTest from descriptor 3.13 11.02.06 we Descriptor as typed const 3.14 26.03.06 we Round constants K1..K4, code reordering 3.15 07.08.06 we $ifdef BIT32: (const fname: shortstring...) 3.16 22.02.07 we values for OID vector 3.17 30.06.07 we Use conditional define FPC_ProcVar 3.18 04.10.07 we FPC: {$asmmode intel} 3.19 02.05.08 we Bit-API: SHA1FinalBits/Ex 3.20 05.05.08 we THashDesc constant with HFinalBit field 3.21 12.11.08 we uses BTypes, Ptr2Inc and/or Str255/Str127 3.22 12.03.10 we Fix VP feature in ExpandMessageBlocks 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 SHA1File - 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} //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} TSHA1Digest = packed array[0..19] of byte; {SHA1 digest } // 원래 이름은 TTgHashContext이고, 범용적인 이름을 피하기 위해 변경 18_0621 10:52:19 sunk TTgHashContext = 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; procedure SHA1Init(var Context: TTgHashContext); {-initialize context} procedure SHA1Update(var Context: TTgHashContext; Msg: pointer; Len: word); {-update context with Msg data} procedure SHA1UpdateXL(var Context: TTgHashContext; Msg: pointer; Len: longint); {-update context with Msg data} procedure SHA1Final(var Context: TTgHashContext; var Digest: TSHA1Digest); {-finalize SHA1 calculation, clear context} procedure SHA1FinalEx(var Context: TTgHashContext; var Digest: THashDigest); {-finalize SHA1 calculation, clear context} procedure SHA1FinalBitsEx(var Context: TTgHashContext; var Digest: THashDigest; BData: byte; bitlen: integer); {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} procedure SHA1FinalBits(var Context: TTgHashContext; var Digest: TSHA1Digest; BData: byte; bitlen: integer); {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} function SHA1SelfTest: boolean; {-self test SHA1: compare with known value} procedure SHA1Full(var Digest: TSHA1Digest; Msg: pointer; Len: word); {-SHA1 of Msg with init/update/final} procedure SHA1FullXL(var Digest: TSHA1Digest; Msg: pointer; Len: longint); {-SHA1 of Msg with init/update/final} procedure SHA1File({$ifdef CONST} const {$endif} fname: string; var Digest: TSHA1Digest; var buf; bsize: word; var Err: word); {-SHA1 of file, buf: buffer with at least bsize bytes} implementation {$ifdef BIT16} {$F-} {$endif} const SHA1_BlockLen = 64; const {round constants} K1 = longint($5A827999); {round 00..19} K2 = longint($6ED9EBA1); {round 20..39} K3 = longint($8F1BBCDC); {round 40..59} K4 = longint($CA62C1D6); {round 60..79} {Internal types} type TWorkBuf = array[0..79] of longint; TOID_Vec = packed array[1..MaxOIDLen] of longint; {OID vector} POID_Vec = ^TOID_Vec; {ptr to OID vector} HashInitProc = procedure(var Context: TTgHashContext); {-initialize context} HashUpdateXLProc = procedure(var Context: TTgHashContext; Msg: pointer; Len: longint); {-update context with Msg data} HashFinalProc = procedure(var Context: TTgHashContext; var Digest: THashDigest); {-finalize calculation, clear context} HashFinalBitProc = procedure(var Context: TTgHashContext; 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; 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; {1.3.14.3.2.26} {iso(1) identified-organization(3) oiw(14) secsig(3) algorithms(2) hashAlgorithmIdentifier(26)} const SHA1_OID : TOID_Vec = (1,3,14,3,2,26,-1,-1,-1,-1,-1); {Len=6} {$ifndef VER5X} const SHA1_Desc: THashDesc = ( HSig : C_HashSig; HDSize : sizeof(THashDesc); HDVersion : C_HashVers; HBlockLen : SHA1_BlockLen; HDigestlen: sizeof(TSHA1Digest); {$ifdef FPC_ProcVar} HInit : @SHA1Init; HFinal : @SHA1FinalEx; HUpdateXL : @SHA1UpdateXL; {$else} HInit : SHA1Init; HFinal : SHA1FinalEx; HUpdateXL : SHA1UpdateXL; {$endif} HAlgNum : longint(_SHA1); HName : 'SHA1'; HPtrOID : @SHA1_OID; HLenOID : 6; HFill : 0; {$ifdef FPC_ProcVar} HFinalBit : @SHA1FinalBitsEx; {$else} HFinalBit : SHA1FinalBitsEx; {$endif} HReserved : (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ); {$else} var SHA1_Desc: THashDesc; {$endif} {$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; {---------------------------------------------------------------------------} procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); {-Calculate "expanded message blocks"} var i,T: longint; begin {Part 1: Transfer buffer with little -> big endian conversion} for i:= 0 to 15 do W[i]:= RB(THashBuf32(Buf)[i]); {Part 2: Calculate remaining "expanded message blocks"} for i:= 16 to 79 do begin T := W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]; W[i] := (T shl 1) or (T shr 31); end; end; {$else} {---------------------------------------------------------------------------} 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 RB(A: longint): longint; assembler; {-reverse byte order in longint} asm {$ifdef LoadArgs} mov eax,[A] {$endif} xchg al,ah rol eax,16 xchg al,ah end; {---------------------------------------------------------------------------} procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); assembler; {-Calculate "expanded message blocks"} asm {$ifdef LoadArgs} mov edx,Buf mov ecx,W {load W before push ebx to avoid VP crash} push ebx {if compiling with no ASM stack frames} mov ebx,ecx {$else} push ebx mov ebx,eax {$endif} {part1: W[i]:= RB(TW32Buf(Buf)[i])} mov ecx,16 @@1: mov eax,[edx] xchg al,ah rol eax,16 xchg al,ah mov [ebx],eax add ebx,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,64 @@2: mov eax,[ebx- 3*4] xor eax,[ebx- 8*4] xor eax,[ebx-14*4] xor eax,[ebx-16*4] rol eax,1 mov [ebx],eax add ebx,4 dec ecx jnz @@2 pop ebx end; {$endif} {---------------------------------------------------------------------------} procedure SHA1Compress(var Data: TTgHashContext); {-Actual hashing function} var i: integer; A, B, C, D, E: longint; W: TWorkBuf; begin ExpandMessageBlocks(W, Data.Buffer); A := Data.Hash[0]; B := Data.Hash[1]; C := Data.Hash[2]; D := Data.Hash[3]; E := Data.Hash[4]; {SHA1 compression function} {Partial unroll for more speed, full unroll is only slightly faster} {BIT32: rotateleft via inline} i := 0; while i<20 do begin inc(E, (A shl 5 or A shr 27) + (D xor (B and (C xor D))) + W[i ] + K1); B := B shr 2 or B shl 30; inc(D, (E shl 5 or E shr 27) + (C xor (A and (B xor C))) + W[i+1] + K1); A := A shr 2 or A shl 30; inc(C, (D shl 5 or D shr 27) + (B xor (E and (A xor B))) + W[i+2] + K1); E := E shr 2 or E shl 30; inc(B, (C shl 5 or C shr 27) + (A xor (D and (E xor A))) + W[i+3] + K1); D := D shr 2 or D shl 30; inc(A, (B shl 5 or B shr 27) + (E xor (C and (D xor E))) + W[i+4] + K1); C := C shr 2 or C shl 30; inc(i,5); end; while i<40 do begin inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + W[i ] + K2); B := B shr 2 or B shl 30; inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + W[i+1] + K2); A := A shr 2 or A shl 30; inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + W[i+2] + K2); E := E shr 2 or E shl 30; inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + W[i+3] + K2); D := D shr 2 or D shl 30; inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + W[i+4] + K2); C := C shr 2 or C shl 30; inc(i,5); end; while i<60 do begin inc(E, (A shl 5 or A shr 27) + ((B and C) or (D and (B or C))) + W[i ] + K3); B := B shr 2 or B shl 30; inc(D, (E shl 5 or E shr 27) + ((A and B) or (C and (A or B))) + W[i+1] + K3); A := A shr 2 or A shl 30; inc(C, (D shl 5 or D shr 27) + ((E and A) or (B and (E or A))) + W[i+2] + K3); E := E shr 2 or E shl 30; inc(B, (C shl 5 or C shr 27) + ((D and E) or (A and (D or E))) + W[i+3] + K3); D := D shr 2 or D shl 30; inc(A, (B shl 5 or B shr 27) + ((C and D) or (E and (C or D))) + W[i+4] + K3); C := C shr 2 or C shl 30; inc(i,5); end; while i<80 do begin inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + W[i ] + K4); B := B shr 2 or B shl 30; inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + W[i+1] + K4); A := A shr 2 or A shl 30; inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + W[i+2] + K4); E := E shr 2 or E shl 30; inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + W[i+3] + K4); D := D shr 2 or D shl 30; inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + W[i+4] + K4); C := C shr 2 or C shl 30; inc(i,5); end; {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); end; {$else} {$ifdef BASM16} {TP6-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 LRot_5(x: longint): longint; {-Rotate left 5} inline( $66/$58/ {pop eax } $66/$C1/$C0/$05/ {rol eax,5 } $66/$8B/$D0/ {mov edx,eax} $66/$C1/$EA/$10); {shr edx,16 } {---------------------------------------------------------------------------} 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 } {---------------------------------------------------------------------------} procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); 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]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]);} mov cx,64 @@2: db $66; mov ax,[si- 3*4] db $66; xor ax,[si- 8*4] db $66; xor ax,[si-14*4] db $66; xor ax,[si-16*4] db $66; rol ax,1 db $66; mov [si],ax add si,4 dec cx jnz @@2 pop ds end; {---------------------------------------------------------------------------} procedure SHA1Compress(var Data: TTgHashContext); {-Actual hashing function} var i: integer; A, B, C, D, E: longint; W: TWorkBuf; begin ExpandMessageBlocks(W, Data.Buffer); {Assign old working hash to variables A..E} A := Data.Hash[0]; B := Data.Hash[1]; C := Data.Hash[2]; D := Data.Hash[3]; E := Data.Hash[4]; {SHA1 compression function} {Partial unroll for more speed, full unroll only marginally faster} {Two INCs, LRot_30 via BASM} i := 0; while i<20 do begin inc(E,LRot_5(A)); inc(E,(D xor (B and (C xor D))) + W[i ] + K1); asm db $66; rol word[B],30 end; inc(D,LRot_5(E)); inc(D,(C xor (A and (B xor C))) + W[i+1] + K1); asm db $66; rol word[A],30 end; inc(C,LRot_5(D)); inc(C,(B xor (E and (A xor B))) + W[i+2] + K1); asm db $66; rol word[E],30 end; inc(B,LRot_5(C)); inc(B,(A xor (D and (E xor A))) + W[i+3] + K1); asm db $66; rol word[D],30 end; inc(A,LRot_5(B)); inc(A,(E xor (C and (D xor E))) + W[i+4] + K1); asm db $66; rol word[C],30 end; inc(i,5); end; while i<40 do begin inc(E,LRot_5(A)); inc(E,(B xor C xor D) + W[i ] + K2); asm db $66; rol word[B],30 end; inc(D,LRot_5(E)); inc(D,(A xor B xor C) + W[i+1] + K2); asm db $66; rol word[A],30 end; inc(C,LRot_5(D)); inc(C,(E xor A xor B) + W[i+2] + K2); asm db $66; rol word[E],30 end; inc(B,LRot_5(C)); inc(B,(D xor E xor A) + W[i+3] + K2); asm db $66; rol word[D],30 end; inc(A,LRot_5(B)); inc(A,(C xor D xor E) + W[i+4] + K2); asm db $66; rol word[C],30 end; inc(i,5); end; while i<60 do begin inc(E,LRot_5(A)); inc(E,((B and C) or (D and (B or C))) + W[i ] + K3); asm db $66; rol word[B],30 end; inc(D,LRot_5(E)); inc(D,((A and B) or (C and (A or B))) + W[i+1] + K3); asm db $66; rol word[A],30 end; inc(C,LRot_5(D)); inc(C,((E and A) or (B and (E or A))) + W[i+2] + K3); asm db $66; rol word[E],30 end; inc(B,LRot_5(C)); inc(B,((D and E) or (A and (D or E))) + W[i+3] + K3); asm db $66; rol word[D],30 end; inc(A,LRot_5(B)); inc(A,((C and D) or (E and (C or D))) + W[i+4] + K3); asm db $66; rol word[C],30 end; inc(i,5); end; while i<80 do begin inc(E,LRot_5(A)); inc(E,(B xor C xor D) + W[i ] + K4); asm db $66; rol word[B],30 end; inc(D,LRot_5(E)); inc(D,(A xor B xor C) + W[i+1] + K4); asm db $66; rol word[A],30 end; inc(C,LRot_5(D)); inc(C,(E xor A xor B) + W[i+2] + K4); asm db $66; rol word[E],30 end; inc(B,LRot_5(C)); inc(B,(D xor E xor A) + W[i+3] + K4); asm db $66; rol word[D],30 end; inc(A,LRot_5(B)); inc(A,(C xor D xor E) + W[i+4] + K4); asm db $66; rol word[C],30 end; inc(i,5); end; {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); end; {$else} {TP5/5.5} {---------------------------------------------------------------------------} 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 LRot_1(x: longint): longint; {-Rotate left 1} inline( $58/ { pop ax } $5A/ { pop dx } $2B/$C9/ { sub cx,cx} $D1/$D0/ { rcl ax,1 } $D1/$D2/ { rcl dx,1 } $13/$C1); { adc ax,cx} {---------------------------------------------------------------------------} function LRot_5(x: longint): longint; {-Rotate left 5} inline( $58/ { pop ax } $5A/ { pop dx } $2B/$C9/ { sub cx,cx} $D1/$D0/ { rcl ax,1 } $D1/$D2/ { rcl dx,1 } $13/$C1/ { adc ax,cx} $D1/$D0/ { rcl ax,1 } $D1/$D2/ { rcl dx,1 } $13/$C1/ { adc ax,cx} $D1/$D0/ { rcl ax,1 } $D1/$D2/ { rcl dx,1 } $13/$C1/ { adc ax,cx} $D1/$D0/ { rcl ax,1 } $D1/$D2/ { rcl dx,1 } $13/$C1/ { adc ax,cx} $D1/$D0/ { rcl ax,1 } $D1/$D2/ { rcl dx,1 } $13/$C1); { adc ax,cx} {---------------------------------------------------------------------------} function LRot_30(x: longint): longint; {-Rotate left 30 = rot right 2} inline( $58/ { pop ax } $5A/ { pop dx } $8B/$CA/ { mov cx,dx} $D1/$E9/ { shr cx,1 } $D1/$D8/ { rcr ax,1 } $D1/$DA/ { rcr dx,1 } $8B/$CA/ { mov cx,dx} $D1/$E9/ { shr cx,1 } $D1/$D8/ { rcr ax,1 } $D1/$DA); { rcr dx,1 } {---------------------------------------------------------------------------} procedure ExpandMessageBlocks(var W: TWorkBuf; var Buf: THashBuffer); {-Calculate "expanded message blocks"} var i: integer; begin {Part 1: Transfer buffer with little -> big endian conversion} for i:= 0 to 15 do W[i]:= RB(THashBuf32(Buf)[i]); {Part 2: Calculate remaining "expanded message blocks"} for i:= 16 to 79 do W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16]); end; {---------------------------------------------------------------------------} procedure SHA1Compress(var Data: TTgHashContext); {-Actual hashing function} var i: integer; A, B, C, D, E: longint; W: TWorkBuf; begin ExpandMessageBlocks(W, Data.Buffer); {Assign old working hash to variables A..E} A := Data.Hash[0]; B := Data.Hash[1]; C := Data.Hash[2]; D := Data.Hash[3]; E := Data.Hash[4]; {SHA1 compression function} {Partial unroll for more speed, full unroll only marginally faster} {BIT16: rotateleft via function call} i := 0; while i<20 do begin inc(E,LRot_5(A) + (D xor (B and (C xor D))) + W[i ] + K1); B := LRot_30(B); inc(D,LRot_5(E) + (C xor (A and (B xor C))) + W[i+1] + K1); A := LRot_30(A); inc(C,LRot_5(D) + (B xor (E and (A xor B))) + W[i+2] + K1); E := LRot_30(E); inc(B,LRot_5(C) + (A xor (D and (E xor A))) + W[i+3] + K1); D := LRot_30(D); inc(A,LRot_5(B) + (E xor (C and (D xor E))) + W[i+4] + K1); C := LRot_30(C); inc(i,5); end; while i<40 do begin inc(E,LRot_5(A) + (B xor C xor D) + W[i ] + K2); B := LRot_30(B); inc(D,LRot_5(E) + (A xor B xor C) + W[i+1] + K2); A := LRot_30(A); inc(C,LRot_5(D) + (E xor A xor B) + W[i+2] + K2); E := LRot_30(E); inc(B,LRot_5(C) + (D xor E xor A) + W[i+3] + K2); D := LRot_30(D); inc(A,LRot_5(B) + (C xor D xor E) + W[i+4] + K2); C := LRot_30(C); inc(i,5); end; while i<60 do begin inc(E,LRot_5(A) + ((B and C) or (D and (B or C))) + W[i ] + K3); B := LRot_30(B); inc(D,LRot_5(E) + ((A and B) or (C and (A or B))) + W[i+1] + K3); A := LRot_30(A); inc(C,LRot_5(D) + ((E and A) or (B and (E or A))) + W[i+2] + K3); E := LRot_30(E); inc(B,LRot_5(C) + ((D and E) or (A and (D or E))) + W[i+3] + K3); D := LRot_30(D); inc(A,LRot_5(B) + ((C and D) or (E and (C or D))) + W[i+4] + K3); C := LRot_30(C); inc(i,5); end; while i<80 do begin inc(E,LRot_5(A) + (B xor C xor D) + W[i ] + K4); B := LRot_30(B); inc(D,LRot_5(E) + (A xor B xor C) + W[i+1] + K4); A := LRot_30(A); inc(C,LRot_5(D) + (E xor A xor B) + W[i+2] + K4); E := LRot_30(E); inc(B,LRot_5(C) + (D xor E xor A) + W[i+3] + K4); D := LRot_30(D); inc(A,LRot_5(B) + (C xor D xor E) + W[i+4] + K4); C := LRot_30(C); inc(i,5); end; {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); end; {$endif BASM16} {$endif BIT16} {---------------------------------------------------------------------------} procedure SHA1Init(var Context: TTgHashContext); {-initialize context} begin {Clear context, buffer=0!!} fillchar(Context,sizeof(Context),0); with Context do begin Hash[0] := longint($67452301); Hash[1] := longint($EFCDAB89); Hash[2] := longint($98BADCFE); Hash[3] := longint($10325476); Hash[4] := longint($C3D2E1F0); end; end; {---------------------------------------------------------------------------} procedure SHA1UpdateXL(var Context: TTgHashContext; 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=SHA1_BlockLen then begin {If 512 bit transferred, compress a block} Context.Index:= 0; SHA1Compress(Context); while Len>=SHA1_BlockLen do begin move(Msg^,Context.Buffer,SHA1_BlockLen); SHA1Compress(Context); inc(Ptr2Inc(Msg),SHA1_BlockLen); dec(Len,SHA1_BlockLen); end; end; end; end; {---------------------------------------------------------------------------} procedure SHA1Update(var Context: TTgHashContext; Msg: pointer; Len: word); {-update context with Msg data} begin SHA1UpdateXL(Context, Msg, Len); end; {---------------------------------------------------------------------------} procedure SHA1FinalBitsEx(var Context: TTgHashContext; var Digest: THashDigest; BData: byte; bitlen: integer); {-finalize SHA1 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 SHA1Compress(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]); SHA1Compress(Context); {Hash->Digest to little endian format} fillchar(Digest, sizeof(Digest), 0); for i:=0 to 4 do THashDig32(Digest)[i]:= RB(Context.Hash[i]); {Clear context} fillchar(Context,sizeof(Context),0); end; {---------------------------------------------------------------------------} procedure SHA1FinalBits(var Context: TTgHashContext; var Digest: TSHA1Digest; BData: byte; bitlen: integer); {-finalize SHA1 calculation with bitlen bits from BData (big-endian), clear context} var tmp: THashDigest; begin SHA1FinalBitsEx(Context, tmp, BData, bitlen); move(tmp, Digest, sizeof(Digest)); end; {---------------------------------------------------------------------------} procedure SHA1FinalEx(var Context: TTgHashContext; var Digest: THashDigest); {-finalize SHA1 calculation, clear context} begin SHA1FinalBitsEx(Context,Digest,0,0); end; {---------------------------------------------------------------------------} procedure SHA1Final(var Context: TTgHashContext; var Digest: TSHA1Digest); {-finalize SHA1 calculation, clear context} var tmp: THashDigest; begin SHA1FinalBitsEx(Context, tmp, 0, 0); move(tmp, Digest, sizeof(Digest)); end; 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; {---------------------------------------------------------------------------} function SHA1SelfTest: boolean; {-self test SHA1: compare with known value} const s1: string[ 3] = 'abc'; s2: string[56] = 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'; D1: TSHA1Digest= ($a9,$99,$3e,$36,$47,$06,$81,$6a,$ba,$3e,$25,$71,$78,$50,$c2,$6c,$9c,$d0,$d8,$9d); D2: TSHA1Digest= ($84,$98,$3E,$44,$1C,$3B,$D2,$6E,$BA,$AE,$4A,$A1,$F9,$51,$29,$E5,$E5,$46,$70,$F1); D3: TSHA1Digest= ($bb,$6b,$3e,$18,$f0,$11,$5b,$57,$92,$52,$41,$67,$6f,$5b,$1a,$e8,$87,$47,$b0,$8a); D4: TSHA1Digest= ($98,$23,$2a,$15,$34,$53,$14,$9a,$f8,$d5,$2a,$61,$50,$3a,$50,$74,$b8,$59,$70,$e8); var Context: TTgHashContext; Digest : TSHA1Digest; function SingleTest(s: Str127; TDig: TSHA1Digest): 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} SHA1Full(Digest, @s[1],length(s)); {Compare with known value} if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; {2. one update call for all chars} SHA1Init(Context); for i:=1 to length(s) do SHA1Update(Context,@s[i],1); SHA1Final(Context,Digest); {Compare with known value} if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@TDig)) then exit; SingleTest := true; end; begin SHA1SelfTest := false; {1 Zero bit from NESSIE test vectors} SHA1Init(Context); SHA1FinalBits(Context,Digest,0,1); if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@D3)) then exit; {4 hightest bits of $50, D4 calculated with program shatest from RFC 4634} SHA1Init(Context); SHA1FinalBits(Context,Digest,$50,4); if not HashSameDigest(@SHA1_Desc, PHashDigest(@Digest), PHashDigest(@D4)) then exit; {strings from SHA1 document} SHA1SelfTest := SingleTest(s1, D1) and SingleTest(s2, D2) end; {---------------------------------------------------------------------------} procedure SHA1FullXL(var Digest: TSHA1Digest; Msg: pointer; Len: longint); {-SHA1 of Msg with init/update/final} var Context: TTgHashContext; begin SHA1Init(Context); SHA1UpdateXL(Context, Msg, Len); SHA1Final(Context, Digest); end; {---------------------------------------------------------------------------} procedure SHA1Full(var Digest: TSHA1Digest; Msg: pointer; Len: word); {-SHA1 of Msg with init/update/final} begin SHA1FullXL(Digest, Msg, Len); 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: TTgHashContext; 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; {---------------------------------------------------------------------------} procedure SHA1File({$ifdef CONST} const {$endif} fname: string; var Digest: TSHA1Digest; var buf; bsize: word; var Err: word); {-SHA1 of file, buf: buffer with at least bsize bytes} var tmp: THashDigest; begin HashFile(fname, @SHA1_Desc, tmp, buf, bsize, Err); move(tmp, Digest, sizeof(Digest)); end; begin {$ifdef VER5X} fillchar(SHA1_Desc, sizeof(SHA1_Desc), 0); with SHA1_Desc do begin HSig := C_HashSig; HDSize := sizeof(THashDesc); HDVersion := C_HashVers; HBlockLen := SHA1_BlockLen; HDigestlen:= sizeof(TSHA1Digest); HInit := SHA1Init; HFinal := SHA1FinalEx; HUpdateXL := SHA1UpdateXL; HAlgNum := longint(_SHA1); HName := 'SHA1'; HPtrOID := @SHA1_OID; HLenOID := 6; HFinalBit := SHA1FinalBitsEx; end; {$endif} RegisterHash(_SHA1, @SHA1_Desc); end.