unit SHA256;

{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
**************************************************************************)

(*-------------------------------------------------------------------------
 (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;

procedure SHA256Init(var Context: THashContext);
  {-initialize context}

procedure SHA256Update(var Context: THashContext; Msg: pointer; Len: word);
  {-update context with Msg data}

procedure SHA256UpdateXL(var Context: THashContext; Msg: pointer; Len: longint);
  {-update context with Msg data}

procedure SHA256Final(var Context: THashContext; var Digest: TSHA256Digest);
  {-finalize SHA256 calculation, clear context}

procedure SHA256FinalEx(var Context: THashContext; var Digest: THashDigest);
  {-finalize SHA256 calculation, clear context}

procedure SHA256FinalBitsEx(var Context: THashContext; var Digest: THashDigest; BData: byte; bitlen: integer);
  {-finalize SHA256 calculation with bitlen bits from BData (big-endian), clear context}

procedure SHA256FinalBits(var Context: THashContext; 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: Str255;
                     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;


{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}


{$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: THashContext);
  {-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: THashContext);
  {-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: THashContext; 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: THashContext; Msg: pointer; Len: word);
   {-update context with Msg data}
begin
  SHA256UpdateXL(Context, Msg, Len);
end;


{---------------------------------------------------------------------------}
procedure SHA256FinalBitsEx(var Context: THashContext; 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: THashContext; 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: THashContext; var Digest: THashDigest);
  {-finalize SHA256 calculation, clear context}
begin
  SHA256FinalBitsEx(Context,Digest,0,0);
end;


{---------------------------------------------------------------------------}
procedure SHA256Final(var Context: THashContext; 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: THashContext;
  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: THashContext;
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: Str255;
                     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.
