Files
Password-Manager/delphi-backend/Handlers/PM.Handler.Auth.pas
T
Zaki 60aa106a30 fix(crypto): SHA-256 wrap auth hash so vault.db at rest no longer = AES key
THE PROBLEM
===========
Before this commit, users.password_hash stored on the server contained
PBKDF2(pw, salt, iters) in hex — the exact same 32 bytes the client
uses as the AES-GCM key to encrypt every entry. Anyone who got hold of
vault.db (filesystem access, backup leak, etc.) had the encryption key
in their hand, no brute force needed. The increased PBKDF2 iteration
count from the previous commit helped against the cipher-text path,
but the easier path was right there in the user row.

THE FIX
=======
Wrap the PBKDF2 output in SHA-256 before storing:

  password_hash = SHA256(PBKDF2(pw, salt, iters))

SHA-256 is one-way. The stored hash can still be verified at login
(server recomputes PBKDF2 from the posted master pw, then SHA-256s it,
compares to stored), but the AES key can no longer be recovered from
it. At rest, vault.db only contains an irreversible derivative.

The server still sees pw transiently during /login while computing
the comparison — eliminating that requires a redesigned auth
protocol where the client sends a pre-computed verifier (SRP, OPAQUE,
or simply SHA-256(PBKDF2(pw, salt, iters)) sent from the client).
That's a separate, larger refactor. This commit closes the at-rest
hole, which is the realistic attack surface for vault file leaks.

SCHEMA / MARKER
===============
users.hash_algo distinguishes the two schemes:
  'pbkdf2'        — LEGACY (raw hex, = AES key)
  'pbkdf2-sha256' — CURRENT (SHA-256-wrapped, one-way)

A constant HASH_ALGO_CURRENT replaces the string literal everywhere
to avoid silent drift between the writer and the reader sides.

MIGRATION
=========
Folded into the existing /migrate-kdf endpoint introduced for the
100k→600k iteration bump. Login response now signals migration on
EITHER:
  - kdf_iterations < PBKDF2_ITERATIONS_TARGET, OR
  - hash_algo != 'pbkdf2-sha256'

The endpoint handles both transitions in one atomic transaction:
  UPDATE users SET password_hash = SHA256(PBKDF2(pw, salt, 600k)),
                   kdf_iterations = 600000,
                   hash_algo = 'pbkdf2-sha256'
  UPDATE vault_entries SET encrypted_password, iv (per entry, if KDF changed)

Idempotency tightened: the "already at target" short-circuit now
requires BOTH conditions, not just the iteration count. Without this,
users who migrated KDF before this commit landed would have been
stuck on the legacy hash format.

CLIENT
======
runKdfMigration() branches on whether the KDF actually changed:
  - kdfChange (fromIters !== toIters): re-encrypt all entries with the
    new key, send them in the entries array, swap state.cryptoKey on
    success. Shows "Vault security upgraded" toast.
  - !kdfChange (hash format only): skip the entry re-encryption loop
    entirely, send entries: []. Silent — the user didn't perceive a
    weakness change worth toasting about.

LOGIN / REAUTH
==============
Both now branch on hash_algo to pick the right verifier:
  HASH_ALGO_LEGACY  → ConstantTimeEquals(stored, PBKDF2(pw, salt, iters))
  HASH_ALGO_CURRENT → ConstantTimeEquals(stored, SHA256(PBKDF2(pw, salt, iters)))

Same constant-time comparison helper as before. Same legacy bcrypt
fallback (still 501-not-implemented).

ALL THREE SCENARIOS AFTER THIS COMMIT
=====================================
1. New register: starts at HASH_ALGO_CURRENT + 600k. No migration ever.
2. Legacy 100k + 'pbkdf2': full migration on next login (hash format
   + iter count + entry re-encryption) in one transaction.
3. Mid-state (already-migrated KDF + still-'pbkdf2'): hash format
   upgrade only on next login, no entry re-encryption.
2026-05-23 05:19:39 +01:00

637 lines
22 KiB
ObjectPascal

unit PM.Handler.Auth;
(*
/register POST body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
/login POST body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
/logout POST auth + csrf -> {message}
/reauth POST auth + csrf + body{masterPassword} -> {message}
Hashing strategy:
- Delphi creates new accounts with PBKDF2-SHA256 100k iterations (hash_algo='pbkdf2'),
same format as PHP hash_pbkdf2. PHP can verify these too.
- For login, we read hash_algo:
pbkdf2 -> verify natively
bcrypt -> reject with clear message (bcrypt verify not implemented yet)
*)
interface
implementation
uses
System.SysUtils, System.JSON, System.Classes,
FireDAC.Comp.Client,
IdCustomHTTPServer,
PM.Router, PM.JSON, PM.Database, PM.Crypto,
PM.Session, PM.RateLimit, PM.Audit;
const
// Legacy iteration count from the initial 2025 release. Kept around to
// verify pre-migration login attempts (each user row records its own
// value in users.kdf_iterations). New code paths should reference
// PBKDF2_ITERATIONS_TARGET instead.
PBKDF2_ITERATIONS = 100000;
// Current target. New accounts hash at this strength; legacy accounts
// are transparently upgraded at next login (see HandleLogin/HandleReauth).
// Value picked per OWASP 2023 PBKDF2-SHA256 recommendation.
PBKDF2_ITERATIONS_TARGET = 600000;
// ---- Hash algorithm markers (users.hash_algo) ----
// 'pbkdf2' : LEGACY. Stored hash = PBKDF2(pw, salt, iters) raw hex.
// Catastrophic at rest: those same bytes ARE the AES
// key the client uses to encrypt entries. A stolen
// vault.db hands the attacker the key directly.
// 'pbkdf2-sha256' : CURRENT. Stored hash = SHA256(PBKDF2(pw, salt, iters)).
// One-way wrap. vault.db at rest no longer contains
// the AES key. Server still sees pw transiently
// during /login to compute the comparison.
HASH_ALGO_LEGACY = 'pbkdf2';
HASH_ALGO_CURRENT = 'pbkdf2-sha256';
DEFAULT_FOLDERS: array[0..4] of string = ('All', 'Social', 'Banking', 'Work', 'Personal');
// Auth-hash computation for the current scheme. Wraps PBKDF2 output in
// SHA-256 so the stored value is no longer usable as the AES decryption
// key. Use this everywhere we write or verify a hash under
// HASH_ALGO_CURRENT — register, login, reauth, and migrate-kdf all
// go through here for consistency.
function ComputeAuthHashCurrent(const APwd, ASalt: string; AIters: Integer): string;
begin
Result := SHA256Hex(PBKDF2_SHA256_Hex(APwd, ASalt, AIters));
end;
procedure EnsureDefaultFolders(AUserId: Integer);
var
LQ: TFDQuery;
I: Integer;
begin
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT OR IGNORE INTO folders (user_id, name) VALUES (:uid, :name)';
for I := Low(DEFAULT_FOLDERS) to High(DEFAULT_FOLDERS) do
begin
LQ.ParamByName('uid').AsInteger := AUserId;
LQ.ParamByName('name').AsString := DEFAULT_FOLDERS[I];
LQ.ExecSQL;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
end;
procedure SendAuthSuccess(AResponse: TIdHTTPResponseInfo;
AUserId: Integer; const AToken, ASalt, ACSRFToken: string;
AKdfIterations: Integer; ANeedsMigration: Boolean);
var
LObj, LMig: TJSONObject;
begin
LObj := TJSONObject.Create;
LObj.AddPair('message', 'OK');
LObj.AddPair('token', AToken);
LObj.AddPair('userId', TJSONNumber.Create(AUserId));
LObj.AddPair('salt', ASalt);
LObj.AddPair('csrfToken', ACSRFToken);
// kdfIterations is the iteration count the client must use when deriving
// the AES-GCM key for THIS session — matches the count under which the
// existing entries are encrypted. If the server signals migration, the
// client should re-encrypt with the new target and call /migrate-kdf.
LObj.AddPair('kdfIterations', TJSONNumber.Create(AKdfIterations));
if ANeedsMigration then
begin
LMig := TJSONObject.Create;
LMig.AddPair('target', TJSONNumber.Create(PBKDF2_ITERATIONS_TARGET));
LObj.AddPair('kdfMigration', LMig);
end;
TJSONHelper.SendJSON(AResponse, LObj);
end;
// ===== /register =============================================================
procedure HandleRegister(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LBody: TJSONObject;
LUser, LPwd, LSalt, LHash, LToken, LCSRF, LIP: string;
LQ: TFDQuery;
LUserId: Integer;
begin
LIP := GetClientIP(ARequest);
if CheckRateLimit(LIP) >= 5 then
begin
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LUser := Trim(LBody.GetValue<string>('username', ''));
LPwd := LBody.GetValue<string>('masterPassword', '');
finally
LBody.Free;
end;
if (Length(LUser) < 3) or (Length(LPwd) < 8) then
begin
TJSONHelper.SendError(AResponse, 400, 'Min 3/8 chars');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text := 'SELECT id FROM users WHERE username = :u';
LQ.ParamByName('u').AsString := LUser;
LQ.Open;
if not LQ.IsEmpty then
begin
TJSONHelper.SendError(AResponse, 409, 'Username exists');
Exit;
end;
finally
LQ.Free;
end;
LSalt := RandomHex(32);
// New accounts use the current target iteration count + the SHA-256
// wrapped auth-hash scheme. password_hash is no longer the AES key.
LHash := ComputeAuthHashCurrent(LPwd, LSalt, PBKDF2_ITERATIONS_TARGET);
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT INTO users (username, password_hash, salt, hash_algo, kdf_iterations) ' +
'VALUES (:u, :h, :s, ''' + HASH_ALGO_CURRENT + ''', :it)';
LQ.ParamByName('u').AsString := LUser;
LQ.ParamByName('h').AsString := LHash;
LQ.ParamByName('s').AsString := LSalt;
LQ.ParamByName('it').AsInteger := PBKDF2_ITERATIONS_TARGET;
LQ.ExecSQL;
LUserId := DB.Connection.GetLastAutoGenValue('users');
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
EnsureDefaultFolders(LUserId);
CreateSession(LUserId, LToken, LCSRF);
LogAudit(LUserId, 'register', LIP);
// No migration ever needed for fresh accounts.
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF,
PBKDF2_ITERATIONS_TARGET, False);
end;
// ===== /login ================================================================
procedure HandleLogin(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LBody: TJSONObject;
LUser, LPwd, LSalt, LStoredHash, LAlgo, LToken, LCSRF, LIP: string;
LUserId, LKdfIters: Integer;
LQ: TFDQuery;
LComputed: string;
LValid: Boolean;
begin
LIP := GetClientIP(ARequest);
if CheckRateLimit(LIP) >= 10 then
begin
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LUser := Trim(LBody.GetValue<string>('username', ''));
LPwd := LBody.GetValue<string>('masterPassword', '');
finally
LBody.Free;
end;
// Per-username lockout check — runs BEFORE touching the users table, so
// attackers can't probe account existence via timing differences between
// "locked" and "not found" responses.
if RejectIfAccountLocked(AResponse, LUser) then Exit;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'SELECT id, password_hash, salt, hash_algo, kdf_iterations ' +
'FROM users WHERE username = :u';
LQ.ParamByName('u').AsString := LUser;
LQ.Open;
if LQ.IsEmpty then
begin
// Unknown username — still record the failure against this username
// so attackers can't enumerate accounts by observing which usernames
// can be locked vs not. TCriticalSection is reentrant for the same
// thread, so calling RecordAttempt/RecordFailedAccountAttempt from
// inside our DB.Lock block is safe (they re-acquire the same lock).
RecordAttempt(LIP);
RecordFailedAccountAttempt(LUser, LIP);
TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
Exit;
end;
LUserId := LQ.FieldByName('id').AsInteger;
LStoredHash := LQ.FieldByName('password_hash').AsString;
LSalt := LQ.FieldByName('salt').AsString;
LAlgo := LQ.FieldByName('hash_algo').AsString;
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
if LAlgo = '' then LAlgo := 'pbkdf2';
// Legacy rows predating the kdf_iterations column have NULL → 0 here;
// treat as the original 100k value used by api.php and early Delphi.
if LKdfIters <= 0 then LKdfIters := PBKDF2_ITERATIONS;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LValid := False;
if SameText(LAlgo, HASH_ALGO_LEGACY) then
begin
// Legacy scheme: stored hash is raw PBKDF2 hex (= AES key bytes). Verify
// by direct comparison. On success, login proceeds normally — the
// migration to HASH_ALGO_CURRENT is signaled via kdfMigration in the
// auth response and handled by the client through /migrate-kdf.
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LKdfIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
begin
// Current scheme: stored hash is SHA-256 of the PBKDF2 output.
LComputed := ComputeAuthHashCurrent(LPwd, LSalt, LKdfIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end
else if SameText(LAlgo, 'bcrypt') then
begin
// Not implemented in Delphi backend yet
RecordAttempt(LIP);
RecordFailedAccountAttempt(LUser, LIP);
LogAudit(LUserId, 'failed_login_bcrypt', LIP);
TJSONHelper.SendError(AResponse, 501,
'This account was created with bcrypt (PHP). The Delphi backend does ' +
'not verify bcrypt yet. Register a new account here, or login via PHP.');
Exit;
end;
if not LValid then
begin
RecordAttempt(LIP);
RecordFailedAccountAttempt(LUser, LIP);
LogAudit(LUserId, 'failed_login', LIP);
TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
Exit;
end;
ClearAttempts(LIP);
ClearAccountLockout(LUser);
DeleteAllUserSessions(LUserId);
EnsureDefaultFolders(LUserId);
CreateSession(LUserId, LToken, LCSRF);
LogAudit(LUserId, 'login', LIP);
// Signal migration whenever EITHER:
// - the user's iteration count is below the target (KDF bump needed), OR
// - the user's hash_algo is not the current scheme (format upgrade needed
// to remove the AES-key-in-vault.db architectural flaw).
// The client then calls /migrate-kdf which fixes both in one atomic step.
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF, LKdfIters,
(LKdfIters < PBKDF2_ITERATIONS_TARGET) or
not SameText(LAlgo, HASH_ALGO_CURRENT));
end;
// ===== /logout ===============================================================
procedure HandleLogout(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId: Integer;
LToken, LAuth: string;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LAuth := ARequest.RawHeaders.Values['Authorization'];
if LAuth.StartsWith('Bearer ', True) then
begin
LToken := Copy(LAuth, 8, MaxInt);
DeleteSessionByTokenHash(SHA256Hex(LToken));
end;
LogAudit(LUserId, 'logout', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Logged out');
end;
// ===== /reauth ===============================================================
procedure HandleReauth(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LKdfIters: Integer;
LBody: TJSONObject;
LUser, LPwd, LStoredHash, LSalt, LAlgo, LIP, LComputed: string;
LQ: TFDQuery;
LValid: Boolean;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LIP := GetClientIP(ARequest);
if CheckRateLimit(LIP) >= 5 then
begin
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LPwd := LBody.GetValue<string>('masterPassword', '');
finally
LBody.Free;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
// Pull username too — needed for the per-account lockout calls.
LQ.SQL.Text :=
'SELECT username, password_hash, salt, hash_algo, kdf_iterations ' +
'FROM users WHERE id = :uid';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
if LQ.IsEmpty then
begin
RecordAttempt(LIP);
TJSONHelper.SendError(AResponse, 401, 'User not found');
Exit;
end;
LUser := LQ.FieldByName('username').AsString;
LStoredHash := LQ.FieldByName('password_hash').AsString;
LSalt := LQ.FieldByName('salt').AsString;
LAlgo := LQ.FieldByName('hash_algo').AsString;
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
if LAlgo = '' then LAlgo := 'pbkdf2';
if LKdfIters <= 0 then LKdfIters := PBKDF2_ITERATIONS;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
// Check account lockout AFTER we have the username. Even though the user
// is already authenticated by their session token, the master-pw re-prompt
// is itself brute-forceable (e.g. attacker hijacked a session and now tries
// to escalate by guessing the master pw to unlock the JS crypto key).
if RejectIfAccountLocked(AResponse, LUser) then Exit;
LValid := False;
if SameText(LAlgo, HASH_ALGO_LEGACY) then
begin
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LKdfIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
begin
LComputed := ComputeAuthHashCurrent(LPwd, LSalt, LKdfIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end;
if not LValid then
begin
RecordAttempt(LIP);
RecordFailedAccountAttempt(LUser, LIP);
LogAudit(LUserId, 'failed_reauth', LIP);
TJSONHelper.SendError(AResponse, 401, 'Invalid password');
Exit;
end;
ClearAttempts(LIP);
ClearAccountLockout(LUser);
LogAudit(LUserId, 'reauth', LIP);
// Return KDF state so the client can detect legacy accounts that haven't
// been migrated yet — unlock from a locked state goes through reauth, not
// login, so we need the same migration signaling here. Migration triggers
// on KDF iter mismatch OR hash format mismatch (same rule as HandleLogin).
begin
var LObj := TJSONObject.Create;
LObj.AddPair('message', 'OK');
LObj.AddPair('kdfIterations', TJSONNumber.Create(LKdfIters));
if (LKdfIters < PBKDF2_ITERATIONS_TARGET) or
not SameText(LAlgo, HASH_ALGO_CURRENT) then
begin
var LMig := TJSONObject.Create;
LMig.AddPair('target', TJSONNumber.Create(PBKDF2_ITERATIONS_TARGET));
LObj.AddPair('kdfMigration', LMig);
end;
TJSONHelper.SendJSON(AResponse, LObj);
end;
end;
// ===== /migrate-kdf ==========================================================
// Atomic transition from an old PBKDF2 iteration count to the current target.
// Client side: derive both old and new AES keys, decrypt each entry with old,
// re-encrypt with new, then POST the new ciphertext blob to this endpoint
// along with the master password (so we can recompute the new server hash).
// Server side: verify the master pw with the old hash, then in a single
// transaction: update users.password_hash to the new PBKDF2 output, set
// kdf_iterations to TARGET, and replace each entry's encrypted_password/iv.
// All-or-nothing: if anything fails, the user stays on the old config.
procedure HandleMigrateKdf(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LOldIters, I: Integer;
LBody, LEntry: TJSONObject;
LEntries: TJSONArray;
LUser, LPwd, LSalt, LStoredHash, LAlgo, LIP, LComputed, LNewHash: string;
LQ: TFDQuery;
LValid: Boolean;
LEntryId: Integer;
LEncPwd, LIv: string;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LIP := GetClientIP(ARequest);
LBody := TJSONHelper.ReadBody(ARequest);
try
LPwd := LBody.GetValue<string>('masterPassword', '');
LEntries := LBody.GetValue<TJSONArray>('entries');
if LEntries = nil then
begin
TJSONHelper.SendError(AResponse, 400, 'Missing entries array');
Exit;
end;
DB.Lock;
try
// Step 1: load current user state.
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'SELECT username, password_hash, salt, hash_algo, kdf_iterations ' +
'FROM users WHERE id = :uid';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
if LQ.IsEmpty then
begin
TJSONHelper.SendError(AResponse, 401, 'User not found');
Exit;
end;
LUser := LQ.FieldByName('username').AsString;
LStoredHash := LQ.FieldByName('password_hash').AsString;
LSalt := LQ.FieldByName('salt').AsString;
LAlgo := LQ.FieldByName('hash_algo').AsString;
LOldIters := LQ.FieldByName('kdf_iterations').AsInteger;
if LAlgo = '' then LAlgo := 'pbkdf2';
if LOldIters <= 0 then LOldIters := PBKDF2_ITERATIONS;
finally
LQ.Free;
end;
// Idempotency: nothing to do if BOTH iter count is at target AND
// hash format is current. Previously we short-circuited on iter
// count alone, which would have skipped the hash-format upgrade for
// users who migrated KDF before this commit landed.
if (LOldIters >= PBKDF2_ITERATIONS_TARGET) and
SameText(LAlgo, HASH_ALGO_CURRENT) then
begin
TJSONHelper.SendOK(AResponse, 'Already at target');
Exit;
end;
// Step 2: verify the master pw against the CURRENT (old) hash,
// using whichever scheme the user is currently on.
LValid := False;
if SameText(LAlgo, HASH_ALGO_LEGACY) then
begin
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LOldIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
begin
LComputed := ComputeAuthHashCurrent(LPwd, LSalt, LOldIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end;
if not LValid then
begin
RecordFailedAccountAttempt(LUser, LIP);
LogAudit(LUserId, 'failed_migrate_kdf', LIP);
TJSONHelper.SendError(AResponse, 401, 'Invalid password');
Exit;
end;
// Step 3: compute the new password hash. ALWAYS uses the current
// scheme (SHA-256 wrap) and the target iteration count, regardless
// of where the user was before — migration converges everyone to
// the same modern config.
LNewHash := ComputeAuthHashCurrent(LPwd, LSalt, PBKDF2_ITERATIONS_TARGET);
// Step 4: atomic transaction — update user hash AND every entry's
// ciphertext together. Any failure rolls back, leaving the user on
// the legacy config (safe to retry next login).
DB.Connection.StartTransaction;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
// Update hash, iter count, AND hash_algo all in one row update.
// hash_algo := HASH_ALGO_CURRENT is what completes the migration
// away from the "stored hash IS the AES key" architectural flaw.
LQ.SQL.Text :=
'UPDATE users SET password_hash = :h, kdf_iterations = :it, ' +
' hash_algo = :algo ' +
'WHERE id = :uid';
LQ.ParamByName('h').AsString := LNewHash;
LQ.ParamByName('it').AsInteger := PBKDF2_ITERATIONS_TARGET;
LQ.ParamByName('algo').AsString := HASH_ALGO_CURRENT;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'UPDATE vault_entries ' +
'SET encrypted_password = :ep, iv = :iv, updated_at = CURRENT_TIMESTAMP ' +
'WHERE id = :id AND user_id = :uid';
for I := 0 to LEntries.Count - 1 do
begin
LEntry := LEntries.Items[I] as TJSONObject;
LEntryId := LEntry.GetValue<Integer>('id', 0);
LEncPwd := LEntry.GetValue<string>('encrypted_password', '');
LIv := LEntry.GetValue<string>('iv', '');
if (LEntryId <= 0) or (LEncPwd = '') or (LIv = '') then
raise Exception.CreateFmt('Invalid entry payload at index %d', [I]);
LQ.ParamByName('id').AsInteger := LEntryId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('ep').AsString := LEncPwd;
LQ.ParamByName('iv').AsString := LIv;
LQ.ExecSQL;
end;
finally
LQ.Free;
end;
DB.Connection.Commit;
except
DB.Connection.Rollback;
raise;
end;
finally
DB.Unlock;
end;
finally
LBody.Free;
end;
LogAudit(LUserId, Format('migrate_kdf %d->%d', [LOldIters, PBKDF2_ITERATIONS_TARGET]), LIP);
TJSONHelper.SendOK(AResponse, 'Migration complete');
end;
initialization
Router.Register('POST', '/register', HandleRegister);
Router.Register('POST', '/login', HandleLogin);
Router.Register('POST', '/logout', HandleLogout);
Router.Register('POST', '/reauth', HandleReauth);
Router.Register('POST', '/migrate-kdf', HandleMigrateKdf);
end.