Commit 3229cb71 authored by Michael Van Canneyt's avatar Michael Van Canneyt
Browse files

* sha256 algorithm

parent b63979a5
program demosha256;
{$mode objfpc}
{$h+}
uses SysUtils, sha256, hashutils;
procedure SHA256Test;
var
aSource,Digest : AnsiString;
S : TBytes;
begin
aSource:='abc';
S:=TEncoding.UTF8.GetAnsiBytes(aSource);
SHA256Hexa(S, Digest);
if (Digest<> 'BA7816BF8F01CFEA414140DE5DAE2223B00361A396177A9CB410FF61F20015AD') then
raise Exception.Create('ERR_SHA256');
SetLength(S,0);
SHA256Hexa(S, Digest);
if (Digest<> 'E3B0C44298FC1C149AFBF4C8996FB92427AE41E4649B934CA495991B7852B855') then
raise Exception.Create('ERR_SHA256');
end;
begin
SHA256Test
end.
......@@ -34,6 +34,9 @@
T.Dependencies.AddInclude('src/md5i386.inc', [i386], AllOSes-[darwin]);
T:=P.Targets.AddUnit('src/sha1.pp');
T.Dependencies.AddInclude('src/sha1i386.inc', [i386], AllOSes-[darwin]);
T:=P.Targets.AddUnit('src/hashutils.pp');
T:=P.Targets.AddUnit('src/sha256.pp');
T.Dependencies.AddUnit('hashutils');
T:=P.Targets.AddUnit('src/crc.pas');
T:=P.Targets.AddUnit('src/ntlm.pas');
T:=P.Targets.AddUnit('src/uuid.pas');
......@@ -44,6 +47,7 @@
T:=P.Targets.AddExampleunit('examples/mdtest.pas');
T:=P.Targets.AddExampleunit('examples/crctest.pas');
T:=P.Targets.AddExampleunit('examples/sha1test.pp');
T:=P.Targets.AddExampleunit('examples/demosha256.pp');
T:=P.Targets.AddExampleunit('examples/hmd5.pp');
T:=P.Targets.AddExampleunit('examples/hsha1.pp');
T:=P.Targets.AddExampleunit('examples/md5performancetest.pas');
......
unit hashutils;
{$mode ObjFPC}{$H+}
{$modeswitch advancedrecords}
interface
uses
Classes, SysUtils, ECC;
Procedure BytesFromVar(out aBytes : TBytes; aLocation : Pointer; aSize : Integer);
Function BytesFromVar(aLocation : Pointer; aSize : Integer) : TBytes;
Function HexStrToBytes(Const aHexStr : AnsiString; out aBytes : TBytes) : Integer;
Function BytesToHexStr(out aHexStr : AnsiString; aBytes : PByte; aSize : Integer) : Integer;
Function BytesToHexStr(out aHexStr : AnsiString; aBytes : TBytes) : Integer;
Function BytesToHexStr(aBytes : TBytes) : AnsiString;
Procedure BytesToHexStrAppend(aBytes : TBytes;var aHexStr : AnsiString);
procedure BytesEncodeBase64(Source: Tbytes; out Dest: AnsiString; const IsURL, MultiLines, Padding: Boolean);
Function BytesEncodeBase64(Source: Tbytes; const IsURL, MultiLines, Padding: Boolean) : AnsiString;
function CryptoGetRandomBytes(Buffer: PByte; const Count: Integer): Boolean;
implementation
Procedure BytesFromVar(out aBytes : TBytes; aLocation : Pointer; aSize : Integer);
begin
SetLength(aBytes,aSize);
if aSize>0 then
Move(aLocation^,aBytes[0],aSize);
end;
Function BytesFromVar(aLocation : Pointer; aSize : Integer) : TBytes;
begin
BytesFromVar(Result,aLocation,aSize);
end;
Function HexStrToBytes(Const aHexStr : AnsiString; out aBytes : TBytes) : Integer;
const
Convert: array['0'..'f'] of SmallInt =
( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
-1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,10,11,12,13,14,15);
Var
Len : LongInt;
P: PAnsiChar;
PResult: PByte;
begin
Len:=Length(aHexStr);
SetLength(aBytes, Len div 2);
if Len=0 then Exit;
P := PAnsiChar(aHexStr);
PResult := PByte(aBytes);
while Len > 0 do
begin
PResult^ := (Convert[P[0]] shl 4) + Convert[P[1]];
Inc(PResult);
Inc(P, 2);
Dec(Len, 2);
end;
end;
Function BytesToHexStr(out aHexStr : AnsiString; aBytes : PByte; aSize : Integer) : Integer;
Const
Digits: Array[0..15] of AnsiChar = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
var
I: Integer;
PB : Pbyte;
PC : PAnsiChar;
begin
SetLength(aHexStr,aSize*2);
if aSize=0 then
exit;
PB:=aBytes;
PC:=PChar(aHexStr);
for I:=0 to aSize-1 do
begin
PC^:=Digits[(PB^ shr 4) and $0f];
Inc(PC);
PC^:=Digits[PB^ and $0f];
Inc(PC);
Inc(PB);
end;
end;
function BytesToHexStr(out aHexStr: AnsiString; aBytes: TBytes): Integer;
begin
BytesToHexStr(aHexStr,PByte(aBytes),Length(aBytes));
end;
function BytesToHexStr(aBytes: TBytes): AnsiString;
begin
BytesToHexStr(Result,aBytes);
end;
Procedure BytesToHexStrAppend(aBytes : TBytes;var aHexStr : AnsiString);
begin
aHexStr:=aHexStr+BytesToHexStr(aBytes);
end;
function GetBase64EncodedSize(const SourceSize: Int32; const MultiLines: Boolean): Int32;
var
Lines: Int32;
begin
Result := (SourceSize div 3) * 4;
if SourceSize mod 3 > 0 then
Inc(Result, 4);
if MultiLines then
begin
Lines := Result div 76;
Inc(Result, Lines*2); // #13#10 for each lines
end;
end;
procedure BytesEncodeBase64(Source: Tbytes; out Dest: AnsiString; const IsURL, MultiLines, Padding: Boolean);
const
FCodingTable: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
FCodingTableURL: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
procedure XBufferEncode64_1(var DestBuf: PByte; const AIn1: Byte; const IsURL: Boolean); inline;
begin
if IsURL then
begin
DestBuf[0] := Ord(FCodingTableURL[((AIn1 shr 2) and 63) + 1]);
DestBuf[1] := Ord(FCodingTableURL[((AIn1 shl 4) and 63) + 1]);
end else begin
DestBuf[0] := Ord(FCodingTable[((AIn1 shr 2) and 63) + 1]);
DestBuf[1] := Ord(FCodingTable[((AIn1 shl 4) and 63) + 1]);
end;
Inc(DestBuf,2);
end;
procedure XBufferEncode64_2(var DestBuf: PByte; const AIn1, AIn2: Byte; const IsURL: Boolean); inline;
begin
if IsURL then
begin
DestBuf[0] := Ord(FCodingTableURL[((AIn1 shr 2) and 63) + 1]);
DestBuf[1] := Ord(FCodingTableURL[(((AIn1 shl 4) or (AIn2 shr 4)) and 63) + 1]);
DestBuf[2] := Ord(FCodingTableURL[((AIn2 shl 2) and 63) + 1]);
end else begin
DestBuf[0] := Ord(FCodingTable[((AIn1 shr 2) and 63) + 1]);
DestBuf[1] := Ord(FCodingTable[(((AIn1 shl 4) or (AIn2 shr 4)) and 63) + 1]);
DestBuf[2] := Ord(FCodingTable[((AIn2 shl 2) and 63) + 1]);
end;
Inc(DestBuf,3);
end;
procedure XBufferEncode64_3(var DestBuf: PByte; const AIn1, AIn2, AIn3: Byte; const IsURL: Boolean); inline;
begin
if IsURL then
begin
DestBuf[0] := Ord(FCodingTableURL[((AIn1 shr 2) and 63) + 1]);
DestBuf[1] := Ord(FCodingTableURL[(((AIn1 shl 4) or (AIn2 shr 4)) and 63) + 1]);
DestBuf[2] := Ord(FCodingTableURL[(((AIn2 shl 2) or (AIn3 shr 6)) and 63) + 1]);
DestBuf[3] := Ord(FCodingTableURL[(Ord(AIn3) and 63) + 1]);
end else begin
DestBuf[0] := Ord(FCodingTable[((AIn1 shr 2) and 63) + 1]);
DestBuf[1] := Ord(FCodingTable[(((AIn1 shl 4) or (AIn2 shr 4)) and 63) + 1]);
DestBuf[2] := Ord(FCodingTable[(((AIn2 shl 2) or (AIn3 shr 6)) and 63) + 1]);
DestBuf[3] := Ord(FCodingTable[(Ord(AIn3) and 63) + 1]);
end;
Inc(DestBuf,4);
end;
var
BufSize, BufSize3: Int32;
Ch1, Ch2, Ch3: Byte;
DestBuf, SourceBuf: PByte;
DestCapacity, DestSize: Int32;
Index, IndexCRLF : Int32;
begin
BufSize := Length(Source);
if BufSize = 0 then
Exit;
DestCapacity := GetBase64EncodedSize(BufSize, MultiLines);
DestSize := 0;
SetLength(Dest, DestCapacity);
SourceBuf := PByte(Source);
DestBuf := PByte(Dest);
IndexCRLF := 0;
Index := 0;
BufSize3 := (BufSize div 3)*3;
while Index < BufSize3 do
begin // Process the buffer up to the trailing 2 chars
Ch1 := SourceBuf[0];
Ch2 := SourceBuf[1];
Ch3 := SourceBuf[2];
SourceBuf := Pointer(PtrUInt(SourceBuf)+3);
Inc(Index, 3);
XBufferEncode64_3(DestBuf, Ch1, Ch2, Ch3, IsURL);
Inc(DestSize, 4);
if MultiLines then
begin
if (IndexCRLF = 18) and (Index < BufSize3) then // KW 20170405 BufSize -> BufSize3
begin
DestBuf[0] := Ord(#13);
DestBuf[1] := Ord(#10);
DestBuf := Pointer(PtrUInt(DestBuf)+2);
Inc(DestSize, 2);
IndexCRLF := 0;
end else
Inc(IndexCRLF);
end;
end;
if MultiLines and (IndexCRLF = 19) and (Index < BufSize) then // KW 20170405 IndexCRLF=18 -> 19
begin
DestBuf[0] := Ord(#13);
DestBuf[1] := Ord(#10);
DestBuf := Pointer(PtrUInt(DestBuf)+2);
Inc(DestSize, 2);
end;
if Index = BufSize-2 then // Last remaining 2 chars
begin
Ch1 := SourceBuf[0];
Ch2 := SourceBuf[1];
XBufferEncode64_2(DestBuf, Ch1, Ch2, IsURL);
Inc(DestSize, 3);
if Padding then
begin
DestBuf[0] := Ord('=');
Inc(DestSize);
end;
end else if Index = BufSize-1 then // Last remaining char
begin
Ch1 := Source[Index];
XBufferEncode64_1(DestBuf, Ch1, IsURL);
Inc(DestSize, 2);
if Padding then
begin
DestBuf[0] := Ord('=');
DestBuf[1] := Ord('=');
Inc(DestSize, 2);
end;
end;
SetLength(Dest,DestSize);
end;
Function BytesEncodeBase64(Source: Tbytes; const IsURL, MultiLines, Padding: Boolean) : AnsiString;
begin
BytesEncodeBase64(Source,Result,IsURL, MultiLines, Padding);
end;
type
TUInt32 = Cardinal;
PUInt32Array = ^TUInt32;
TLecuyer = record
rs1, rs2, rs3: UInt32;
SeedCount: UInt32;
procedure Seed;
function Next: UInt32;
end;
// TODO: explore Xorshift* instead of CryptoGetRandomNumber
procedure TLecuyer.Seed;
var
VLI: TVLI;
begin
EccGetRandomNumber(VLI);
rs1 := VLI[0];
rs2 := VLI[1];
rs3 := VLI[2];
SeedCount := 1;
end;
function TLecuyer.Next: UInt32;
begin
if SeedCount and $FFFF = 0 then // reseed after 256KB of output
Seed
else
Inc(SeedCount);
Result := rs1;
rs1 := ((Result and -2) shl 12) xor (((Result shl 13) xor Result) shr 19);
Result := rs2;
rs2 := ((Result and -8) shl 4) xor (((Result shl 2) xor Result) shr 25);
Result := rs3;
rs3 := ((Result and -16) shl 17) xor (((Result shl 3) xor Result) shr 11);
Result := rs1 xor rs2 xor result;
end;
function CryptoGetRandomBytes(Buffer: PByte; const Count: Integer): Boolean;
var
I, Remainder, Rounds: Integer;
Lecuyer: TLecuyer;
R: UInt32;
begin
Result := True;
Lecuyer.Seed;
Rounds := Count div SizeOf(UInt32);
for I := 0 to Rounds-1 do
PUInt32Array(Buffer)[I] := Lecuyer.Next;
Remainder := Count mod SizeOf(UInt32);
if Remainder > 0 then
begin
R := Lecuyer.Next;
Move(R, PByteArray(Buffer)[Rounds*SizeOf(UInt32)], Remainder);
end;
end;
end.
{
This file is part of the Free Component Library.
Copyright (c) 2021 by the Free Pascal team.
SHA256 and HMACSha256 routines.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit sha256;
{$mode ObjFPC}{$H+}
{$MODESWITCH advancedrecords}
interface
uses
Classes, SysUtils;
Type
TSHA256Digest = packed array[0..31] of Byte;
PSHA256Digest = ^TSHA256Digest;
PSHA256 = ^TSHA256;
TSHA256 = record
Context: array[0..7] of UInt32;
Digest: TSHA256Digest;
HashBuffer: array[0..63] of Byte;
Index: UInt32;
Length: Int64;
procedure Compress;
procedure Final;
procedure Init;
function IsEqual(const ADigest: TSHA256Digest): Boolean;
procedure OutputHexa(out Result: AnsiString);
procedure Update(PBuf: PByte; Size: UInt32); overload;
procedure Update(const Value: TBytes); overload;
end;
Const
SHA256_DIGEST_SIZE = SizeOf(TSHA256Digest); // 32
// Calculate SHA256, return digest as bytes.
procedure SHA256(const Value: TBytes; out Result: TBytes);
// Calculate SHA256, return digest as base64(url) string
procedure SHA256Base64(const Value: TBytes; const IsURL: Boolean; out Result: AnsiString);
// Calculate SHA256, return digest as HEX encoded string
procedure SHA256Hexa(const Value: TBytes; out Result: AnsiString);
// Calculate HMacSHA256, return digest as bytes.
function HMACSHA256(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; var Digest: TSHA256Digest): Boolean; overload;
function HMACSHA256(Key: PByte; KeySize: UInt32; Data: PByte; DataSize: UInt32; Data2: PByte; DataSize2: UInt32; Data3: PByte; DataSize3: UInt32; var Digest: TSHA256Digest): Boolean; overload;
// Calculate HMacSHA256, return digest as hex string.
function HMACSHA256Hexa(const Key, Data: TBytes; out SignatureHexa: AnsiString): Boolean; overload;
// Calculate HMacSHA256 from a stream, return digest.
procedure StreamSHA256(aStream: TStream; out Digest: TSHA256Digest);
function StreamSHA256(aStream: TStream): TSHA256Digest;
// Calculate HMacSHA256 from a stream, return digest as HEX-Encoded string.
procedure StreamSHA256Hexa(aStream: TStream; out Result: AnsiString);
Function StreamSHA256Hexa(aStream: TStream): AnsiString;
// Calculate HMacSHA256 from a stream, return digest as base64-encoded string.
procedure StreamSHA256Base64(aStream: TStream; isURL : Boolean; out Result: AnsiString);
Function StreamSHA256Base64(aStream: TStream; isURL : Boolean): AnsiString;
// HKDF : Derive key of desired length from a salt,input key and info (RF5869, using HMACSHA256) .
function HKDF_SHA256(const Salt, IKM, Info: TBytes; var Output: TBytes; const DesiredLen: Integer): Boolean;
implementation
uses hashutils;
//------------------------------------------------------------------------------
// SHA256
//------------------------------------------------------------------------------
procedure TSHA256.Init;
begin
Self.Index := 0;
Self.Length := 0;
FillChar(Self.HashBuffer, Sizeof(Self.HashBuffer), 0);
Self.Context[0] := $6a09e667;
Self.Context[1] := $bb67ae85;
Self.Context[2] := $3c6ef372;
Self.Context[3] := $a54ff53a;
Self.Context[4] := $510e527f;
Self.Context[5] := $9b05688c;
Self.Context[6] := $1f83d9ab;
Self.Context[7] := $5be0cd19;
end;
procedure TSHA256.Compress;
// Actual hashing function
const
K: array[0..63] of UInt32 = (
$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);
Type
TBuf64 = array[0..63] of UInt32;
var
A, B, C, D, E, F, G, H: UInt32;
W: TBuf64;
I: UInt32;
t1, t2: UInt32;
begin
w:=Default(TBuf64);
// Calculate "expanded message blocks"
Move(HashBuffer, W, Sizeof(HashBuffer));
for I := 0 to 15 do
W[I] := SwapEndian(W[I]);
for I := 16 to 63 do
W[I] := (((W[I-2] shr 17) or(W[I-2] shl 15)) xor ((W[I-2] shr 19) or (W[I-2] shl 13))
xor (W[I-2] shr 10))+W[I-7]+(((W[I-15] shr 7) or (W[I-15] shl 25))
xor ((W[I-15] shr 18) or (W[I-15] shl 14)) xor (W[I-15] shr 3))+W[I-16];
A := Context[0]; B := Context[1]; C := Context[2]; D := Context[3]; E := Context[4]; F := Context[5]; G := Context[6]; H := Context[7];
for I := 0 to High(W) do
begin
t1 := H+(((E shr 6) or (E shl 26)) xor ((E shr 11) or (E shl 21)) xor ((E shr 25) or (E shl 7)))+((E and F) xor (not E and G))+K[I]+W[I];
t2 := (((A shr 2) or (A shl 30)) xor ((A shr 13) or (A shl 19)) xor ((A shr 22) xor (A shl 10)))+((A and B) xor (A and C) xor (B and C));
H := G; G := F; F := E; E := D+t1;
D := C; C := B; B := A; A := t1+t2;
end;
Inc(Context[0], A);
Inc(Context[1], B);
Inc(Context[2], C);
Inc(Context[3], D);
Inc(Context[4], E);
Inc(Context[5], F);
Inc(Context[6], G);
Inc(Context[7], H);
end;
type
TInt64Rec = packed record
case Integer of
0: (Lo, Hi: UInt32);
1: (QuadPart: Int64);
end;
procedure TSHA256.Final;
begin
// 1. append bit '1' after Buffer
HashBuffer[Self.Index] := $80;
FillChar(HashBuffer[Self.Index+1], SizeOf(HashBuffer)-Self.Index-1, 0);
// 2. Compress if more than 448 bits, (no room for 64 bit length)
if Self.Index >= 56 then
begin
Compress;
FillChar(HashBuffer, SizeOf(HashBuffer), 0);
end;
// Write 64 bit Buffer length into the last bits of the last block
// (in big endian format) and do a final compress
PUInt32(@HashBuffer[56])^ := SwapEndian(TInt64Rec(Self.Length).Hi);
PUInt32(@HashBuffer[60])^ := SwapEndian(TInt64Rec(Self.Length).Lo);
Compress;
Context[0] := SwapEndian(Context[0]);
Context[1] := SwapEndian(Context[1]);
Context[2] := SwapEndian(Context[2]);
Context[3] := SwapEndian(Context[3]);
Context[4] := SwapEndian(Context[4]);
Context[5] := SwapEndian(Context[5]);
Context[6] := SwapEndian(Context[6]);
Context[7] := SwapEndian(Context[7]);
Move(Context, Digest, Sizeof(Context));
// Self.Init; // uncomment if you need security protection against memory inspection
end;
function TSHA256.IsEqual(const ADigest: TSHA256Digest): Boolean;
var
Left, Right: TBytes;
begin
Left:=BytesFromVar(@ADigest, SizeOf(ADigest));
Right:=BytesFromVar(@Self.Digest, SizeOf(Self.Digest));
Result:=CompareMem(Pointer(Left), Pointer(Right),System.Length(Left));
end;
procedure TSHA256.Update(PBuf: PByte; Size: UInt32);
var
Len: UInt32;
begin
Inc(Self.Length, Int64(UInt32(Size)) shl 3);
while Size > 0 do
begin
if (Sizeof(HashBuffer)-Self.Index) <= UInt32(Size) then
begin
Len := Sizeof(HashBuffer)-Self.Index;
Move(PBuf^, HashBuffer[Self.Index], Len);
Dec(Size, Len);
Inc(PBuf, Len);
Compress;
Self.Index := 0;
end else
begin
Move(PBuf^, HashBuffer[Self.Index], Size);
Inc(Self.Index, Size);
Size := 0;
end;
end;
end;
(*
procedure TSHA256.Update(const Buffer: TXBuffer);
begin
Update(PByte(Buffer.Buf), Buffer.Size);
end;
*)