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); 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('username', '')); LPwd := LBody.GetValue('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); 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('username', '')); LPwd := LBody.GetValue('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); 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); 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('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); 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('masterPassword', ''); LEntries := LBody.GetValue('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('id', 0); LEncPwd := LEntry.GetValue('encrypted_password', ''); LIv := LEntry.GetValue('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); 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('currentMasterPassword', ''); LNewPwd := LBody.GetValue('newMasterPassword', ''); LNewSalt := LBody.GetValue('newSalt', ''); LEntries := LBody.GetValue('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('id', 0); LEncPwd := LEntry.GetValue('encrypted_password', ''); LIv := LEntry.GetValue('iv', ''); LTotpSec := LEntry.GetValue('totp_secret', ''); LTotpIv := LEntry.GetValue('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.