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

unit PM.Session;

{
  Session lookup + CSRF validation.

  - Authenticate: read Bearer token from Authorization header, SHA256 it,
    look up sessions.token_hash. Reject if missing/expired. Returns userId.
    On failure, writes 401 + JSON error and raises ESessionRejected so the
    handler aborts cleanly.

  - RequireCSRF: for non-GET methods, validate X-CSRF-Token header against
    the user's latest session csrf_token (constant-time compare).
}

interface

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

type
  ESessionRejected = class(Exception);

function Authenticate(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo): Integer;
procedure RequireCSRF(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; AUserId: Integer);

function CreateSession(AUserId: Integer; out AToken, ACSRFToken: string): Boolean;
procedure DeleteSessionByTokenHash(const ATokenHash: string);
procedure DeleteAllUserSessions(AUserId: Integer);

implementation

uses
  System.DateUtils;

function ExtractBearerToken(ARequest: TIdHTTPRequestInfo): string;
var
  LAuth: string;
begin
  LAuth := ARequest.RawHeaders.Values['Authorization'];
  if LAuth.StartsWith('Bearer ', True) then
    Result := Copy(LAuth, 8, MaxInt)
  else
    Result := '';
end;

function Authenticate(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo): Integer;
var
  LToken, LTokenHash: string;
  LQ: TFDQuery;
  LExpires: TDateTime;
begin
  LToken := ExtractBearerToken(ARequest);
  if LToken = '' then
  begin
    TJSONHelper.SendError(AResponse, 401, 'No token');
    raise ESessionRejected.Create('no token');
  end;
  LTokenHash := SHA256Hex(LToken);

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT user_id, expires_at FROM sessions WHERE token_hash = :th';
      LQ.ParamByName('th').AsString := LTokenHash;
      LQ.Open;
      if LQ.IsEmpty then
      begin
        TJSONHelper.SendError(AResponse, 401, 'Invalid session');
        raise ESessionRejected.Create('invalid session');
      end;
      Result := LQ.FieldByName('user_id').AsInteger;
      // Read as TDateTime directly — FireDAC parses SQLite DATETIME columns
      // internally; using AsString would round-trip through system locale.
      LExpires := LQ.FieldByName('expires_at').AsDateTime;
    finally
      LQ.Free;
    end;

    // expires_at is now UTC (see CreateSession) — compare against UTC too.
    if (LExpires <> 0) and (LExpires < NowUTC) then
    begin
      DeleteSessionByTokenHash(LTokenHash);
      TJSONHelper.SendError(AResponse, 401, 'Session expired');
      raise ESessionRejected.Create('expired');
    end;
  finally
    DB.Unlock;
  end;
end;

procedure RequireCSRF(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; AUserId: Integer);
var
  LSubmitted, LStored, LTokenHash: string;
  LQ: TFDQuery;
begin
  if SameText(ARequest.Command, 'GET') then Exit;

  LSubmitted := ARequest.RawHeaders.Values['X-CSRF-Token'];
  if LSubmitted = '' then
  begin
    TJSONHelper.SendError(AResponse, 403, 'Missing CSRF token');
    raise ESessionRejected.Create('missing csrf');
  end;

  // Bind the CSRF check to the session actually PRESENTED (token_hash), not
  // "the user's most recent session" (§6c-3). The old ORDER BY created_at
  // could read a different session's token — and created_at's 1-second
  // resolution made two same-second sessions a coin-flip → phantom 403s.
  // user_id stays as a filter (defense in depth). Expiry isn't re-checked:
  // Authenticate always runs before RequireCSRF and already did it.
  LTokenHash := SHA256Hex(ExtractBearerToken(ARequest));

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT csrf_token FROM sessions ' +
        'WHERE token_hash = :th AND user_id = :uid';
      LQ.ParamByName('th').AsString  := LTokenHash;
      LQ.ParamByName('uid').AsInteger := AUserId;
      LQ.Open;
      if LQ.IsEmpty then
      begin
        TJSONHelper.SendError(AResponse, 403, 'Invalid CSRF token');
        raise ESessionRejected.Create('no session');
      end;
      LStored := LQ.FieldByName('csrf_token').AsString;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  if not ConstantTimeEquals(LStored, LSubmitted) then
  begin
    TJSONHelper.SendError(AResponse, 403, 'Invalid CSRF token');
    raise ESessionRejected.Create('csrf mismatch');
  end;
end;

function CreateSession(AUserId: Integer; out AToken, ACSRFToken: string): Boolean;
var
  LQ: TFDQuery;
  LTokenHash, LExpires: string;
begin
  AToken     := RandomHex(32);
  ACSRFToken := RandomHex(32);
  LTokenHash := SHA256Hex(AToken);
  // YYYY-MM-DD HH:NN:SS, +24h, server local time (api.php uses date() = local)
  // UTC like everywhere else — RequireCSRF + CleanupExpired compare against
  // SQLite datetime('now') which IS UTC. Writing local here made the CSRF
  // window fall short on negative-offset zones (§6c-2): "Invalid CSRF token"
  // on writes while GETs still authed.
  LExpires := FormatDateTime('yyyy-mm-dd hh:nn:ss', IncHour(NowUTC, 24));

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'INSERT INTO sessions (user_id, token_hash, csrf_token, expires_at) ' +
        'VALUES (:uid, :th, :csrf, :exp)';
      LQ.ParamByName('uid').AsInteger  := AUserId;
      LQ.ParamByName('th').AsString    := LTokenHash;
      LQ.ParamByName('csrf').AsString  := ACSRFToken;
      LQ.ParamByName('exp').AsString   := LExpires;
      LQ.ExecSQL;
      Result := True;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

procedure DeleteSessionByTokenHash(const ATokenHash: string);
var
  LQ: TFDQuery;
begin
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'DELETE FROM sessions WHERE token_hash = :th';
      LQ.ParamByName('th').AsString := ATokenHash;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

procedure DeleteAllUserSessions(AUserId: Integer);
var
  LQ: TFDQuery;
begin
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'DELETE FROM sessions WHERE user_id = :uid';
      LQ.ParamByName('uid').AsInteger := AUserId;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

end.