feat: Delphi backend + JS↔Delphi bridge (clipboard, tray, auto-lock)
Introduces the Delphi 12 FMX backend (PMServer) that hosts the embedded
WebView2 vault on 127.0.0.1, and a native bridge between JS and Delphi
that wires three privacy-focused features:
1. Secure clipboard
Copying a password registers the Win32 "ExcludeClipboardContentFromMonitorProcessing"
format alongside CF_UNICODETEXT, so Win+V clipboard history never sees
the value. Auto-clears after 30s via TTimer. Bridge.copySecure() in
app.js routes all password/username/secret copy paths through the
native layer when running inside the Delphi WebView2 (falls back to
navigator.clipboard for the PHP standalone).
2. Tray icon (X-to-tray when server running)
Closing the dev panel hides both the form HWND and the TFMAppClass
per-process proxy window that owns the FMX taskbar entry — the form's
HWND alone is not the taskbar-visible one in FMX (took some iteration
to discover). Tray menu: Open, Lock vault, Quit. Clipboard is force-
cleared on minimize as extra safety. First-time minimize fires a
balloon notification so the user knows the app is still running.
3. Auto-lock on Windows session lock (Win+L)
wtsapi32.dll!WTSRegisterSessionNotification on a dedicated message-only
window. On WM_WTSSESSION_CHANGE / WTS_SESSION_LOCK, the bridge calls
ExecuteJavaScript('lockVault()'). Same path used by the tray "Lock vault"
menu item.
Bridge architecture:
- JS → Delphi via cmd:// URLs intercepted in OnBeforeNavigate
(pattern lifted from DeskInsight Monaco). Currently exposes
cmd://clipboard/copy?text=...&clear=... and cmd://clipboard/clear.
- Delphi → JS via TTMSFNCWebBrowser.ExecuteJavaScript with guarded
calls (typeof check) so the bridge degrades cleanly if app.js isn't
loaded yet.
Files:
- Source/PM.Bridge.pas (new) — TSecureClipboard + TPMBridge
- UMainForm.pas/.fmx — bridge wiring, FormCloseQuery intercept, tray
callbacks (BridgeTrayRestore / BridgeLockRequest / BridgeQuit)
- js/app.js — Bridge object, 5 navigator.clipboard sites migrated to
Bridge.copySecure with PHP-compatible fallback, Bridge.onTrayRestore
handler that resets the auto-lock timer
.gitignore extended with Delphi build artifacts (*.dcu, Win32/, Win64/,
__history/, __recovery/, *.identcache, *.dsk, *.local, etc.) so source
checkouts stay clean.
This commit is contained in:
@@ -0,0 +1,219 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user