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, 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 Result := 0; 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; if (LExpires <> 0) and (LExpires < Now) 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: 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; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; LQ.SQL.Text := 'SELECT csrf_token FROM sessions ' + 'WHERE user_id = :uid AND expires_at > datetime(''now'') ' + 'ORDER BY created_at DESC LIMIT 1'; 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) LExpires := FormatDateTime('yyyy-mm-dd hh:nn:ss', IncHour(Now, 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.