Ken Johnson
bade0eb593
Standalone FidoNet mailer daemon implementing the Comet protocol (TCP variant of the Nova protocol family) with BinkP/1.1 fallback. Written in Free Pascal for DOS/Win/OS2/Linux/FreeBSD. 15 source files, ~10K lines: - Protocol: length-prefixed frames, SHA-256/384/512, CRC-32, bidirectional transfer with sliding window, adaptive block sizing - Session: own TCP handshake with BinkP auto-detection on port 26638 - Outbound: BSO (Binkley), FrontDoor, D'Bridge format support - Daemon: multi-session with thread pool, outbound scanner - Paths: DOS<->Linux bridge with case-insensitive lookup, drive mapping - Config: INI-style with heavily documented sample (COMET.SAM) All 17 Nova interop bug fixes baked in from the start. 18/18 tests passing (CRC-32, SHA-256/384/512, frame encode/decode).
804 lines
23 KiB
ObjectPascal
804 lines
23 KiB
ObjectPascal
{
|
|
Comet - Direct TCP File Transfer for FidoNet
|
|
cometsha.pas - SHA-256 and SHA-384 message digests (FIPS 180-4)
|
|
|
|
SHA-256: 32-bit state, 256-bit (32 byte) digest.
|
|
Used for file content verification (same as Nova/Xenia/Fimail).
|
|
SHA-384: 64-bit state, 384-bit (48 byte) digest.
|
|
Available for stronger hashing where needed.
|
|
|
|
Both produce big-endian digest output per FIPS standard.
|
|
SHA-256 output is byte-identical to Xenia and Fimail.
|
|
|
|
SHA-256 test vectors:
|
|
SHA256("abc") = ba7816bf 8f01cfea 414140de 5dae2223
|
|
b00361a3 96177a9c b410ff61 f20015ad
|
|
SHA-384 test vectors:
|
|
SHA384("abc") = cb00753f45a35e8b b5a03d699ac65007
|
|
272c32ab0eded163 1a8b605a43ff5bed
|
|
8086072ba1e7cc23 58baeca134c825a7
|
|
|
|
Copyright (C) 2026 Ken Johnson
|
|
License: GPL-2.0
|
|
}
|
|
unit cometsha;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
type
|
|
TSHA256Digest = array[0..31] of Byte;
|
|
|
|
TSHA256Context = record
|
|
State: array[0..7] of LongWord;
|
|
Count: array[0..7] of Byte; { 64-bit bit count, big-endian }
|
|
Done: Boolean;
|
|
DataBuf: array[0..63] of Byte;
|
|
DataLen: Byte;
|
|
end;
|
|
|
|
{ Incremental API }
|
|
procedure SHA256Init(var Ctx: TSHA256Context);
|
|
procedure SHA256Update(var Ctx: TSHA256Context; const Buf; Len: LongWord);
|
|
procedure SHA256Final(var Ctx: TSHA256Context; out Digest: TSHA256Digest);
|
|
|
|
{ One-shot convenience }
|
|
function SHA256Buffer(const Buf; Len: LongWord): TSHA256Digest;
|
|
function SHA256String(const S: string): TSHA256Digest;
|
|
|
|
{ Digest to lowercase hex string }
|
|
function SHA256DigestToHex(const Digest: TSHA256Digest): string;
|
|
|
|
{ Compare two digests, returns True if identical }
|
|
function SHA256DigestEqual(const A, B: TSHA256Digest): Boolean;
|
|
|
|
|
|
{ ---- SHA-512 family (SHA-384 and SHA-512 share the same core) ---- }
|
|
|
|
type
|
|
TSHA384Digest = array[0..47] of Byte;
|
|
TSHA512Digest = array[0..63] of Byte;
|
|
|
|
{ Shared context for SHA-384 and SHA-512 (same 64-bit core, 128-byte blocks) }
|
|
TSHA512Context = record
|
|
State: array[0..7] of QWord; { 64-bit state words }
|
|
Count: array[0..15] of Byte; { 128-bit bit count, big-endian }
|
|
Done: Boolean;
|
|
DataBuf: array[0..127] of Byte; { 128-byte block buffer }
|
|
DataLen: Byte;
|
|
end;
|
|
|
|
{ SHA-384 uses the same context type }
|
|
TSHA384Context = TSHA512Context;
|
|
|
|
{ ---- SHA-384 ---- }
|
|
procedure SHA384Init(var Ctx: TSHA384Context);
|
|
procedure SHA384Update(var Ctx: TSHA384Context; const Buf; Len: LongWord);
|
|
procedure SHA384Final(var Ctx: TSHA384Context; out Digest: TSHA384Digest);
|
|
function SHA384Buffer(const Buf; Len: LongWord): TSHA384Digest;
|
|
function SHA384String(const S: string): TSHA384Digest;
|
|
function SHA384DigestToHex(const Digest: TSHA384Digest): string;
|
|
function SHA384DigestEqual(const A, B: TSHA384Digest): Boolean;
|
|
|
|
{ ---- SHA-512 ---- }
|
|
procedure SHA512Init(var Ctx: TSHA512Context);
|
|
procedure SHA512Update(var Ctx: TSHA512Context; const Buf; Len: LongWord);
|
|
procedure SHA512Final(var Ctx: TSHA512Context; out Digest: TSHA512Digest);
|
|
function SHA512Buffer(const Buf; Len: LongWord): TSHA512Digest;
|
|
function SHA512String(const S: string): TSHA512Digest;
|
|
function SHA512DigestToHex(const Digest: TSHA512Digest): string;
|
|
function SHA512DigestEqual(const A, B: TSHA512Digest): Boolean;
|
|
|
|
|
|
implementation
|
|
|
|
const
|
|
{ Initial hash values (FIPS 180-4 section 5.3.3) }
|
|
H0 = LongWord($6a09e667); H1 = LongWord($bb67ae85);
|
|
H2 = LongWord($3c6ef372); H3 = LongWord($a54ff53a);
|
|
H4 = LongWord($510e527f); H5 = LongWord($9b05688c);
|
|
H6 = LongWord($1f83d9ab); H7 = LongWord($5be0cd19);
|
|
|
|
{ Round constants (FIPS 180-4 section 4.2.2) }
|
|
K: array[0..63] of LongWord = (
|
|
$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
|
|
);
|
|
|
|
|
|
function ROTR(X: LongWord; N: Byte): LongWord; inline;
|
|
begin
|
|
Result := (X shr N) or (X shl (32 - N));
|
|
end;
|
|
|
|
function CH(X, Y, Z: LongWord): LongWord; inline;
|
|
begin
|
|
Result := (X and Y) xor ((not X) and Z);
|
|
end;
|
|
|
|
function MAJ(X, Y, Z: LongWord): LongWord; inline;
|
|
begin
|
|
Result := (X and Y) xor (X and Z) xor (Y and Z);
|
|
end;
|
|
|
|
function BSIG0(X: LongWord): LongWord; inline;
|
|
begin
|
|
Result := ROTR(X, 2) xor ROTR(X, 13) xor ROTR(X, 22);
|
|
end;
|
|
|
|
function BSIG1(X: LongWord): LongWord; inline;
|
|
begin
|
|
Result := ROTR(X, 6) xor ROTR(X, 11) xor ROTR(X, 25);
|
|
end;
|
|
|
|
function SSIG0(X: LongWord): LongWord; inline;
|
|
begin
|
|
Result := ROTR(X, 7) xor ROTR(X, 18) xor (X shr 3);
|
|
end;
|
|
|
|
function SSIG1(X: LongWord): LongWord; inline;
|
|
begin
|
|
Result := ROTR(X, 17) xor ROTR(X, 19) xor (X shr 10);
|
|
end;
|
|
|
|
|
|
procedure SHA256Block(var Ctx: TSHA256Context; Data: PByte);
|
|
var
|
|
W: array[0..63] of LongWord;
|
|
A, B, C, D, E, F, G, HH: LongWord;
|
|
T1, T2: LongWord;
|
|
T: Integer;
|
|
begin
|
|
{ Prepare message schedule (big-endian byte order) }
|
|
for T := 0 to 15 do
|
|
W[T] := (LongWord(Data[T * 4]) shl 24) or
|
|
(LongWord(Data[T * 4 + 1]) shl 16) or
|
|
(LongWord(Data[T * 4 + 2]) shl 8) or
|
|
LongWord(Data[T * 4 + 3]);
|
|
|
|
for T := 16 to 63 do
|
|
W[T] := SSIG1(W[T - 2]) + W[T - 7] + SSIG0(W[T - 15]) + W[T - 16];
|
|
|
|
{ Initialize working variables }
|
|
A := Ctx.State[0]; B := Ctx.State[1];
|
|
C := Ctx.State[2]; D := Ctx.State[3];
|
|
E := Ctx.State[4]; F := Ctx.State[5];
|
|
G := Ctx.State[6]; HH := Ctx.State[7];
|
|
|
|
{ 64 rounds }
|
|
for T := 0 to 63 do
|
|
begin
|
|
T1 := HH + BSIG1(E) + CH(E, F, G) + K[T] + W[T];
|
|
T2 := BSIG0(A) + MAJ(A, B, C);
|
|
HH := G; G := F; F := E; E := D + T1;
|
|
D := C; C := B; B := A; A := T1 + T2;
|
|
end;
|
|
|
|
{ Add to running hash }
|
|
Ctx.State[0] := Ctx.State[0] + A;
|
|
Ctx.State[1] := Ctx.State[1] + B;
|
|
Ctx.State[2] := Ctx.State[2] + C;
|
|
Ctx.State[3] := Ctx.State[3] + D;
|
|
Ctx.State[4] := Ctx.State[4] + E;
|
|
Ctx.State[5] := Ctx.State[5] + F;
|
|
Ctx.State[6] := Ctx.State[6] + G;
|
|
Ctx.State[7] := Ctx.State[7] + HH;
|
|
end;
|
|
|
|
|
|
procedure SHA256Init(var Ctx: TSHA256Context);
|
|
begin
|
|
Ctx.State[0] := H0; Ctx.State[1] := H1;
|
|
Ctx.State[2] := H2; Ctx.State[3] := H3;
|
|
Ctx.State[4] := H4; Ctx.State[5] := H5;
|
|
Ctx.State[6] := H6; Ctx.State[7] := H7;
|
|
FillChar(Ctx.Count, 8, 0);
|
|
Ctx.Done := False;
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
|
|
|
|
procedure SHA256Update(var Ctx: TSHA256Context; const Buf; Len: LongWord);
|
|
var
|
|
P: PByte;
|
|
I: LongWord;
|
|
BitLenLo, BitLenHi: LongWord;
|
|
begin
|
|
if Ctx.Done or (Len = 0) then Exit;
|
|
P := @Buf;
|
|
|
|
{ Update 64-bit bit count (big-endian in Count[0..7]) }
|
|
BitLenLo := (LongWord(Ctx.Count[4]) shl 24) or
|
|
(LongWord(Ctx.Count[5]) shl 16) or
|
|
(LongWord(Ctx.Count[6]) shl 8) or
|
|
LongWord(Ctx.Count[7]);
|
|
BitLenHi := (LongWord(Ctx.Count[0]) shl 24) or
|
|
(LongWord(Ctx.Count[1]) shl 16) or
|
|
(LongWord(Ctx.Count[2]) shl 8) or
|
|
LongWord(Ctx.Count[3]);
|
|
|
|
BitLenLo := BitLenLo + (Len shl 3);
|
|
if BitLenLo < (Len shl 3) then Inc(BitLenHi);
|
|
BitLenHi := BitLenHi + (Len shr 29);
|
|
|
|
Ctx.Count[0] := Byte(BitLenHi shr 24);
|
|
Ctx.Count[1] := Byte(BitLenHi shr 16);
|
|
Ctx.Count[2] := Byte(BitLenHi shr 8);
|
|
Ctx.Count[3] := Byte(BitLenHi);
|
|
Ctx.Count[4] := Byte(BitLenLo shr 24);
|
|
Ctx.Count[5] := Byte(BitLenLo shr 16);
|
|
Ctx.Count[6] := Byte(BitLenLo shr 8);
|
|
Ctx.Count[7] := Byte(BitLenLo);
|
|
|
|
I := 0;
|
|
|
|
{ Fill partial buffer from previous call }
|
|
if Ctx.DataLen > 0 then
|
|
begin
|
|
while (Ctx.DataLen < 64) and (I < Len) do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := P[I];
|
|
Inc(Ctx.DataLen);
|
|
Inc(I);
|
|
end;
|
|
if Ctx.DataLen = 64 then
|
|
begin
|
|
SHA256Block(Ctx, @Ctx.DataBuf[0]);
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
end;
|
|
|
|
{ Process full 64-byte blocks directly from input }
|
|
while I + 64 <= Len do
|
|
begin
|
|
SHA256Block(Ctx, P + I);
|
|
Inc(I, 64);
|
|
end;
|
|
|
|
{ Buffer remaining bytes }
|
|
while I < Len do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := P[I];
|
|
Inc(Ctx.DataLen);
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure SHA256Final(var Ctx: TSHA256Context; out Digest: TSHA256Digest);
|
|
var
|
|
SavedCount: array[0..7] of Byte;
|
|
I: Integer;
|
|
begin
|
|
if Ctx.Done then
|
|
begin
|
|
{ Already finalized - just output state again }
|
|
for I := 0 to 7 do
|
|
begin
|
|
Digest[I * 4] := Byte(Ctx.State[I] shr 24);
|
|
Digest[I * 4 + 1] := Byte(Ctx.State[I] shr 16);
|
|
Digest[I * 4 + 2] := Byte(Ctx.State[I] shr 8);
|
|
Digest[I * 4 + 3] := Byte(Ctx.State[I]);
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
{ Save count before padding modifies it }
|
|
Move(Ctx.Count, SavedCount, 8);
|
|
|
|
{ Pad: append 0x80, then zeros, then 64-bit bit count }
|
|
Ctx.DataBuf[Ctx.DataLen] := $80;
|
|
Inc(Ctx.DataLen);
|
|
|
|
{ If not enough room for 8-byte count, pad to 64 and process }
|
|
if Ctx.DataLen > 56 then
|
|
begin
|
|
while Ctx.DataLen < 64 do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := 0;
|
|
Inc(Ctx.DataLen);
|
|
end;
|
|
SHA256Block(Ctx, @Ctx.DataBuf[0]);
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
|
|
{ Pad with zeros up to byte 56 }
|
|
while Ctx.DataLen < 56 do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := 0;
|
|
Inc(Ctx.DataLen);
|
|
end;
|
|
|
|
{ Append 64-bit bit count (big-endian) }
|
|
Move(SavedCount, Ctx.DataBuf[56], 8);
|
|
SHA256Block(Ctx, @Ctx.DataBuf[0]);
|
|
Ctx.Done := True;
|
|
|
|
{ Output digest (big-endian) }
|
|
for I := 0 to 7 do
|
|
begin
|
|
Digest[I * 4] := Byte(Ctx.State[I] shr 24);
|
|
Digest[I * 4 + 1] := Byte(Ctx.State[I] shr 16);
|
|
Digest[I * 4 + 2] := Byte(Ctx.State[I] shr 8);
|
|
Digest[I * 4 + 3] := Byte(Ctx.State[I]);
|
|
end;
|
|
end;
|
|
|
|
|
|
function SHA256Buffer(const Buf; Len: LongWord): TSHA256Digest;
|
|
var
|
|
Ctx: TSHA256Context;
|
|
begin
|
|
SHA256Init(Ctx);
|
|
SHA256Update(Ctx, Buf, Len);
|
|
SHA256Final(Ctx, Result);
|
|
end;
|
|
|
|
function SHA256String(const S: string): TSHA256Digest;
|
|
begin
|
|
if Length(S) > 0 then
|
|
Result := SHA256Buffer(S[1], LongWord(Length(S)))
|
|
else
|
|
Result := SHA256Buffer(S, 0);
|
|
end;
|
|
|
|
function SHA256DigestToHex(const Digest: TSHA256Digest): string;
|
|
const
|
|
HexChars: array[0..15] of Char = '0123456789abcdef';
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetLength(Result, 64);
|
|
for I := 0 to 31 do
|
|
begin
|
|
Result[I * 2 + 1] := HexChars[(Digest[I] shr 4) and $0F];
|
|
Result[I * 2 + 2] := HexChars[Digest[I] and $0F];
|
|
end;
|
|
end;
|
|
|
|
function SHA256DigestEqual(const A, B: TSHA256Digest): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to 31 do
|
|
begin
|
|
if A[I] <> B[I] then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ ======================================================================== }
|
|
{ SHA-512 family (shared core for SHA-384 and SHA-512) }
|
|
{ Uses 64-bit state words (QWord), 128-byte blocks, 80 rounds. }
|
|
{ ======================================================================== }
|
|
|
|
const
|
|
{ SHA-512 round constants (FIPS 180-4 section 4.2.3) }
|
|
K512: array[0..79] of QWord = (
|
|
QWord($428a2f98d728ae22), QWord($7137449123ef65cd),
|
|
QWord($b5c0fbcfec4d3b2f), QWord($e9b5dba58189dbbc),
|
|
QWord($3956c25bf348b538), QWord($59f111f1b605d019),
|
|
QWord($923f82a4af194f9b), QWord($ab1c5ed5da6d8118),
|
|
QWord($d807aa98a3030242), QWord($12835b0145706fbe),
|
|
QWord($243185be4ee4b28c), QWord($550c7dc3d5ffb4e2),
|
|
QWord($72be5d74f27b896f), QWord($80deb1fe3b1696b1),
|
|
QWord($9bdc06a725c71235), QWord($c19bf174cf692694),
|
|
QWord($e49b69c19ef14ad2), QWord($efbe4786384f25e3),
|
|
QWord($0fc19dc68b8cd5b5), QWord($240ca1cc77ac9c65),
|
|
QWord($2de92c6f592b0275), QWord($4a7484aa6ea6e483),
|
|
QWord($5cb0a9dcbd41fbd4), QWord($76f988da831153b5),
|
|
QWord($983e5152ee66dfab), QWord($a831c66d2db43210),
|
|
QWord($b00327c898fb213f), QWord($bf597fc7beef0ee4),
|
|
QWord($c6e00bf33da88fc2), QWord($d5a79147930aa725),
|
|
QWord($06ca6351e003826f), QWord($142929670a0e6e70),
|
|
QWord($27b70a8546d22ffc), QWord($2e1b21385c26c926),
|
|
QWord($4d2c6dfc5ac42aed), QWord($53380d139d95b3df),
|
|
QWord($650a73548baf63de), QWord($766a0abb3c77b2a8),
|
|
QWord($81c2c92e47edaee6), QWord($92722c851482353b),
|
|
QWord($a2bfe8a14cf10364), QWord($a81a664bbc423001),
|
|
QWord($c24b8b70d0f89791), QWord($c76c51a30654be30),
|
|
QWord($d192e819d6ef5218), QWord($d69906245565a910),
|
|
QWord($f40e35855771202a), QWord($106aa07032bbd1b8),
|
|
QWord($19a4c116b8d2d0c8), QWord($1e376c085141ab53),
|
|
QWord($2748774cdf8eeb99), QWord($34b0bcb5e19b48a8),
|
|
QWord($391c0cb3c5c95a63), QWord($4ed8aa4ae3418acb),
|
|
QWord($5b9cca4f7763e373), QWord($682e6ff3d6b2b8a3),
|
|
QWord($748f82ee5defb2fc), QWord($78a5636f43172f60),
|
|
QWord($84c87814a1f0ab72), QWord($8cc702081a6439ec),
|
|
QWord($90befffa23631e28), QWord($a4506cebde82bde9),
|
|
QWord($bef9a3f7b2c67915), QWord($c67178f2e372532b),
|
|
QWord($ca273eceea26619c), QWord($d186b8c721c0c207),
|
|
QWord($eada7dd6cde0eb1e), QWord($f57d4f7fee6ed178),
|
|
QWord($06f067aa72176fba), QWord($0a637dc5a2c898a6),
|
|
QWord($113f9804bef90dae), QWord($1b710b35131c471b),
|
|
QWord($28db77f523047d84), QWord($32caab7b40c72493),
|
|
QWord($3c9ebe0a15c9bebc), QWord($431d67c49c100d4c),
|
|
QWord($4cc5d4becb3e42b6), QWord($597f299cfc657e2a),
|
|
QWord($5fcb6fab3ad6faec), QWord($6c44198c4a475817)
|
|
);
|
|
|
|
|
|
function ROTR64(X: QWord; N: Byte): QWord; inline;
|
|
begin
|
|
Result := (X shr N) or (X shl (64 - N));
|
|
end;
|
|
|
|
function CH64(X, Y, Z: QWord): QWord; inline;
|
|
begin
|
|
Result := (X and Y) xor ((not X) and Z);
|
|
end;
|
|
|
|
function MAJ64(X, Y, Z: QWord): QWord; inline;
|
|
begin
|
|
Result := (X and Y) xor (X and Z) xor (Y and Z);
|
|
end;
|
|
|
|
function BSIG0_64(X: QWord): QWord; inline;
|
|
begin
|
|
Result := ROTR64(X, 28) xor ROTR64(X, 34) xor ROTR64(X, 39);
|
|
end;
|
|
|
|
function BSIG1_64(X: QWord): QWord; inline;
|
|
begin
|
|
Result := ROTR64(X, 14) xor ROTR64(X, 18) xor ROTR64(X, 41);
|
|
end;
|
|
|
|
function SSIG0_64(X: QWord): QWord; inline;
|
|
begin
|
|
Result := ROTR64(X, 1) xor ROTR64(X, 8) xor (X shr 7);
|
|
end;
|
|
|
|
function SSIG1_64(X: QWord): QWord; inline;
|
|
begin
|
|
Result := ROTR64(X, 19) xor ROTR64(X, 61) xor (X shr 6);
|
|
end;
|
|
|
|
|
|
procedure SHA512Block(var Ctx: TSHA512Context; Data: PByte);
|
|
var
|
|
W: array[0..79] of QWord;
|
|
A, B, C, D, E, F, G, HH: QWord;
|
|
T1, T2: QWord;
|
|
T: Integer;
|
|
begin
|
|
{ Prepare message schedule (big-endian, 64-bit words) }
|
|
for T := 0 to 15 do
|
|
W[T] := (QWord(Data[T * 8]) shl 56) or
|
|
(QWord(Data[T * 8 + 1]) shl 48) or
|
|
(QWord(Data[T * 8 + 2]) shl 40) or
|
|
(QWord(Data[T * 8 + 3]) shl 32) or
|
|
(QWord(Data[T * 8 + 4]) shl 24) or
|
|
(QWord(Data[T * 8 + 5]) shl 16) or
|
|
(QWord(Data[T * 8 + 6]) shl 8) or
|
|
QWord(Data[T * 8 + 7]);
|
|
|
|
for T := 16 to 79 do
|
|
W[T] := SSIG1_64(W[T - 2]) + W[T - 7] + SSIG0_64(W[T - 15]) + W[T - 16];
|
|
|
|
A := Ctx.State[0]; B := Ctx.State[1];
|
|
C := Ctx.State[2]; D := Ctx.State[3];
|
|
E := Ctx.State[4]; F := Ctx.State[5];
|
|
G := Ctx.State[6]; HH := Ctx.State[7];
|
|
|
|
for T := 0 to 79 do
|
|
begin
|
|
T1 := HH + BSIG1_64(E) + CH64(E, F, G) + K512[T] + W[T];
|
|
T2 := BSIG0_64(A) + MAJ64(A, B, C);
|
|
HH := G; G := F; F := E; E := D + T1;
|
|
D := C; C := B; B := A; A := T1 + T2;
|
|
end;
|
|
|
|
Ctx.State[0] := Ctx.State[0] + A;
|
|
Ctx.State[1] := Ctx.State[1] + B;
|
|
Ctx.State[2] := Ctx.State[2] + C;
|
|
Ctx.State[3] := Ctx.State[3] + D;
|
|
Ctx.State[4] := Ctx.State[4] + E;
|
|
Ctx.State[5] := Ctx.State[5] + F;
|
|
Ctx.State[6] := Ctx.State[6] + G;
|
|
Ctx.State[7] := Ctx.State[7] + HH;
|
|
end;
|
|
|
|
|
|
{ Shared Update for SHA-384/512 (128-byte blocks) }
|
|
procedure SHA512FamilyUpdate(var Ctx: TSHA512Context; const Buf; Len: LongWord);
|
|
var
|
|
P: PByte;
|
|
I: LongWord;
|
|
BitLenLo, BitLenHi: QWord;
|
|
begin
|
|
if Ctx.Done or (Len = 0) then Exit;
|
|
P := @Buf;
|
|
|
|
{ Update 128-bit bit count (big-endian in Count[0..15]).
|
|
We only use the low 64 bits since files won't exceed 2^64 bits. }
|
|
BitLenLo := (QWord(Ctx.Count[8]) shl 56) or (QWord(Ctx.Count[9]) shl 48) or
|
|
(QWord(Ctx.Count[10]) shl 40) or (QWord(Ctx.Count[11]) shl 32) or
|
|
(QWord(Ctx.Count[12]) shl 24) or (QWord(Ctx.Count[13]) shl 16) or
|
|
(QWord(Ctx.Count[14]) shl 8) or QWord(Ctx.Count[15]);
|
|
BitLenHi := (QWord(Ctx.Count[0]) shl 56) or (QWord(Ctx.Count[1]) shl 48) or
|
|
(QWord(Ctx.Count[2]) shl 40) or (QWord(Ctx.Count[3]) shl 32) or
|
|
(QWord(Ctx.Count[4]) shl 24) or (QWord(Ctx.Count[5]) shl 16) or
|
|
(QWord(Ctx.Count[6]) shl 8) or QWord(Ctx.Count[7]);
|
|
|
|
BitLenLo := BitLenLo + QWord(Len) * 8;
|
|
if BitLenLo < QWord(Len) * 8 then Inc(BitLenHi);
|
|
|
|
Ctx.Count[0] := Byte(BitLenHi shr 56); Ctx.Count[1] := Byte(BitLenHi shr 48);
|
|
Ctx.Count[2] := Byte(BitLenHi shr 40); Ctx.Count[3] := Byte(BitLenHi shr 32);
|
|
Ctx.Count[4] := Byte(BitLenHi shr 24); Ctx.Count[5] := Byte(BitLenHi shr 16);
|
|
Ctx.Count[6] := Byte(BitLenHi shr 8); Ctx.Count[7] := Byte(BitLenHi);
|
|
Ctx.Count[8] := Byte(BitLenLo shr 56); Ctx.Count[9] := Byte(BitLenLo shr 48);
|
|
Ctx.Count[10] := Byte(BitLenLo shr 40); Ctx.Count[11] := Byte(BitLenLo shr 32);
|
|
Ctx.Count[12] := Byte(BitLenLo shr 24); Ctx.Count[13] := Byte(BitLenLo shr 16);
|
|
Ctx.Count[14] := Byte(BitLenLo shr 8); Ctx.Count[15] := Byte(BitLenLo);
|
|
|
|
I := 0;
|
|
|
|
{ Fill partial buffer }
|
|
if Ctx.DataLen > 0 then
|
|
begin
|
|
while (Ctx.DataLen < 128) and (I < Len) do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := P[I];
|
|
Inc(Ctx.DataLen);
|
|
Inc(I);
|
|
end;
|
|
if Ctx.DataLen = 128 then
|
|
begin
|
|
SHA512Block(Ctx, @Ctx.DataBuf[0]);
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
end;
|
|
|
|
{ Process full 128-byte blocks }
|
|
while I + 128 <= Len do
|
|
begin
|
|
SHA512Block(Ctx, P + I);
|
|
Inc(I, 128);
|
|
end;
|
|
|
|
{ Buffer remaining }
|
|
while I < Len do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := P[I];
|
|
Inc(Ctx.DataLen);
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ Shared Final for SHA-384/512. DigestLen is 48 for SHA-384, 64 for SHA-512. }
|
|
procedure SHA512FamilyFinal(var Ctx: TSHA512Context; out Digest; DigestLen: Integer);
|
|
var
|
|
SavedCount: array[0..15] of Byte;
|
|
I: Integer;
|
|
D: PByte;
|
|
begin
|
|
D := @Digest;
|
|
|
|
if Ctx.Done then
|
|
begin
|
|
for I := 0 to (DigestLen div 8) - 1 do
|
|
begin
|
|
D[I * 8] := Byte(Ctx.State[I] shr 56);
|
|
D[I * 8 + 1] := Byte(Ctx.State[I] shr 48);
|
|
D[I * 8 + 2] := Byte(Ctx.State[I] shr 40);
|
|
D[I * 8 + 3] := Byte(Ctx.State[I] shr 32);
|
|
D[I * 8 + 4] := Byte(Ctx.State[I] shr 24);
|
|
D[I * 8 + 5] := Byte(Ctx.State[I] shr 16);
|
|
D[I * 8 + 6] := Byte(Ctx.State[I] shr 8);
|
|
D[I * 8 + 7] := Byte(Ctx.State[I]);
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
Move(Ctx.Count, SavedCount, 16);
|
|
|
|
{ Pad: 0x80 + zeros + 128-bit count }
|
|
Ctx.DataBuf[Ctx.DataLen] := $80;
|
|
Inc(Ctx.DataLen);
|
|
|
|
if Ctx.DataLen > 112 then
|
|
begin
|
|
while Ctx.DataLen < 128 do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := 0;
|
|
Inc(Ctx.DataLen);
|
|
end;
|
|
SHA512Block(Ctx, @Ctx.DataBuf[0]);
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
|
|
while Ctx.DataLen < 112 do
|
|
begin
|
|
Ctx.DataBuf[Ctx.DataLen] := 0;
|
|
Inc(Ctx.DataLen);
|
|
end;
|
|
|
|
Move(SavedCount, Ctx.DataBuf[112], 16);
|
|
SHA512Block(Ctx, @Ctx.DataBuf[0]);
|
|
Ctx.Done := True;
|
|
|
|
{ Output digest (big-endian, 64-bit words) }
|
|
for I := 0 to (DigestLen div 8) - 1 do
|
|
begin
|
|
D[I * 8] := Byte(Ctx.State[I] shr 56);
|
|
D[I * 8 + 1] := Byte(Ctx.State[I] shr 48);
|
|
D[I * 8 + 2] := Byte(Ctx.State[I] shr 40);
|
|
D[I * 8 + 3] := Byte(Ctx.State[I] shr 32);
|
|
D[I * 8 + 4] := Byte(Ctx.State[I] shr 24);
|
|
D[I * 8 + 5] := Byte(Ctx.State[I] shr 16);
|
|
D[I * 8 + 6] := Byte(Ctx.State[I] shr 8);
|
|
D[I * 8 + 7] := Byte(Ctx.State[I]);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ ---- SHA-384 public API ---- }
|
|
|
|
procedure SHA384Init(var Ctx: TSHA384Context);
|
|
begin
|
|
{ SHA-384 initial values (FIPS 180-4 section 5.3.4) }
|
|
Ctx.State[0] := QWord($cbbb9d5dc1059ed8);
|
|
Ctx.State[1] := QWord($629a292a367cd507);
|
|
Ctx.State[2] := QWord($9159015a3070dd17);
|
|
Ctx.State[3] := QWord($152fecd8f70e5939);
|
|
Ctx.State[4] := QWord($67332667ffc00b31);
|
|
Ctx.State[5] := QWord($8eb44a8768581511);
|
|
Ctx.State[6] := QWord($db0c2e0d64f98fa7);
|
|
Ctx.State[7] := QWord($47b5481dbefa4fa4);
|
|
FillChar(Ctx.Count, 16, 0);
|
|
Ctx.Done := False;
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
|
|
procedure SHA384Update(var Ctx: TSHA384Context; const Buf; Len: LongWord);
|
|
begin
|
|
SHA512FamilyUpdate(Ctx, Buf, Len);
|
|
end;
|
|
|
|
procedure SHA384Final(var Ctx: TSHA384Context; out Digest: TSHA384Digest);
|
|
begin
|
|
SHA512FamilyFinal(Ctx, Digest, 48);
|
|
end;
|
|
|
|
function SHA384Buffer(const Buf; Len: LongWord): TSHA384Digest;
|
|
var
|
|
Ctx: TSHA384Context;
|
|
begin
|
|
SHA384Init(Ctx);
|
|
SHA384Update(Ctx, Buf, Len);
|
|
SHA384Final(Ctx, Result);
|
|
end;
|
|
|
|
function SHA384String(const S: string): TSHA384Digest;
|
|
begin
|
|
if Length(S) > 0 then
|
|
Result := SHA384Buffer(S[1], LongWord(Length(S)))
|
|
else
|
|
Result := SHA384Buffer(S, 0);
|
|
end;
|
|
|
|
function SHA384DigestToHex(const Digest: TSHA384Digest): string;
|
|
const
|
|
HexChars: array[0..15] of Char = '0123456789abcdef';
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetLength(Result, 96);
|
|
for I := 0 to 47 do
|
|
begin
|
|
Result[I * 2 + 1] := HexChars[(Digest[I] shr 4) and $0F];
|
|
Result[I * 2 + 2] := HexChars[Digest[I] and $0F];
|
|
end;
|
|
end;
|
|
|
|
function SHA384DigestEqual(const A, B: TSHA384Digest): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to 47 do
|
|
if A[I] <> B[I] then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ ---- SHA-512 public API ---- }
|
|
|
|
procedure SHA512Init(var Ctx: TSHA512Context);
|
|
begin
|
|
{ SHA-512 initial values (FIPS 180-4 section 5.3.5) }
|
|
Ctx.State[0] := QWord($6a09e667f3bcc908);
|
|
Ctx.State[1] := QWord($bb67ae8584caa73b);
|
|
Ctx.State[2] := QWord($3c6ef372fe94f82b);
|
|
Ctx.State[3] := QWord($a54ff53a5f1d36f1);
|
|
Ctx.State[4] := QWord($510e527fade682d1);
|
|
Ctx.State[5] := QWord($9b05688c2b3e6c1f);
|
|
Ctx.State[6] := QWord($1f83d9abfb41bd6b);
|
|
Ctx.State[7] := QWord($5be0cd19137e2179);
|
|
FillChar(Ctx.Count, 16, 0);
|
|
Ctx.Done := False;
|
|
Ctx.DataLen := 0;
|
|
end;
|
|
|
|
procedure SHA512Update(var Ctx: TSHA512Context; const Buf; Len: LongWord);
|
|
begin
|
|
SHA512FamilyUpdate(Ctx, Buf, Len);
|
|
end;
|
|
|
|
procedure SHA512Final(var Ctx: TSHA512Context; out Digest: TSHA512Digest);
|
|
begin
|
|
SHA512FamilyFinal(Ctx, Digest, 64);
|
|
end;
|
|
|
|
function SHA512Buffer(const Buf; Len: LongWord): TSHA512Digest;
|
|
var
|
|
Ctx: TSHA512Context;
|
|
begin
|
|
SHA512Init(Ctx);
|
|
SHA512Update(Ctx, Buf, Len);
|
|
SHA512Final(Ctx, Result);
|
|
end;
|
|
|
|
function SHA512String(const S: string): TSHA512Digest;
|
|
begin
|
|
if Length(S) > 0 then
|
|
Result := SHA512Buffer(S[1], LongWord(Length(S)))
|
|
else
|
|
Result := SHA512Buffer(S, 0);
|
|
end;
|
|
|
|
function SHA512DigestToHex(const Digest: TSHA512Digest): string;
|
|
const
|
|
HexChars: array[0..15] of Char = '0123456789abcdef';
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetLength(Result, 128);
|
|
for I := 0 to 63 do
|
|
begin
|
|
Result[I * 2 + 1] := HexChars[(Digest[I] shr 4) and $0F];
|
|
Result[I * 2 + 2] := HexChars[Digest[I] and $0F];
|
|
end;
|
|
end;
|
|
|
|
function SHA512DigestEqual(const A, B: TSHA512Digest): Boolean;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := True;
|
|
for I := 0 to 63 do
|
|
if A[I] <> B[I] then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|