Password-Manager/delphi-backend/Source/PM.Crypto.pas

unit PM.Crypto;

{
  Cryptographic primitives for the password manager backend.

  - RandomBytes: cryptographically secure via Windows CNG (BCryptGenRandom)
  - SHA256Hex / SHA256Bytes: identical to PHP hash('sha256', ...)
  - PBKDF2_SHA256_Hex: identical to PHP hash_pbkdf2('sha256', pwd, salt, iters)
  - ConstantTimeEquals: timing-safe comparison (api.php uses hash_equals())
  - BytesToHex / HexToBytes: PHP bin2hex / hex2bin equivalents

  NOTE on bcrypt: PHP api.php hashes new passwords with PASSWORD_BCRYPT.
  This Delphi backend does NOT implement bcrypt verification yet (would take
  ~250 lines for Blowfish + EKS). Accounts created here use pbkdf2 — which
  PHP knows how to verify and migrate. Bcrypt accounts from PHP cannot login
  here yet; the auth handler returns a clear error in that case.
}

interface

uses
  System.SysUtils, System.Classes, System.NetEncoding,
  System.Hash;

function RandomBytes(ALen: Integer): TBytes;
function RandomHex(AByteLen: Integer): string;

function BytesToHex(const ABytes: TBytes): string;
function HexToBytes(const AHex: string): TBytes;

function SHA256Hex(const AInput: string): string; overload;
function SHA256Hex(const AInput: TBytes): string; overload;

function PBKDF2_SHA256_Hex(const APassword, ASaltHex: string;
  AIterations: Integer; ADKLenBytes: Integer = 32): string;

// Sanity check at unit initialization — verifies PBKDF2-HMAC-SHA256 matches
// the reference (PHP-equivalent) output. Raises if implementation drifts.
procedure SelfTestCrypto;

function ConstantTimeEquals(const A, B: string): Boolean;

implementation

uses
  Winapi.Windows;

// ===== Windows CNG random ====================================================

const
  BCRYPT_USE_SYSTEM_PREFERRED_RNG = $00000002;

function BCryptGenRandom(hAlgorithm: Pointer; pbBuffer: PByte;
  cbBuffer: ULONG; dwFlags: ULONG): NTSTATUS; stdcall;
  external 'bcrypt.dll' name 'BCryptGenRandom';

function RandomBytes(ALen: Integer): TBytes;
var
  LStatus: NTSTATUS;
begin
  SetLength(Result, ALen);
  if ALen = 0 then Exit;
  LStatus := BCryptGenRandom(nil, @Result[0], ALen,
    BCRYPT_USE_SYSTEM_PREFERRED_RNG);
  if LStatus <> 0 then
    raise Exception.CreateFmt('BCryptGenRandom failed (0x%x)', [LStatus]);
end;

function RandomHex(AByteLen: Integer): string;
begin
  Result := BytesToHex(RandomBytes(AByteLen));
end;

// ===== Hex helpers (PHP bin2hex / hex2bin) ===================================

function BytesToHex(const ABytes: TBytes): string;
const
  HEX: array[0..15] of Char =
    ('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
var
  I: Integer;
begin
  SetLength(Result, Length(ABytes) * 2);
  for I := 0 to High(ABytes) do
  begin
    Result[(I * 2) + 1] := HEX[ABytes[I] shr 4];
    Result[(I * 2) + 2] := HEX[ABytes[I] and $0F];
  end;
end;

function HexCharToInt(C: Char): Integer; inline;
begin
  case C of
    '0'..'9': Result := Ord(C) - Ord('0');
    'a'..'f': Result := Ord(C) - Ord('a') + 10;
    'A'..'F': Result := Ord(C) - Ord('A') + 10;
  else
    raise Exception.Create('Invalid hex character: ' + C);
  end;
end;

function HexToBytes(const AHex: string): TBytes;
var
  I, LLen: Integer;
begin
  LLen := Length(AHex);
  if Odd(LLen) then
    raise Exception.Create('Hex string has odd length');
  SetLength(Result, LLen div 2);
  for I := 0 to High(Result) do
    Result[I] := (HexCharToInt(AHex[(I * 2) + 1]) shl 4) or
                  HexCharToInt(AHex[(I * 2) + 2]);
end;

// ===== SHA256 ================================================================

function SHA256Hex(const AInput: string): string;
begin
  Result := LowerCase(THashSHA2.GetHashString(AInput, THashSHA2.TSHA2Version.SHA256));
end;

function SHA256Hex(const AInput: TBytes): string;
var
  H: THashSHA2;
begin
  H := THashSHA2.Create(THashSHA2.TSHA2Version.SHA256);
  if Length(AInput) > 0 then
    H.Update(AInput);
  Result := LowerCase(BytesToHex(H.HashAsBytes));
end;

// ===== PBKDF2-SHA256 =========================================================
// Matches PHP hash_pbkdf2('sha256', $password, $salt, $iterations) which
// returns lowercase hex. $salt is whatever bytes you pass — api.php stores
// salt as bin2hex(random_bytes(32)), then passes that hex STRING as the salt
// argument to hash_pbkdf2. So the "salt" fed to PBKDF2 is the 64-char hex
// representation, NOT the 32 raw bytes. We replicate that quirk here.

// Manual HMAC-SHA256 — avoid any ambiguity with System.Hash overloads.
// Verified against RFC 4231 test vectors.
function HMAC_SHA256(const AKey, AMsg: TBytes): TBytes;
const
  BLOCK = 64;  // SHA256 block size in bytes
var
  LKey, LIpad, LOpad, LInner: TBytes;
  I: Integer;
  H: THashSHA2;
begin
  // Step 1: derive working key
  LKey := Copy(AKey, 0, Length(AKey));
  if Length(LKey) > BLOCK then
  begin
    H := THashSHA2.Create(THashSHA2.TSHA2Version.SHA256);
    H.Update(LKey);
    LKey := H.HashAsBytes;
  end;
  if Length(LKey) < BLOCK then
    SetLength(LKey, BLOCK);  // zero-padded to block size

  // Step 2: inner & outer pads
  SetLength(LIpad, BLOCK);
  SetLength(LOpad, BLOCK);
  for I := 0 to BLOCK - 1 do
  begin
    LIpad[I] := LKey[I] xor $36;
    LOpad[I] := LKey[I] xor $5C;
  end;

  // Step 3: inner = SHA256(ipad || msg)
  H := THashSHA2.Create(THashSHA2.TSHA2Version.SHA256);
  H.Update(LIpad);
  if Length(AMsg) > 0 then H.Update(AMsg);
  LInner := H.HashAsBytes;

  // Step 4: result = SHA256(opad || inner)
  H := THashSHA2.Create(THashSHA2.TSHA2Version.SHA256);
  H.Update(LOpad);
  H.Update(LInner);
  Result := H.HashAsBytes;
end;

function PBKDF2_SHA256_Hex(const APassword, ASaltHex: string;
  AIterations: Integer; ADKLenBytes: Integer): string;
var
  LPwd, LSalt, LU, LT, LBlock: TBytes;
  LBlocks, I, J, K: Integer;
  LCtr: array[0..3] of Byte;
  LOut: TBytes;
begin
  LPwd := TEncoding.UTF8.GetBytes(APassword);
  // PHP behavior: pass salt argument as-is. api.php passes the hex string,
  // so HMAC sees the ascii bytes of the hex.
  LSalt := TEncoding.UTF8.GetBytes(ASaltHex);

  LBlocks := (ADKLenBytes + 31) div 32;  // SHA256 block = 32 bytes
  SetLength(LOut, 0);

  for I := 1 to LBlocks do
  begin
    LCtr[0] := (I shr 24) and $FF;
    LCtr[1] := (I shr 16) and $FF;
    LCtr[2] := (I shr 8)  and $FF;
    LCtr[3] :=  I         and $FF;

    SetLength(LBlock, Length(LSalt) + 4);
    if Length(LSalt) > 0 then
      Move(LSalt[0], LBlock[0], Length(LSalt));
    Move(LCtr[0], LBlock[Length(LSalt)], 4);

    LU := HMAC_SHA256(LPwd, LBlock);
    LT := Copy(LU, 0, Length(LU));

    for J := 2 to AIterations do
    begin
      LU := HMAC_SHA256(LPwd, LU);
      for K := 0 to High(LT) do
        LT[K] := LT[K] xor LU[K];
    end;

    LOut := LOut + LT;
  end;

  SetLength(LOut, ADKLenBytes);
  Result := BytesToHex(LOut);
end;

// ===== Timing-safe compare ===================================================

function ConstantTimeEquals(const A, B: string): Boolean;
var
  I, LDiff, LLen: Integer;
begin
  LLen := Length(A);
  if Length(B) <> LLen then Exit(False);
  LDiff := 0;
  for I := 1 to LLen do
    LDiff := LDiff or (Ord(A[I]) xor Ord(B[I]));
  Result := LDiff = 0;
end;

// ===== Self-test =============================================================

procedure SelfTestCrypto;
const
  // Test vector: password='password', salt='salt', iters=1, dkLen=32, sha256
  // Independently verified: matches PHP hash_pbkdf2('sha256','password','salt',1)
  EXPECTED_1     = '120fb6cffcf8b32c43e7225256c4f837a86548c92ccc35480805987cb70be17b';
  // Same with iterations=2
  EXPECTED_2     = 'ae4d0c95af6b46d32d0adff928f06dd02a303f8ef3c251dfd6e2d85a95474c43';
var
  Got1, Got2: string;
begin
  Got1 := PBKDF2_SHA256_Hex('password', 'salt', 1, 32);
  if not SameText(Got1, EXPECTED_1) then
    raise Exception.CreateFmt(
      'PBKDF2 self-test FAILED (iters=1):'#10'  expected %s'#10'  got      %s',
      [EXPECTED_1, Got1]);

  Got2 := PBKDF2_SHA256_Hex('password', 'salt', 2, 32);
  if not SameText(Got2, EXPECTED_2) then
    raise Exception.CreateFmt(
      'PBKDF2 self-test FAILED (iters=2):'#10'  expected %s'#10'  got      %s',
      [EXPECTED_2, Got2]);
end;

initialization
  SelfTestCrypto;

end.