Password-Manager/delphi-backend/Source/PM.RateLimit.pas

unit PM.RateLimit;

{
  Two-layer brute-force protection:

  1) Per-IP rate limit (login_attempts table, 15-minute window).
     Useful for non-loopback deployments and as a defense-in-depth layer.

  2) Per-username lockout (account_lockouts table, exponential backoff).
     The real defense for a loopback-only setup where everyone shares
     127.0.0.1. After 4 consecutive failed attempts for a given username,
     the account is locked for an increasing duration (1m, 5m, 15m, 1h,
     6h, 24h-capped). Counter resets on successful authentication.

     IMPORTANT: failed attempts are recorded even when the username doesn't
     exist in the users table. This prevents attackers from enumerating
     existing accounts by observing which usernames trigger a lockout.
     Trade-off: an attacker can DoS-lock arbitrary usernames, but they can
     never bypass authentication this way.
}

interface

uses
  System.SysUtils, System.JSON,
  Data.DB,
  FireDAC.Comp.Client, FireDAC.Stan.Param, IdCustomHTTPServer,
  PM.Database;

function GetClientIP(ARequest: TIdHTTPRequestInfo): string;

// ---- Per-IP rate limit (legacy) ----
function CheckRateLimit(const AIP: string): Integer;
procedure RecordAttempt(const AIP: string);
procedure ClearAttempts(const AIP: string);

// ---- Per-username account lockout ----

// Seconds remaining until the account is unlocked. 0 means not locked.
function GetAccountLockoutRemaining(const AUsername: string): Integer;

// Records a failed authentication attempt against AUsername (whether or not
// the user exists), applies exponential backoff, and returns the new
// failed_count. Caller should pass this back to the audit log.
function RecordFailedAccountAttempt(const AUsername, AIP: string): Integer;

// Resets the failed counter and clears any lockout for AUsername. Call on
// successful login / reauth.
procedure ClearAccountLockout(const AUsername: string);

// One-stop helper for handlers: if the account is currently locked, sends
// a 429 with a JSON body { error, retry_after } and returns True. Caller
// should Exit immediately. Returns False if not locked (caller proceeds).
function RejectIfAccountLocked(AResponse: TIdHTTPResponseInfo;
  const AUsername: string): Boolean;

implementation

function GetClientIP(ARequest: TIdHTTPRequestInfo): string;
begin
  // api.php trusts X-Forwarded-For (security flaw H1 in audit). Since this
  // server is loopback-only and not behind a proxy, prefer the actual peer IP.
  Result := ARequest.RemoteIP;
  if Result = '' then Result := 'unknown';
end;

function CheckRateLimit(const AIP: string): Integer;
var
  LQ: TFDQuery;
begin
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT COUNT(*) AS cnt FROM login_attempts ' +
        'WHERE ip = :ip ' +
        'AND attempted_at > datetime(''now'', ''-15 minutes'')';
      LQ.ParamByName('ip').AsString := AIP;
      LQ.Open;
      Result := LQ.FieldByName('cnt').AsInteger;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

procedure RecordAttempt(const AIP: string);
var
  LQ: TFDQuery;
begin
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'INSERT INTO login_attempts (ip) VALUES (:ip)';
      LQ.ParamByName('ip').AsString := AIP;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

procedure ClearAttempts(const AIP: string);
var
  LQ: TFDQuery;
begin
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'DELETE FROM login_attempts WHERE ip = :ip';
      LQ.ParamByName('ip').AsString := AIP;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

// =============================================================================
//  Per-username lockout with exponential backoff
// =============================================================================

// Exponential backoff schedule. Index = failed_count value AFTER this attempt.
// First 3 failures give no lockout — a real user typing their master pw
// wrong once or twice shouldn't be punished. From the 4th failure on, the
// duration ramps up sharply. Capped at 24 h regardless of further failures.
function ComputeBackoffSeconds(AFailedCount: Integer): Integer;
begin
  case AFailedCount of
    0..3: Result := 0;       // grace window
    4:    Result := 60;      // 1 minute
    5:    Result := 300;     // 5 minutes
    6:    Result := 900;     // 15 minutes
    7:    Result := 3600;    // 1 hour
    8:    Result := 21600;   // 6 hours
  else
    Result := 86400;         // 24 hours — capped, regardless of count
  end;
end;

function GetAccountLockoutRemaining(const AUsername: string): Integer;
var
  LQ: TFDQuery;
begin
  Result := 0;
  if AUsername = '' then Exit;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      // julianday() returns a real number of days since the Julian epoch
      // — the standard SQLite idiom for date arithmetic. Multiplying by
      // 86400 gives seconds. The WHERE clause filters out rows where the
      // lockout is NULL or already expired, so an empty result set means
      // "not locked" — no separate NULL handling needed.
      LQ.SQL.Text :=
        'SELECT CAST((julianday(locked_until) - julianday(''now'')) * 86400 ' +
        '            AS INTEGER) AS remaining ' +
        'FROM account_lockouts ' +
        'WHERE username = :u AND locked_until > datetime(''now'')';
      LQ.ParamByName('u').AsString := AUsername;
      LQ.Open;
      if not LQ.IsEmpty then
        Result := LQ.FieldByName('remaining').AsInteger;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

function RecordFailedAccountAttempt(const AUsername, AIP: string): Integer;
var
  LQ: TFDQuery;
  LNewCount, LBackoff: Integer;
begin
  Result := 0;
  if AUsername = '' then Exit;

  DB.Lock;
  try
    // Try UPDATE first; if no row exists, INSERT a fresh one. This avoids
    // SQLite UPSERT (ON CONFLICT DO UPDATE), which requires SQLite 3.24+
    // and which FireDAC's parameter preprocessor mangles on some versions.
    // Safe under our outer DB.Lock — no race between the UPDATE and INSERT.
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'UPDATE account_lockouts SET ' +
        '  failed_count    = failed_count + 1, ' +
        '  last_attempt_at = CURRENT_TIMESTAMP, ' +
        '  last_attempt_ip = :ip ' +
        'WHERE username = :u';
      LQ.ParamByName('u').AsString  := AUsername;
      LQ.ParamByName('ip').AsString := AIP;
      LQ.ExecSQL;

      if LQ.RowsAffected = 0 then
      begin
        LQ.SQL.Text :=
          'INSERT INTO account_lockouts ' +
          '  (username, failed_count, last_attempt_at, last_attempt_ip) ' +
          'VALUES (:u, 1, CURRENT_TIMESTAMP, :ip)';
        LQ.ParamByName('u').AsString  := AUsername;
        LQ.ParamByName('ip').AsString := AIP;
        LQ.ExecSQL;
      end;
    finally
      LQ.Free;
    end;

    // Read the new failed_count to decide if the backoff threshold is crossed.
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT failed_count FROM account_lockouts WHERE username = :u';
      LQ.ParamByName('u').AsString := AUsername;
      LQ.Open;
      if LQ.IsEmpty then Exit;
      LNewCount := LQ.FieldByName('failed_count').AsInteger;
    finally
      LQ.Free;
    end;
    Result := LNewCount;

    LBackoff := ComputeBackoffSeconds(LNewCount);
    if LBackoff > 0 then
    begin
      LQ := TFDQuery.Create(nil);
      try
        LQ.Connection := DB.Connection;
        // Build the datetime modifier in Delphi (e.g. "+60 seconds") and
        // pass it as a single string parameter — avoids SQL-side string
        // concatenation which FireDAC's preprocessor can choke on.
        LQ.SQL.Text :=
          'UPDATE account_lockouts SET ' +
          '  locked_until = datetime(''now'', :modifier) ' +
          'WHERE username = :u';
        LQ.ParamByName('modifier').AsString := Format('+%d seconds', [LBackoff]);
        LQ.ParamByName('u').AsString := AUsername;
        LQ.ExecSQL;
      finally
        LQ.Free;
      end;
    end;
  finally
    DB.Unlock;
  end;
end;

procedure ClearAccountLockout(const AUsername: string);
var
  LQ: TFDQuery;
begin
  if AUsername = '' then Exit;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      // Hard delete on success: keeps the table small, and there's no
      // value in remembering past failures once the user has proven they
      // know the password.
      LQ.SQL.Text := 'DELETE FROM account_lockouts WHERE username = :u';
      LQ.ParamByName('u').AsString := AUsername;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

function RejectIfAccountLocked(AResponse: TIdHTTPResponseInfo;
  const AUsername: string): Boolean;
var
  LRemaining: Integer;
  LBody: TJSONObject;
begin
  LRemaining := GetAccountLockoutRemaining(AUsername);
  Result := LRemaining > 0;
  if not Result then Exit;

  // 429 Too Many Requests with a structured body so the client can show
  // a countdown timer ("Try again in X seconds") instead of a generic
  // error toast. Standard Retry-After header included as a fallback for
  // HTTP-aware tooling.
  AResponse.ResponseNo := 429;
  AResponse.ContentType := 'application/json; charset=utf-8';
  AResponse.CustomHeaders.Values['Retry-After'] := IntToStr(LRemaining);

  LBody := TJSONObject.Create;
  try
    LBody.AddPair('error', 'Account temporarily locked due to repeated failed attempts');
    LBody.AddPair('retry_after', TJSONNumber.Create(LRemaining));
    AResponse.ContentText := LBody.ToJSON;
  finally
    LBody.Free;
  end;
end;

end.