unit EM.Tocsg.Hash;

{General Hash Unit: This unit defines the common types, functions, and
procedures. Via Hash descriptors and corresponding pointers, algorithms
can be searched by name or by ID. More important: all supported algorithms
can be used in the HMAC and KDF constructions.}


interface

(*************************************************************************

 DESCRIPTION     :  General hash unit: defines Algo IDs, digest types, etc

 REQUIREMENTS    :  TP5-7, D1-D7/D9-D10/D12/D17-D18/D25S, FPC, VP

 EXTERNAL DATA   :  ---

 MEMORY USAGE    :  ---

 DISPLAY MODE    :  ---

 REFERENCES      :  ---

 REMARK          :  TTgHashContext does not directly map the structure of the
                    context for SHA3 algorithms, a typecast with TSHA3State
                    from unit SHA3 should be used to access the fields.


 Version  Date      Author      Modification
 -------  --------  -------     ------------------------------------------
 0.10     15.01.06  W.Ehrhardt  Initial version
 0.11     15.01.06  we          FindHash_by_ID, $ifdef DLL: stdcall
 0.12     16.01.06  we          FindHash_by_Name
 0.13     18.01.06  we          Descriptor fields HAlgNum, HSig
 0.14     22.01.06  we          Removed HSelfTest from descriptor
 0.14     31.01.06  we          RIPEMD-160, C_MinHash, C_MaxHash
 0.15     11.02.06  we          Fields: HDSize, HVersion, HPtrOID, HLenOID
 0.16     02.08.06  we          Packed arrays
 0.17     07.08.06  we          $ifdef BIT32: (const fname: shortstring...)
 0.18     07.08.06  we          C_HashVers = $00010002
 0.19     10.02.07  we          HashFile: no eof, XL and filemode via $ifdef
 0.20     18.02.07  we          MD4, C_HashVers = $00010003
 0.21     22.02.07  we          POID_Vec=^TOID_Vec, typed HPtrOID
 0.22     24.02.07  we          added some checks for HSig=C_HashSig
 0.23     04.10.07  we          TTgHashContext.Index now longint
 0.24     02.05.08  we          type PHashDigest, function HashSameDigest
 0.25     04.05.08  we          BitAPI_Mask, BitAPI_PBit
 0.26     05.05.08  we          Descriptor with HFinalBit, C_HashVers=$00010004
 0.27     20.05.08  we          RMD160 as alias for RIPEMD160
 0.28     12.11.08  we          uses BTypes and Str255
 0.29     19.07.09  we          D12 fix: assign with typecast string(fname)
 0.30     08.03.12  we          SHA512/224 and SHA512/256, C_HashVers=$00010005
 0.31     10.03.12  we          HashFile: {$ifndef BIT16} instead of {$ifdef WIN32}

 0.32     08.08.18  we          New enlarged padded context, _SHA3_224 .. _SHA3_512
 0.33     08.08.18  we          THMacBuffer, assert HASHCTXSIZE
 0.34     16.08.15  we          Removed $ifdef DLL / stdcall

 0.35     15.05.17  we          Changes for Blake2s
 0.36     16.05.17  we          MaxOIDLen = 11 and MaxC_HashVers = $00020002

 0.37     03.11.17  we          TBlake2B_384/512Digest

 0.38     29.11.17  we          HashFile - fname: string

**************************************************************************)

(*-------------------------------------------------------------------------
 (C) Copyright 2006-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.
----------------------------------------------------------------------------*)

{$i STD.INC}

uses
  BTypes;

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

const
  _RMD160  = _RIPEMD160;      {Alias}

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}
  C_MinHash    = _MD4;        {Lowest  hash in THashAlgorithm}
  C_MaxHash    = _Blake2B_512;{Highest hash in THashAlgorithm}

type
  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}
  THMacBuffer  = packed array[0..143] of byte;                      {hmac buffer block}

const
  HASHCTXSIZE  = 448;  {Common size of enlarged padded old context}
                       {and new padded SHA3/SHAKE/Keccak context  }

type
  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;

type
  TMD4Digest       = packed array[0..15] of byte;  {MD4    digest    }
  TMD5Digest       = packed array[0..15] of byte;  {MD5    digest    }
  TRMD160Digest    = packed array[0..19] of byte;  {RMD160 digest    }
  TSHA1Digest      = packed array[0..19] of byte;  {SHA1   digest    }
  TSHA224Digest    = packed array[0..27] of byte;  {SHA224 digest    }
  TSHA256Digest    = packed array[0..31] of byte;  {SHA256 digest    }
  TSHA384Digest    = packed array[0..47] of byte;  {SHA384 digest    }
  TSHA512Digest    = packed array[0..63] of byte;  {SHA512 digest    }
  TSHA5_224Digest  = packed array[0..27] of byte;  {SHA512/224 digest}
  TSHA5_256Digest  = packed array[0..31] of byte;  {SHA512/256 digest}
  TWhirlDigest     = packed array[0..63] of byte;  {Whirlpool digest }
  TSHA3_224Digest  = packed array[0..27] of byte;  {SHA3_224 digest  }
  TSHA3_256Digest  = packed array[0..31] of byte;  {SHA3_256 digest  }
  TSHA3_384Digest  = packed array[0..47] of byte;  {SHA3_384 digest  }
  TSHA3_512Digest  = packed array[0..63] of byte;  {SHA3_512 digest  }
  TBlake2S_224Digest = packed array[0..27] of byte;  {Blake2S digest }
  TBlake2S_256Digest = packed array[0..31] of byte;  {Blake2S digest }
  TBlake2B_384Digest = packed array[0..47] of byte;  {Blake2B-384 digest}
  TBlake2B_512Digest = packed array[0..63] of byte;  {Blake2B-512 digest}


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

type
  TOID_Vec  = packed array[1..MaxOIDLen] of longint; {OID vector}
  POID_Vec  = ^TOID_Vec;                             {ptr to OID vector}

  Ptr2Inc = pByte;         {Type cast to increment untyped pointer}
  Str127  = string[127];

type
  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;


const
  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);

procedure RegisterHash(AlgId: THashAlgorithm; PHash: PHashDesc);
  {-Register algorithm with AlgID and Hash descriptor PHash^}

function  FindHash_by_ID(AlgoID: THashAlgorithm): PHashDesc;
  {-Return PHashDesc of AlgoID, nil if not found/registered}

function  FindHash_by_Name(AlgoName: THashName): PHashDesc;
  {-Return PHashDesc of Algo with AlgoName, nil if not found/registered}

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}

procedure HashUpdate(PHash: PHashDesc; var Context: TTgHashContext; Msg: pointer; Len: word);
  {-update context with Msg data}

procedure HashFullXL(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: longint);
  {-Calulate hash digest of Msg with init/update/final}

procedure HashFull(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: word);
  {-Calulate hash digest of Msg with init/update/final}

function  HashSameDigest(PHash: PHashDesc; PD1, PD2: PHashDigest): boolean;
  {-Return true if same digests, using HDigestlen of PHash}


implementation


var
  PHashVec : array[THashAlgorithm] of PHashDesc;
             {Hash descriptor pointers of all defined hash algorithms}

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


{---------------------------------------------------------------------------}
function FindHash_by_ID(AlgoID: THashAlgorithm): PHashDesc;
  {-Return PHashDesc of AlgoID, nil if not found/registered}
var
  p: PHashDesc;
  A: longint;
begin
  A := longint(AlgoID);
  FindHash_by_ID := nil;
  if (A>=ord(C_MinHash)) and (A<=ord(C_MaxHash)) then begin
    p := PHashVec[AlgoID];
    if (p<>nil) and (p^.HSig=C_HashSig) and (p^.HAlgNum=A) then FindHash_by_ID := p;
  end;
end;


{---------------------------------------------------------------------------}
function  FindHash_by_Name(AlgoName: THashName): PHashDesc;
  {-Return PHashDesc of Algo with AlgoName, nil if not found/registered}
var
  algo : THashAlgorithm;
  phash: PHashDesc;

  function StrUpcase(s: THashName): THashName;
    {-Upcase for strings}
  var
    i: integer;
  begin
    for i:=1 to length(s) do s[i] := upcase(s[i]);
    StrUpcase := s;
  end;

begin
  AlgoName := StrUpcase(Algoname);
  {Transform RMD160 alias to standard name}
  if AlgoName='RMD160' then AlgoName:='RIPEMD160';
  FindHash_by_Name := nil;
  for algo := C_MinHash to C_MaxHash do begin
    phash := PHashVec[algo];
    if (phash<>nil) and (AlgoName=StrUpcase(phash^.HName))
      and (phash^.HSig=C_HashSig) and (phash^.HAlgNum=longint(algo))
    then begin
      FindHash_by_Name := phash;
      exit;
    end;
  end;
end;


{---------------------------------------------------------------------------}
procedure HashUpdate(PHash: PHashDesc; var Context: TTgHashContext; Msg: pointer; Len: word);
  {-update context with Msg data}
begin
  if PHash<>nil then with PHash^ do begin
    if HSig=C_HashSig then HUpdateXL(Context, Msg, Len);
  end;
end;


{---------------------------------------------------------------------------}
procedure HashFullXL(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: longint);
  {-Calulate hash digest of Msg with init/update/final}
var
  Context: TTgHashContext;
begin
  if PHash<>nil then with PHash^ do begin
    if HSig=C_HashSig then begin
      HInit(Context);
      HUpdateXL(Context, Msg, Len);
      HFinal(Context, Digest);
    end;
  end;
end;


{---------------------------------------------------------------------------}
procedure HashFull(PHash: PHashDesc; var Digest: THashDigest; Msg: pointer; Len: word);
  {-Calulate hash digest of Msg with init/update/final}
begin
  {test PHash<>nil in HashFullXL}
  HashFullXL(PHash, Digest, Msg, Len);
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;


{$i-} {Force I-}
{---------------------------------------------------------------------------}
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;


begin
{$ifdef HAS_ASSERT}
  assert(sizeof(TTgHashContext)=HASHCTXSIZE , '** Invalid sizeof(TTgHashContext)');
{$else}
  if sizeof(TTgHashContext)<>HASHCTXSIZE then RunError(227);
{$endif}
  {Paranoia: initialize all descriptor pointers to nil (should}
  {be done by compiler/linker because array is in global data)}
  fillchar(PHashVec,sizeof(PHashVec),0);
end.