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,Data.DB, 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; // ===== Zero-knowledge verifier path ========================================== // In the verifier flow the CLIENT computes PBKDF2(pw, salt, iters) and sends // the resulting hex (the "verifier") instead of the plaintext master pw. The // server then either: // - hashes the verifier with SHA-256 and compares to stored (CURRENT algo) // - compares the verifier directly to stored (LEGACY algo, where the // stored value IS the PBKDF2 hex) // Either way the server never sees the master pw plaintext. // // IsValidVerifier guards against malformed input — accept only lowercase or // uppercase hex of 64 chars (32 bytes of PBKDF2-SHA-256 output). function IsValidVerifier(const AVerifier: string): Boolean; var I: Integer; begin Result := False; if Length(AVerifier) <> 64 then Exit; for I := 1 to 64 do if not CharInSet(AVerifier[I], ['0'..'9', 'a'..'f', 'A'..'F']) then Exit; Result := True; end; // Returns the stored-hash representation of a verifier under a given algo. // Useful for both verification (compare to stored) and persistence (write // after a successful pw change). function VerifierToStoredHash(const AVerifier, AAlgo: string): string; begin if SameText(AAlgo, HASH_ALGO_LEGACY) then Result := AVerifier // legacy stores PBKDF2 hex directly else Result := SHA256Hex(AVerifier); end; // Constant-time verifier check. Returns False if the verifier is malformed // or the algo string is unsupported, otherwise compares per-algo. function CheckVerifier(const AVerifier, AStoredHash, AAlgo: string): Boolean; begin Result := False; if not IsValidVerifier(AVerifier) then Exit; Result := ConstantTimeEquals(VerifierToStoredHash(AVerifier, AAlgo), AStoredHash); 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, LVerifier, LSalt, LHash, LToken, LCSRF, LIP: string; LKdfIters: Integer; 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', ''); // Zero-knowledge register: client generates the salt + verifier locally // so the master pw never leaves the client. Optional — clients that // still send masterPassword get the legacy server-side derivation. LVerifier := LBody.GetValue('verifier', ''); LSalt := LBody.GetValue('salt', ''); LKdfIters := LBody.GetValue('kdfIterations', PBKDF2_ITERATIONS_TARGET); finally LBody.Free; end; // Username length always required. Master pw length only matters when the // client is sending plaintext — under the verifier flow the server has no // way to check pw length (it never sees it), so we trust the client to // enforce client-side. if Length(LUser) < 3 then begin TJSONHelper.SendError(AResponse, 400, 'Username min 3 chars'); Exit; end; if (LVerifier = '') and (Length(LPwd) < 8) then begin TJSONHelper.SendError(AResponse, 400, 'Master password min 8 chars'); Exit; end; if (LVerifier <> '') and (not IsValidVerifier(LVerifier)) then begin TJSONHelper.SendError(AResponse, 400, 'Malformed verifier'); Exit; end; if (LVerifier <> '') and (Length(LSalt) <> 64) then begin TJSONHelper.SendError(AResponse, 400, 'Client-supplied salt must be 64 hex chars'); Exit; end; if (LVerifier <> '') and ((LKdfIters < 100000) or (LKdfIters > 5000000)) then begin TJSONHelper.SendError(AResponse, 400, 'kdfIterations out of allowed range'); 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; if LVerifier <> '' then begin // ZK path: use the client-supplied salt + iters + verifier as-is. LHash := VerifierToStoredHash(LVerifier, HASH_ALGO_CURRENT); end else begin // Legacy plaintext path: server generates salt + derives. LSalt := RandomHex(32); LKdfIters := PBKDF2_ITERATIONS_TARGET; LHash := ComputeAuthHashCurrent(LPwd, LSalt, LKdfIters); end; 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 := LKdfIters; 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, LKdfIters, False); end; // ===== /login ================================================================ procedure HandleLogin(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LBody: TJSONObject; LUser, LPwd, LVerifier, 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', ''); LVerifier := LBody.GetValue('verifier', ''); 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 LVerifier <> '' then begin // Zero-knowledge path: client already computed PBKDF2(pw, salt, iters) // and sent us the hex. Server only does the SHA-256 wrap (CURRENT) or // direct compare (LEGACY). Master pw never leaves the client. LValid := CheckVerifier(LVerifier, LStoredHash, LAlgo); end else if SameText(LAlgo, HASH_ALGO_LEGACY) then begin // Legacy plaintext path: stored hash is raw PBKDF2 hex (= AES key bytes). // Verify by direct comparison. Kept for compatibility with any client // that hasn't been upgraded to send a verifier yet. LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, LKdfIters); LValid := ConstantTimeEquals(LComputed, LStoredHash); end else if SameText(LAlgo, HASH_ALGO_CURRENT) then begin // Current plaintext path: 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, LVerifier, 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', ''); LVerifier := LBody.GetValue('verifier', ''); 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 LVerifier <> '' then LValid := CheckVerifier(LVerifier, LStoredHash, LAlgo) else 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, LOldVerifier, LNewVerifier, 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', ''); // ZK path: client provides PBKDF2 hex at the OLD iter count (oldVerifier, // for current-hash verification) AND at the new TARGET iter count // (newVerifier, for the post-migration stored hash). LOldVerifier := LBody.GetValue('oldVerifier', ''); LNewVerifier := LBody.GetValue('newVerifier', ''); 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. Prefer // the ZK verifier path; fall back to plaintext for legacy clients. LValid := False; if LOldVerifier <> '' then LValid := CheckVerifier(LOldVerifier, LStoredHash, LAlgo) else 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 under the current scheme // (SHA-256 wrap) at the target iter count. ZK path takes the // newVerifier (PBKDF2 at the target iters, computed client-side) and // just wraps it; plaintext path runs PBKDF2 server-side. if LNewVerifier <> '' then begin if not IsValidVerifier(LNewVerifier) then begin TJSONHelper.SendError(AResponse, 400, 'Malformed newVerifier'); Exit; end; LNewHash := VerifierToStoredHash(LNewVerifier, HASH_ALGO_CURRENT); end else 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, LCurVerifier, LNewVerifier, 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', ''); // ZK path: verifier for the OLD pw (PBKDF2 over OLD salt + iters) and // for the NEW pw (PBKDF2 over the new salt at target iters). LCurVerifier := LBody.GetValue('currentVerifier', ''); LNewVerifier := LBody.GetValue('newVerifier', ''); LEntries := LBody.GetValue('entries'); // Input validation. Either plaintext OR verifier must be present; we // can't enforce min-length on the new pw in the ZK path (we don't see it). if (LCurPwd = '') and (LCurVerifier = '') then begin TJSONHelper.SendError(AResponse, 400, 'Missing current credentials'); Exit; end; if (LNewPwd = '') and (LNewVerifier = '') then begin TJSONHelper.SendError(AResponse, 400, 'Missing new credentials'); Exit; end; if (LNewPwd <> '') and (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 (LNewVerifier <> '') and (not IsValidVerifier(LNewVerifier)) then begin TJSONHelper.SendError(AResponse, 400, 'Malformed newVerifier'); 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 — prefer verifier path. LValid := False; if LCurVerifier <> '' then LValid := CheckVerifier(LCurVerifier, LStoredHash, LAlgo) else 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. ZK path: just wrap the // client-supplied newVerifier. Plaintext: derive server-side. if LNewVerifier <> '' then LNewHash := VerifierToStoredHash(LNewVerifier, HASH_ALGO_CURRENT) else 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. LQ.ParamByName('ts').DataType := ftString; LQ.ParamByName('tiv').DataType := ftString; if LTotpSec.IsEmpty 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; // ===== POST /login/challenge ================================================= // First leg of the zero-knowledge login: client posts the username, server // returns the salt + KDF iteration count needed to compute the verifier on // the client side. The actual login then sends the verifier (not the master // pw) to POST /login. // // User existence: this endpoint DOES leak user existence (404 vs 200) — same // as the existing /login through timing (PBKDF2 cost runs only on valid // users). Closing that hole properly requires returning a deterministic fake // salt for unknown users, which itself leaks via stability under retry. v1 // accepts the timing leak in /login and the explicit leak here as equivalent. // // Rate-limited per IP via the existing login_attempts table. No per-account // lockout fires here — that lives in /login proper, on actual verifier // mismatches. procedure HandleLoginChallenge(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LBody, LObj: TJSONObject; LUser, LSalt, LIP, LAlgo: string; LKdfIters: Integer; LQ: TFDQuery; begin LIP := GetClientIP(ARequest); if CheckRateLimit(LIP) >= 20 then begin TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.'); Exit; end; LBody := TJSONHelper.ReadBody(ARequest); try LUser := Trim(LBody.GetValue('username', '')); finally LBody.Free; end; if LUser = '' then begin TJSONHelper.SendError(AResponse, 400, 'Username required'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'SELECT salt, kdf_iterations, hash_algo ' + 'FROM users WHERE username = :u'; LQ.ParamByName('u').AsString := LUser; LQ.Open; if LQ.IsEmpty then begin TJSONHelper.SendError(AResponse, 404, 'Unknown user'); Exit; end; LSalt := LQ.FieldByName('salt').AsString; LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger; LAlgo := LQ.FieldByName('hash_algo').AsString; if LAlgo = '' then LAlgo := HASH_ALGO_LEGACY; if LKdfIters <= 0 then LKdfIters := PBKDF2_ITERATIONS; finally LQ.Free; end; finally DB.Unlock; end; LObj := TJSONObject.Create; LObj.AddPair('salt', LSalt); LObj.AddPair('kdfIterations', TJSONNumber.Create(LKdfIters)); // Echo back the hash_algo so the client can choose the right wrap path // when needed (legacy vs current). Most clients ignore it. LObj.AddPair('hashAlgo', LAlgo); TJSONHelper.SendJSON(AResponse, LObj); end; initialization Router.Register('POST', '/login/challenge', HandleLoginChallenge); 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.