Zaki/Password-Manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
9f6636defc73cf932bfb1f56236a2c5364bf1f6c
Password-Manager/delphi-backend/Handlers/PM.Handler.Auth.pas
T
Zaki 9f6636defc feat(auth): per-account brute-force lockout with exponential backoff 
Existing protection was per-IP only (login_attempts table). On a loopback
deployment everyone hits 127.0.0.1, so the per-IP counter is mostly
ornamental — the real attacker is on the same machine. Adds a second
defense layer that tracks failures per username with an exponential
backoff schedule.

Schema:
  account_lockouts (username TEXT PK, failed_count INT,
                    locked_until DATETIME, last_attempt_at, last_attempt_ip)

Backoff after threshold (4+ failures):
  1, 2, 3 failures → no lockout (grace window for typos)
  4th             → 60 s
  5th             → 5 min
  6th             → 15 min
  7th             → 1 h
  8th             → 6 h
  9th and beyond  → 24 h (capped)

Counter resets to 0 on successful login or reauth. Old non-locked rows
older than 30 days are pruned by CleanupExpired alongside the existing
sessions / audit_log / login_attempts cleanups.

Wiring:
 - HandleLogin / HandleReauth both check RejectIfAccountLocked() before
   touching the users table. Lockout responses are 429 with JSON body
   { error, retry_after } and a Retry-After header.
 - Failed attempts are recorded against the username even when the user
   doesn't exist, preventing account enumeration via differential
   "is this account locked?" probes.
 - PBKDF2 hash comparison was already constant-time (ConstantTimeEquals);
   no change there.

Client (js/app.js):
 - api() now preserves response status + body on Error so callers can
   distinguish 429-lockout from other errors.
 - New showLockoutCountdown(seconds) renders a live "Account locked —
   try again in Xm Ys" message in #authHint, disables #loginBtn until
   the countdown reaches 0, then re-enables it.
 - doLogin / doUnlock both branch on err.status === 429 + retry_after
   to call showLockoutCountdown instead of a generic error toast.

Known limitation: an attacker can DoS-lock arbitrary usernames by
spamming /login with that name. This is intentional — the alternative
(per-(username,IP) tracking) would let attackers enumerate accounts.
DoS-lock is acceptable; auth bypass is not.
2026-05-23 00:14:44 +01:00

369 lines
11 KiB
ObjectPascal
Raw Blame History

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
PBKDF2_ITERATIONS = 100000;
DEFAULT_FOLDERS: array[0..4] of string = ('All', 'Social', 'Banking', 'Work', 'Personal');
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);
var
LObj: 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);
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);
LHash := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT INTO users (username, password_hash, salt, hash_algo) ' +
'VALUES (:u, :h, :s, ''pbkdf2'')';
LQ.ParamByName('u').AsString := LUser;
LQ.ParamByName('h').AsString := LHash;
LQ.ParamByName('s').AsString := LSalt;
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);
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF);
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: 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 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;
if LAlgo = '' then LAlgo := 'pbkdf2';
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LValid := False;
if SameText(LAlgo, 'pbkdf2') then
begin
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
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);
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF);
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: 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 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;
if LAlgo = '' then LAlgo := 'pbkdf2';
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, 'pbkdf2') then
begin
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
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);
TJSONHelper.SendOK(AResponse, 'OK');
end;
initialization
Router.Register('POST', '/register', HandleRegister);
Router.Register('POST', '/login', HandleLogin);
Router.Register('POST', '/logout', HandleLogout);
Router.Register('POST', '/reauth', HandleReauth);
end.
Reference in New Issue View Git Blame Copy Permalink