unit PM.Handler.Audit; (* POST /audit body {action, site} -> {ok:true} GET /audit?limit=N&before= -> [{id, action, ip, created_at}, ...] audit_log is auto-purged after 30 days by Database init. The viewer reads page-by-page via the `before` cursor (id < before). *) interface implementation uses System.SysUtils, System.JSON, IdCustomHTTPServer, Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param, PM.Router, PM.JSON, PM.Session, PM.Audit, PM.Database; function GetClientIP(ARequest: TIdHTTPRequestInfo): string; begin Result := ARequest.RemoteIP; if Result = '' then Result := '127.0.0.1'; end; procedure HandlePostAudit(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId: Integer; LBody: TJSONObject; LAction, LSite: string; begin LUserId := Authenticate(ARequest, AResponse); RequireCSRF(ARequest, AResponse, LUserId); LBody := TJSONHelper.ReadBody(ARequest); try LAction := LBody.GetValue('action', ''); LSite := LBody.GetValue('site', ''); finally LBody.Free; end; if LAction = '' then begin TJSONHelper.SendError(AResponse, 400, 'action required'); Exit; end; // Keep the log compact: "autofill:github.com" rather than repeating // structured columns we don't have in the current schema. if LSite <> '' then LAction := LAction + ':' + LSite; LogAudit(LUserId, LAction, GetClientIP(ARequest)); TJSONHelper.SendOK(AResponse); end; // GET /audit — return up to `limit` log entries for the current user, // optionally newer-than-cursor (`before` = id). Most-recent first. procedure HandleGetAudit(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TArray); var LUserId, LLimit, LBefore: Integer; LQ: TFDQuery; LArr: TJSONArray; LObj: TJSONObject; begin LUserId := Authenticate(ARequest, AResponse); LLimit := StrToIntDef(ARequest.Params.Values['limit'], 100); if LLimit <= 0 then LLimit := 100; if LLimit > 500 then LLimit := 500; LBefore := StrToIntDef(ARequest.Params.Values['before'], 0); LArr := TJSONArray.Create; DB.Lock; try LQ := TFDQuery.Create(nil); try LQ.Connection := DB.Connection; if LBefore > 0 then LQ.SQL.Text := 'SELECT id, action, ip, created_at FROM audit_log ' + 'WHERE user_id = :uid AND id < :b ' + 'ORDER BY id DESC LIMIT :l' else LQ.SQL.Text := 'SELECT id, action, ip, created_at FROM audit_log ' + 'WHERE user_id = :uid ' + 'ORDER BY id DESC LIMIT :l'; LQ.ParamByName('uid').AsInteger := LUserId; LQ.ParamByName('l').AsInteger := LLimit; if LBefore > 0 then LQ.ParamByName('b').AsInteger := LBefore; LQ.Open; while not LQ.Eof do begin LObj := TJSONObject.Create; LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger)); LObj.AddPair('action', LQ.FieldByName('action').AsString); LObj.AddPair('ip', LQ.FieldByName('ip').AsString); LObj.AddPair('created_at', FormatDateTime('yyyy-mm-dd hh:nn:ss', LQ.FieldByName('created_at').AsDateTime)); LArr.Add(LObj); LQ.Next; end; finally LQ.Free; end; finally DB.Unlock; end; TJSONHelper.SendJSON(AResponse, LArr); end; initialization Router.Register('POST', '/audit', HandlePostAudit); Router.Register('GET', '/audit', HandleGetAudit); end.