feat: MFA tools, single-instance, tray polish, prefs persistence
Session highlights:
- feat(prefs): DPAPI-backed key/value store (PM.UserPrefs) — fixes
rememberedUsername being lost across reboots due to the random
ephemeral HTTP port changing the localStorage origin every launch.
Bridge cmd://prefs/{get,set} round-trips through Delphi.
- feat(tray): icon visible from startup (NIM_ADD at constructor, not
at first minimize). Tray context menu themed via uxtheme!135
SetPreferredAppMode so it follows the app's dark/light setting.
- feat(single-instance): named mutex + RegisterWindowMessage broadcast.
Second launch posts WM_PMSHOW to HWND_BROADCAST and exits; the
running bridge restores the window from tray. Mutex lives in Local\
namespace so distinct Windows users can still each run one.
- feat(mfa): Authenticator sidebar view (live TOTP codes for every
entry with a secret) + standalone TOTP generator modal (paste
base32 / otpauth:// URI, or generate a random 20-byte secret).
- feat(sidebar): Folders / Tags / Tools sections collapsible with
chevron toggle. Badge counts stay visible when collapsed. State
persisted in settings_json (synced across devices).
- feat(autofill): hotkey when vault is locked now restores the app
and focuses the master password input instead of no-op'ing
silently. Cleaner UX for the common "I hit Ctrl+Shift+L but the
vault was locked" path.
- feat(quick-unlock): when enabled, skip lockVault on Windows lock /
sleep. Rationale: the DPAPI blob already gates access via the
Windows account, so re-locking on top of the OS lock is redundant.
Idle auto-lock still fires (separate opt-in).
- fix(quick-unlock): re-sync state.quickUnlockEnabled from DPAPI
source-of-truth at boot, instead of trusting (now-volatile)
localStorage.
- docs: CLAUDE.md updated with all new modules, bridge commands,
and the port-ephemeral pitfall.
Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,65 @@
|
||||
unit PM.Handler.Audit;
|
||||
|
||||
(*
|
||||
POST /audit body {action, site} -> {ok:true}
|
||||
|
||||
Light-weight endpoint that lets the JS layer append an entry to audit_log
|
||||
without going through the full entries pipeline. Used by the autofill
|
||||
feature to record which site was filled (action = "autofill:<site>").
|
||||
The bearer token identifies the user — no data beyond the action string
|
||||
is stored.
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON, PM.Session, PM.Audit;
|
||||
|
||||
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<string>);
|
||||
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<string>('action', '');
|
||||
LSite := LBody.GetValue<string>('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;
|
||||
|
||||
initialization
|
||||
Router.Register('POST', '/audit', HandlePostAudit);
|
||||
|
||||
end.
|
||||
@@ -19,9 +19,9 @@ interface
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.Classes,
|
||||
FireDAC.Comp.Client,
|
||||
IdCustomHTTPServer,Data.DB,
|
||||
System.SysUtils, System.JSON, System.Classes, System.Generics.Collections,
|
||||
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON, PM.Database, PM.Crypto,
|
||||
PM.Session, PM.RateLimit, PM.Audit;
|
||||
|
||||
@@ -961,8 +961,21 @@ begin
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
// Step 5: invalidate every other session for this user. The CURRENT
|
||||
// session token is still valid — caller stays logged in.
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
DeleteAllUserSessions(LUserId);
|
||||
finally
|
||||
LBody.Free;
|
||||
|
||||
@@ -16,6 +16,7 @@ implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.StrUtils, System.NetEncoding,
|
||||
System.Generics.Collections,
|
||||
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
IdCustomHTTPServer, IdGlobalProtocols, IdURI,
|
||||
PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit;
|
||||
@@ -91,6 +92,7 @@ begin
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
|
||||
LObj.AddPair('site', LQ.FieldByName('site').AsString);
|
||||
LObj.AddPair('title', LQ.FieldByName('title').AsString);
|
||||
LObj.AddPair('username', LQ.FieldByName('username').AsString);
|
||||
LObj.AddPair('encrypted_password', LQ.FieldByName('encrypted_password').AsString);
|
||||
LObj.AddPair('iv', LQ.FieldByName('iv').AsString);
|
||||
@@ -135,7 +137,7 @@ procedure HandleCreateEntry(ARequest: TIdHTTPRequestInfo;
|
||||
var
|
||||
LUserId, LNewId: Integer;
|
||||
LBody, LObj: TJSONObject;
|
||||
LSite, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string;
|
||||
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
@@ -148,6 +150,7 @@ begin
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LSite := Trim(LBody.GetValue<string>('site', ''));
|
||||
LTitle := Trim(LBody.GetValue<string>('title', ''));
|
||||
LUser := Trim(LBody.GetValue<string>('username', ''));
|
||||
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
|
||||
LEnc := LBody.GetValue<string>('encrypted_password', '');
|
||||
@@ -175,11 +178,12 @@ begin
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'INSERT INTO vault_entries ' +
|
||||
'(user_id, site, username, encrypted_password, iv, encryption_method, ' +
|
||||
'(user_id, site, title, username, encrypted_password, iv, encryption_method, ' +
|
||||
' folder, tags, totp_secret, totp_iv, created_at, updated_at) ' +
|
||||
'VALUES (:uid, :s, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)';
|
||||
'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('s').AsString := LSite;
|
||||
LQ.ParamByName('tt').AsString := LTitle;
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.ParamByName('e').AsString := LEnc;
|
||||
LQ.ParamByName('i').AsString := LIV;
|
||||
@@ -216,6 +220,7 @@ begin
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('id', TJSONNumber.Create(LNewId));
|
||||
LObj.AddPair('site', LSite);
|
||||
LObj.AddPair('title', LTitle);
|
||||
LObj.AddPair('username', LUser);
|
||||
LObj.AddPair('folder', LFolder);
|
||||
LObj.AddPair('tags', LTags);
|
||||
@@ -229,7 +234,7 @@ procedure HandleUpdateEntry(ARequest: TIdHTTPRequestInfo;
|
||||
var
|
||||
LUserId, LId: Integer;
|
||||
LBody: TJSONObject;
|
||||
LSite, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string;
|
||||
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
@@ -249,6 +254,7 @@ begin
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LSite := Trim(LBody.GetValue<string>('site', ''));
|
||||
LTitle := Trim(LBody.GetValue<string>('title', ''));
|
||||
LUser := Trim(LBody.GetValue<string>('username', ''));
|
||||
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
|
||||
LEnc := LBody.GetValue<string>('encrypted_password', '');
|
||||
@@ -274,11 +280,12 @@ begin
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'UPDATE vault_entries ' +
|
||||
'SET site=:s, username=:u, encrypted_password=:e, iv=:i, ' +
|
||||
'SET site=:s, title=:tt, username=:u, encrypted_password=:e, iv=:i, ' +
|
||||
' folder=:f, tags=:t, totp_secret=:ts, totp_iv=:tiv, ' +
|
||||
' updated_at=:c ' +
|
||||
'WHERE id=:id AND user_id=:uid';
|
||||
LQ.ParamByName('s').AsString := LSite;
|
||||
LQ.ParamByName('tt').AsString := LTitle;
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.ParamByName('e').AsString := LEnc;
|
||||
LQ.ParamByName('i').AsString := LIV;
|
||||
@@ -501,7 +508,7 @@ var
|
||||
LUserId, I, LImported: Integer;
|
||||
LBody, LObj, LEntry: TJSONObject;
|
||||
LArr: TJSONArray;
|
||||
LSite, LUser, LFolder, LEnc, LIV, LTags, LTotpSec, LTotpIv, LNow: string;
|
||||
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LTotpSec, LTotpIv, LNow: string;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
@@ -540,9 +547,9 @@ begin
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'INSERT INTO vault_entries ' +
|
||||
'(user_id, site, username, encrypted_password, iv, encryption_method, ' +
|
||||
'(user_id, site, title, username, encrypted_password, iv, encryption_method, ' +
|
||||
' folder, tags, totp_secret, totp_iv, created_at, updated_at) ' +
|
||||
'VALUES (:uid, :s, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)';
|
||||
'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)';
|
||||
// Declare optional TOTP param types ONCE — the prepared statement
|
||||
// is reused across every imported entry, and FireDAC needs the
|
||||
// type set before the first .Clear call would otherwise fail
|
||||
@@ -554,6 +561,7 @@ begin
|
||||
begin
|
||||
LEntry := LArr.Items[I] as TJSONObject;
|
||||
LSite := Trim(LEntry.GetValue<string>('site', ''));
|
||||
LTitle := Trim(LEntry.GetValue<string>('title', ''));
|
||||
LUser := Trim(LEntry.GetValue<string>('username', ''));
|
||||
LFolder := Trim(LEntry.GetValue<string>('folder', 'All'));
|
||||
LEnc := LEntry.GetValue<string>('encrypted_password', '');
|
||||
@@ -569,6 +577,7 @@ begin
|
||||
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('s').AsString := LSite;
|
||||
LQ.ParamByName('tt').AsString := LTitle;
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.ParamByName('e').AsString := LEnc;
|
||||
LQ.ParamByName('i').AsString := LIV;
|
||||
@@ -604,6 +613,52 @@ begin
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
procedure HandleEntriesCount(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId, LActive, LTrashed: Integer;
|
||||
LQ: TFDQuery;
|
||||
LObj: TJSONObject;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LActive := 0;
|
||||
LTrashed := 0;
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'SELECT deleted, COUNT(*) AS cnt FROM vault_entries ' +
|
||||
'WHERE user_id = :uid GROUP BY deleted';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.Open;
|
||||
while not LQ.Eof do
|
||||
begin
|
||||
if LQ.FieldByName('deleted').AsInteger = 0 then
|
||||
LActive := LQ.FieldByName('cnt').AsInteger
|
||||
else
|
||||
LTrashed := LQ.FieldByName('cnt').AsInteger;
|
||||
LQ.Next;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('active', TJSONNumber.Create(LActive));
|
||||
LObj.AddPair('trashed', TJSONNumber.Create(LTrashed));
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
initialization
|
||||
// /entries/trash/empty must be registered BEFORE /entries/{id} to win the regex match.
|
||||
// Same logic for /entries/bulk-import — register before the catch-all /entries/{id}.
|
||||
@@ -611,6 +666,7 @@ initialization
|
||||
Router.Register('POST', '/entries/bulk-import', HandleBulkImport);
|
||||
Router.Register('POST', '/entries/(\d+)/restore', HandleRestoreEntry);
|
||||
Router.Register('POST', '/entries/(\d+)/favorite', HandleToggleFavorite);
|
||||
Router.Register('GET', '/entries/count', HandleEntriesCount);
|
||||
Router.Register('GET', '/entries', HandleGetEntries);
|
||||
Router.Register('POST', '/entries', HandleCreateEntry);
|
||||
Router.Register('PUT', '/entries/(\d+)', HandleUpdateEntry);
|
||||
|
||||
@@ -33,7 +33,7 @@ implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON,
|
||||
FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON, PM.Database, PM.Crypto, PM.Session, PM.Audit, PM.RateLimit;
|
||||
|
||||
@@ -122,19 +122,21 @@ begin
|
||||
|
||||
LConfigured := False;
|
||||
LCreatedAt := '';
|
||||
var RemainingUses: Integer := 0;
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'SELECT created_at FROM recovery_keys WHERE user_id = :uid';
|
||||
'SELECT created_at, remaining_uses FROM recovery_keys WHERE user_id = :uid';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.Open;
|
||||
if not LQ.IsEmpty then
|
||||
begin
|
||||
LConfigured := True;
|
||||
LCreatedAt := LQ.FieldByName('created_at').AsString;
|
||||
RemainingUses := LQ.FieldByName('remaining_uses').AsInteger;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
@@ -146,6 +148,7 @@ begin
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('configured', TJSONBool.Create(LConfigured));
|
||||
if LConfigured then LObj.AddPair('created_at', LCreatedAt);
|
||||
if LConfigured then LObj.AddPair('remaining_uses', TJSONNumber.Create(RemainingUses));
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
@@ -208,8 +211,8 @@ begin
|
||||
|
||||
LQ.SQL.Text :=
|
||||
'INSERT INTO recovery_keys ' +
|
||||
' (user_id, code_hash, kdf_salt, wrapped_key, wrapped_iv) ' +
|
||||
'VALUES (:uid, :ch, :ks, :wk, :wi)';
|
||||
' (user_id, code_hash, kdf_salt, wrapped_key, wrapped_iv, remaining_uses) ' +
|
||||
'VALUES (:uid, :ch, :ks, :wk, :wi, 5)';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('ch').AsString := LCodeHash;
|
||||
LQ.ParamByName('ks').AsString := LKdfSalt;
|
||||
@@ -271,7 +274,7 @@ var
|
||||
LBody, LObj: TJSONObject;
|
||||
LUser, LCode, LCodeHash, LIP, LStoredHash, LKdfSalt, LWrappedKey, LWrappedIv,
|
||||
LSalt, LToken, LCSRF: string;
|
||||
LUserId, LKdfIters: Integer;
|
||||
LUserId, LKdfIters, LCurrentUses, LNewUses: Integer;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
LIP := GetClientIP(ARequest);
|
||||
@@ -307,7 +310,7 @@ begin
|
||||
// Join to users to look up by username + verify the code in one shot.
|
||||
LQ.SQL.Text :=
|
||||
'SELECT u.id, u.salt, u.kdf_iterations, ' +
|
||||
' rk.code_hash, rk.kdf_salt, rk.wrapped_key, rk.wrapped_iv ' +
|
||||
' rk.code_hash, rk.kdf_salt, rk.wrapped_key, rk.wrapped_iv, rk.remaining_uses ' +
|
||||
'FROM users u ' +
|
||||
'LEFT JOIN recovery_keys rk ON rk.user_id = u.id ' +
|
||||
'WHERE u.username = :u';
|
||||
@@ -315,20 +318,19 @@ begin
|
||||
LQ.Open;
|
||||
if LQ.IsEmpty then
|
||||
begin
|
||||
// User doesn't exist OR has no recovery key configured. Same error
|
||||
// either way to avoid leaking which.
|
||||
RecordAttempt(LIP);
|
||||
RecordFailedAccountAttempt(LUser, LIP);
|
||||
TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code');
|
||||
Exit;
|
||||
end;
|
||||
LUserId := LQ.FieldByName('id').AsInteger;
|
||||
LSalt := LQ.FieldByName('salt').AsString;
|
||||
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
||||
LStoredHash := LQ.FieldByName('code_hash').AsString;
|
||||
LKdfSalt := LQ.FieldByName('kdf_salt').AsString;
|
||||
LWrappedKey := LQ.FieldByName('wrapped_key').AsString;
|
||||
LWrappedIv := LQ.FieldByName('wrapped_iv').AsString;
|
||||
LUserId := LQ.FieldByName('id').AsInteger;
|
||||
LSalt := LQ.FieldByName('salt').AsString;
|
||||
LKdfIters := LQ.FieldByName('kdf_iterations').AsInteger;
|
||||
LStoredHash := LQ.FieldByName('code_hash').AsString;
|
||||
LKdfSalt := LQ.FieldByName('kdf_salt').AsString;
|
||||
LWrappedKey := LQ.FieldByName('wrapped_key').AsString;
|
||||
LWrappedIv := LQ.FieldByName('wrapped_iv').AsString;
|
||||
LCurrentUses := LQ.FieldByName('remaining_uses').AsInteger;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
@@ -361,13 +363,24 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Code matches. Consume (delete the row) inside the same lock so the
|
||||
// single-use guarantee holds even under concurrent requests.
|
||||
// Code matches. Decrement remaining_uses ; if it drops to 0, delete
|
||||
// the row (last use). The row is also deleted when the user
|
||||
// successfully changes their master password (in PM.Handler.Auth).
|
||||
LNewUses := LCurrentUses - 1;
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
if LNewUses <= 0 then
|
||||
begin
|
||||
LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
end
|
||||
else
|
||||
begin
|
||||
LQ.SQL.Text := 'UPDATE recovery_keys SET remaining_uses = :u WHERE user_id = :uid';
|
||||
LQ.ParamByName('u').AsInteger := LNewUses;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
end;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
@@ -391,6 +404,7 @@ begin
|
||||
LObj.AddPair('wrappedKey', LWrappedKey);
|
||||
LObj.AddPair('wrappedIv', LWrappedIv);
|
||||
LObj.AddPair('kdfSalt', LKdfSalt);
|
||||
LObj.AddPair('remainingUses', TJSONNumber.Create(LNewUses));
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
|
||||
@@ -0,0 +1,113 @@
|
||||
unit PM.Handler.Settings;
|
||||
|
||||
(*
|
||||
GET /settings -> {<arbitrary JSON object stored as-is>}
|
||||
PUT /settings body: {<arbitrary JSON object>} -> {message:"OK"}
|
||||
|
||||
Persists a per-user preferences blob (users.settings_json). The server
|
||||
treats the body as opaque JSON — schema lives in the JS layer. Any client
|
||||
reading it should tolerate unknown keys for forward compatibility.
|
||||
|
||||
Device-specific toggles (quick-unlock DPAPI, autofill hotkey) deliberately
|
||||
stay in localStorage on the client and are NOT included in this blob.
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.Classes,
|
||||
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON, PM.Session, PM.Database;
|
||||
|
||||
procedure HandleGetSettings(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LQ: TFDQuery;
|
||||
LRaw: string;
|
||||
LObj: TJSONValue;
|
||||
begin
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'SELECT settings_json FROM users WHERE id = :uid';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.Open;
|
||||
if LQ.IsEmpty then
|
||||
LRaw := '{}'
|
||||
else
|
||||
LRaw := LQ.FieldByName('settings_json').AsString;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
if Trim(LRaw) = '' then LRaw := '{}';
|
||||
|
||||
// Validate so a corrupt row doesn't return malformed JSON to the client.
|
||||
LObj := TJSONObject.ParseJSONValue(LRaw);
|
||||
if LObj = nil then LObj := TJSONObject.Create;
|
||||
TJSONHelper.SendJSON(AResponse, LObj); // SendJSON frees the object
|
||||
end;
|
||||
|
||||
procedure HandlePutSettings(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LBody: TJSONObject;
|
||||
LSerialized: string;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
// Re-serialize to a canonical compact form (strips comments / extra
|
||||
// whitespace, and guarantees what we store is valid JSON).
|
||||
LSerialized := LBody.ToJSON;
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
// Soft cap to protect the row from a runaway client (typical settings
|
||||
// blob is a few hundred bytes; 16 KB leaves room for future flags).
|
||||
if Length(LSerialized) > 16384 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 413, 'Settings payload too large');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'UPDATE users SET settings_json = :s WHERE id = :uid';
|
||||
LQ.ParamByName('s').AsString := LSerialized;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
TJSONHelper.SendOK(AResponse);
|
||||
end;
|
||||
|
||||
initialization
|
||||
Router.Register('GET', '/settings', HandleGetSettings);
|
||||
Router.Register('PUT', '/settings', HandlePutSettings);
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user