Files
Password-Manager/delphi-backend/Handlers/PM.Handler.Auth.pas
T
Zaki cca8184b81 feat(auth): change master password with full vault re-encryption
Adds the canonical PM feature: let the user pick a new master password
and have every entry transparently re-encrypted under the new key,
without ever exposing plaintext to the server.

Backend endpoint: POST /change-master-password
==============================================
Body:
  {
    currentMasterPassword,   verified against current stored hash
    newMasterPassword,       basis for the new hash + new client key
    newSalt,                 64-char hex, client-generated
    entries: [{ id, encrypted_password, iv,
                totp_secret?, totp_iv? }, ...]
  }

Flow:
  1. Authenticate + RequireCSRF (caller already logged in).
  2. RejectIfAccountLocked — pw change is brute-forceable through a
     hijacked session, so it respects the same per-account lockout as
     /login.
  3. Verify currentMasterPassword against the stored hash. Branches on
     hash_algo to handle both legacy 'pbkdf2' and current 'pbkdf2-sha256'.
     Wrong pw → RecordFailedAccountAttempt + audit + 401.
  4. Compute new auth hash = SHA256(PBKDF2(new_pw, new_salt, 600k)),
     always using the current scheme (migration baked in).
  5. ATOMIC transaction:
       UPDATE users SET password_hash, salt, kdf_iterations, hash_algo
       UPDATE vault_entries SET encrypted_password, iv, totp_secret, totp_iv
       (per entry)
     Any failure → rollback, user stays on the old config.
  6. DeleteAllUserSessions — every OTHER session is invalidated so a
     leaked old token can't keep working past the rotation. The current
     caller's session stays valid.
  7. ClearAccountLockout + audit_log entry.
  8. Returns { message, salt, kdfIterations }.

Client
======
New modal in index.html (#changeMasterModal) with three password
fields (current / new / confirm) + inline error display. Added a
"Change master password" button in the Settings panel → Account
section. Escape-key handler routes through it like the other modals.

doChangeMasterPassword():
  1. Local validation: all fields filled, new ≥ 8 chars, new == confirm,
     new ≠ current. Fast failure beats a round trip.
  2. randomHexSalt() → 32 secure random bytes, hex-encoded.
  3. Derive newKey = PBKDF2(new_pw, new_salt, 600k).
  4. Walk state.entries: decrypt password + (optional) TOTP under the
     current key, re-encrypt under newKey with fresh random IVs.
     One decrypt failure aborts the whole change — better than partial
     commit.
  5. POST to /change-master-password.
  6. On success: swap state.salt + state.cryptoKey, persistCryptoKey,
     update sessionStorage, refresh cached ciphertexts in state.entries,
     close modal, toast.
  7. On 401 / 429 / generic error: show inline error in the modal so
     the user can fix and retry without re-typing everything.

Threat model notes
==================
 - The current session token stays valid because the new server hash
   only invalidates OTHER sessions. Self-logout would be needlessly
   disruptive (user already proved knowledge of both pws).
 - Server still sees the old + new master pws transiently in /change-
   master-password. Same trade-off as /login — eliminating it requires
   redesigning to send pre-computed verifiers (SRP-style), tracked
   separately.
 - The salt rotates with the password — best-practice against any
   precomputed dictionary attack tied to the previous salt.
2026-05-23 11:11:38 +01:00

851 lines
30 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;
// ===== POST /change-master-password ==========================================
// Body: {
// currentMasterPassword, // verified against current stored hash
// newMasterPassword, // basis for new hash + new client AES key
// newSalt, // 64-char hex, client-generated
// entries: [{ id, encrypted_password, iv, totp_secret?, totp_iv? }, ...]
// // entries re-encrypted client-side with the
// // new key (derived from new pw + new salt)
// }
//
// All-or-nothing transaction: verifies current, then in one tx updates the
// user row (hash + salt + iter count + algo) AND every entry's ciphertext.
// On any failure the user stays on the old config — they can retry without
// data loss.
//
// Side effects:
// - Invalidates ALL other sessions so a leaked old token can't keep
// working past the pw change.
// - Writes an audit_log entry.
//
// The /migrate-kdf endpoint exists for the same "re-encrypt all entries"
// pattern when the master pw stays the same; this endpoint differs by
// rotating the salt + pw too.
procedure HandleChangeMasterPassword(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, I: Integer;
LBody, LEntry, LObj: TJSONObject;
LEntries: TJSONArray;
LUser, LCurPwd, LNewPwd, LNewSalt, LStoredHash, LOldSalt, LAlgo, LIP,
LComputed, LNewHash: string;
LOldIters: Integer;
LQ: TFDQuery;
LValid: Boolean;
LEntryId: Integer;
LEncPwd, LIv, LTotpSec, LTotpIv: 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
LCurPwd := LBody.GetValue<string>('currentMasterPassword', '');
LNewPwd := LBody.GetValue<string>('newMasterPassword', '');
LNewSalt := LBody.GetValue<string>('newSalt', '');
LEntries := LBody.GetValue<TJSONArray>('entries');
// Input validation. Length 64 = 32 raw bytes in hex, matches the salt
// format produced by RandomHex(32) and client-side randomHexSalt().
if (Length(LCurPwd) < 1) or (Length(LNewPwd) < 8) then
begin
TJSONHelper.SendError(AResponse, 400,
'New master password must be at least 8 characters');
Exit;
end;
if Length(LNewSalt) <> 64 then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid newSalt length');
Exit;
end;
if LEntries = nil then
begin
TJSONHelper.SendError(AResponse, 400, 'Missing entries array');
Exit;
end;
DB.Lock;
try
// Step 1: load current 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;
LOldSalt := LQ.FieldByName('salt').AsString;
LAlgo := LQ.FieldByName('hash_algo').AsString;
LOldIters := LQ.FieldByName('kdf_iterations').AsInteger;
if LAlgo = '' then LAlgo := HASH_ALGO_LEGACY;
if LOldIters <= 0 then LOldIters := PBKDF2_ITERATIONS;
finally
LQ.Free;
end;
// Lockout protection on the pw change itself (same threat model as
// /login — attacker with a hijacked session shouldn't be able to
// brute-force the current pw to swap it for one they know).
if RejectIfAccountLocked(AResponse, LUser) then Exit;
// Step 2: verify the CURRENT master pw.
LValid := False;
if SameText(LAlgo, HASH_ALGO_LEGACY) then
begin
LComputed := PBKDF2_SHA256_Hex(LCurPwd, LOldSalt, LOldIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end
else if SameText(LAlgo, HASH_ALGO_CURRENT) then
begin
LComputed := ComputeAuthHashCurrent(LCurPwd, LOldSalt, LOldIters);
LValid := ConstantTimeEquals(LComputed, LStoredHash);
end;
if not LValid then
begin
RecordFailedAccountAttempt(LUser, LIP);
LogAudit(LUserId, 'failed_change_password', LIP);
TJSONHelper.SendError(AResponse, 401, 'Current password is incorrect');
Exit;
end;
// Step 3: compute the new auth hash with the new salt + target iters.
LNewHash := ComputeAuthHashCurrent(LNewPwd, LNewSalt, PBKDF2_ITERATIONS_TARGET);
// Step 4: atomic transaction — user row + every entry's ciphertext.
DB.Connection.StartTransaction;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'UPDATE users SET ' +
' password_hash = :h, ' +
' salt = :s, ' +
' kdf_iterations = :it, ' +
' hash_algo = :algo ' +
'WHERE id = :uid';
LQ.ParamByName('h').AsString := LNewHash;
LQ.ParamByName('s').AsString := LNewSalt;
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, ' +
' totp_secret = :ts, totp_iv = :tiv, ' +
' 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', '');
LTotpSec := LEntry.GetValue<string>('totp_secret', '');
LTotpIv := LEntry.GetValue<string>('totp_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;
// TOTP fields are optional per entry — clear when empty so
// existing-NULL rows don't get stomped with empty strings.
if LTotpSec = '' then LQ.ParamByName('ts').Clear
else LQ.ParamByName('ts').AsString := LTotpSec;
if LTotpIv = '' then LQ.ParamByName('tiv').Clear
else LQ.ParamByName('tiv').AsString := LTotpIv;
LQ.ExecSQL;
end;
finally
LQ.Free;
end;
DB.Connection.Commit;
except
DB.Connection.Rollback;
raise;
end;
finally
DB.Unlock;
end;
// Step 5: invalidate every other session for this user. The CURRENT
// session token is still valid — caller stays logged in.
DeleteAllUserSessions(LUserId);
finally
LBody.Free;
end;
ClearAccountLockout(LUser);
LogAudit(LUserId, 'change_master_password', LIP);
LObj := TJSONObject.Create;
LObj.AddPair('message', 'Master password changed');
LObj.AddPair('salt', LNewSalt);
LObj.AddPair('kdfIterations', TJSONNumber.Create(PBKDF2_ITERATIONS_TARGET));
TJSONHelper.SendJSON(AResponse, LObj);
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);
Router.Register('POST', '/change-master-password', HandleChangeMasterPassword);
end.