unit PM.Handler.Recovery; (* Recovery key endpoints — one-time-use code that wraps the user's AES vault key for emergency access when the master password is lost. Threat model: The server stores only SHA-256(code), never the plaintext. The wrapped_key is AES-GCM ciphertext of the user's vault key under a KEK derived from PBKDF2(code, kdf_salt, 600k). Without the plaintext code, the server cannot unwrap the key on its own. The user is the only party that ever has access to the plaintext, and only once (right after generation). Single use: Redeeming the recovery key deletes the row. The user is expected to set a fresh master password and generate a new recovery key immediately after, which the client does automatically via change-master-password + setup. GET /recovery-key/status -> { configured: bool, created_at? } POST /recovery-key/setup body { masterPassword, codeHash, kdfSalt, wrappedKey, wrappedIv } -> { message } DELETE /recovery-key -> { message } POST /recovery-key/redeem body { username, code } -> session + { wrappedKey, wrappedIv, kdfSalt, salt, kdfIterations, token, csrfToken, userId } (NO session auth — this IS the auth) *) interface implementation uses System.SysUtils, System.JSON, FireDAC.Comp.Client, FireDAC.Stan.Param, IdCustomHTTPServer, PM.Router, PM.JSON, PM.Database, PM.Crypto, PM.Session, PM.Audit, PM.RateLimit; // Verifies the user's master password against their current stored hash. // Used by /recovery-key/setup so a stolen session token alone can't set up // a recovery backdoor. function VerifyMasterPassword(AUserId: Integer; const APwd: string; out AUsername: string): Boolean; const HASH_ALGO_LEGACY = 'pbkdf2'; HASH_ALGO_CURRENT = 'pbkdf2-sha256'; PBKDF2_ITERATIONS = 100000; var LQ: TFDQuery; LStoredHash, LSalt, LAlgo, LComputed: string; LIters: Integer; begin Result := False; AUsername := ''; DB.Lock; try 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 := AUserId; LQ.Open; if LQ.IsEmpty then Exit; AUsername := LQ.FieldByName('username').AsString; LStoredHash := LQ.FieldByName('password_hash').AsString; LSalt := LQ.FieldByName('salt').AsString; LAlgo := LQ.FieldByName('hash_algo').AsString; LIters := LQ.FieldByName('kdf_iterations').AsInteger; if LAlgo = '' then LAlgo := HASH_ALGO_LEGACY; if LIters <= 0 then LIters := PBKDF2_ITERATIONS; finally LQ.Free; end; finally DB.Unlock; end; if SameText(LAlgo, HASH_ALGO_LEGACY) then begin LComputed := PBKDF2_SHA256_Hex(APwd, LSalt, LIters); Result := ConstantTimeEquals(LComputed, LStoredHash); end else if SameText(LAlgo, HASH_ALGO_CURRENT) then begin LComputed := SHA256Hex(PBKDF2_SHA256_Hex(APwd, LSalt, LIters)); Result := ConstantTimeEquals(LComputed, LStoredHash); end; end; // ===== GET /recovery-key/status ============================================== procedure HandleStatus(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LQ: TFDQuery; LObj: TJSONObject; LConfigured: Boolean; LCreatedAt: string; begin try LUserId := Authenticate(ARequest, AResponse); except on ESessionRejected do Exit; end; LConfigured := False; LCreatedAt := ''; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'SELECT created_at FROM recovery_keys WHERE user_id = :uid'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.Open; if not LQ.IsEmpty then begin LConfigured := True; LCreatedAt := LQ.FieldByName('created_at').AsString; end; finally LQ.Free; end; finally DB.Unlock; end; LObj := TJSONObject.Create; LObj.AddPair('configured', TJSONBool.Create(LConfigured)); if LConfigured then LObj.AddPair('created_at', LCreatedAt); TJSONHelper.SendJSON(AResponse, LObj); end; // ===== POST /recovery-key/setup ============================================== procedure HandleSetup(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LBody: TJSONObject; LPwd, LCodeHash, LKdfSalt, LWrappedKey, LWrappedIv, LIP, LUser: string; LQ: TFDQuery; 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', ''); LCodeHash := LBody.GetValue('codeHash', ''); LKdfSalt := LBody.GetValue('kdfSalt', ''); LWrappedKey := LBody.GetValue('wrappedKey', ''); LWrappedIv := LBody.GetValue('wrappedIv', ''); finally LBody.Free; end; // Length sanity: SHA-256 hex = 64; kdf salt hex = 64; wrapped pieces are // base64 — minimal length check to weed out obvious garbage. if (Length(LCodeHash) <> 64) or (Length(LKdfSalt) <> 64) or (LWrappedKey = '') or (LWrappedIv = '') then begin TJSONHelper.SendError(AResponse, 400, 'Invalid recovery payload'); Exit; end; if not VerifyMasterPassword(LUserId, LPwd, LUser) then begin RecordFailedAccountAttempt(LUser, LIP); LogAudit(LUserId, 'failed_recovery_setup', LIP); TJSONHelper.SendError(AResponse, 401, 'Invalid master password'); Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; // INSERT-or-replace via DELETE+INSERT (portable, avoids the UPSERT // syntax we saw FireDAC choke on for the lockout table earlier). LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; LQ.SQL.Text := 'INSERT INTO recovery_keys ' + ' (user_id, code_hash, kdf_salt, wrapped_key, wrapped_iv) ' + 'VALUES (:uid, :ch, :ks, :wk, :wi)'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('ch').AsString := LCodeHash; LQ.ParamByName('ks').AsString := LKdfSalt; LQ.ParamByName('wk').AsString := LWrappedKey; LQ.ParamByName('wi').AsString := LWrappedIv; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'recovery_setup', LIP); TJSONHelper.SendOK(AResponse, 'Recovery key configured'); end; // ===== DELETE /recovery-key ================================================== procedure HandleDelete(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LQ: TFDQuery; begin try LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); except on ESessionRejected do Exit; end; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; LogAudit(LUserId, 'recovery_delete', GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse, 'Recovery key removed'); end; // ===== POST /recovery-key/redeem ============================================= // No session auth required — this is the entry point when the user CAN'T log // in. Per-IP rate limit + per-account lockout still apply: an attacker can't // brute-force the (high-entropy) recovery code by trying every possible // value without hitting the lockout. procedure HandleRedeem(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LBody, LObj: TJSONObject; LUser, LCode, LCodeHash, LIP, LStoredHash, LKdfSalt, LWrappedKey, LWrappedIv, LSalt, LToken, LCSRF: string; LUserId, LKdfIters: Integer; LQ: TFDQuery; 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', '')); LCode := Trim(LBody.GetValue('code', '')); finally LBody.Free; end; if (LUser = '') or (LCode = '') then begin TJSONHelper.SendError(AResponse, 400, 'Username and code required'); Exit; end; if RejectIfAccountLocked(AResponse, LUser) then Exit; LCodeHash := SHA256Hex(LCode); DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; // Join to users to look up by username + verify the code in one shot. LQ.SQL.Text := 'SELECT u.id, u.salt, u.kdf_iterations, ' + ' rk.code_hash, rk.kdf_salt, rk.wrapped_key, rk.wrapped_iv ' + 'FROM users u ' + 'LEFT JOIN recovery_keys rk ON rk.user_id = u.id ' + 'WHERE u.username = :u'; LQ.ParamByName('u').AsString := LUser; LQ.Open; if LQ.IsEmpty then begin // User doesn't exist OR has no recovery key configured. Same error // either way to avoid leaking which. RecordAttempt(LIP); RecordFailedAccountAttempt(LUser, LIP); TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code'); Exit; end; LUserId := LQ.FieldByName('id').AsInteger; LSalt := LQ.FieldByName('salt').AsString; LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger; LStoredHash := LQ.FieldByName('code_hash').AsString; LKdfSalt := LQ.FieldByName('kdf_salt').AsString; LWrappedKey := LQ.FieldByName('wrapped_key').AsString; LWrappedIv := LQ.FieldByName('wrapped_iv').AsString; finally LQ.Free; end; if (LStoredHash = '') or (LKdfSalt = '') or (LWrappedKey = '') then begin // User exists but no recovery row. DB.Unlock; try RecordAttempt(LIP); RecordFailedAccountAttempt(LUser, LIP); finally DB.Lock; end; TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code'); Exit; end; if not ConstantTimeEquals(LCodeHash, LStoredHash) then begin DB.Unlock; try RecordAttempt(LIP); RecordFailedAccountAttempt(LUser, LIP); finally DB.Lock; end; LogAudit(LUserId, 'failed_recovery_redeem', LIP); TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code'); Exit; end; // Code matches. Consume (delete the row) inside the same lock so the // single-use guarantee holds even under concurrent requests. LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ExecSQL; finally LQ.Free; end; finally DB.Unlock; end; ClearAttempts(LIP); ClearAccountLockout(LUser); CreateSession(LUserId, LToken, LCSRF); LogAudit(LUserId, 'recovery_redeem', LIP); LObj := TJSONObject.Create; LObj.AddPair('message', 'OK'); LObj.AddPair('userId', TJSONNumber.Create(LUserId)); LObj.AddPair('token', LToken); LObj.AddPair('csrfToken', LCSRF); LObj.AddPair('salt', LSalt); LObj.AddPair('kdfIterations', TJSONNumber.Create(LKdfIters)); LObj.AddPair('wrappedKey', LWrappedKey); LObj.AddPair('wrappedIv', LWrappedIv); LObj.AddPair('kdfSalt', LKdfSalt); TJSONHelper.SendJSON(AResponse, LObj); end; initialization Router.Register('GET', '/recovery-key/status', HandleStatus); Router.Register('POST', '/recovery-key/setup', HandleSetup); Router.Register('DELETE', '/recovery-key', HandleDelete); Router.Register('POST', '/recovery-key/redeem', HandleRedeem); end.