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,209 @@
|
||||
unit PM.HTTPServer;
|
||||
|
||||
{
|
||||
Indy TIdHTTPServer wrapper.
|
||||
- Binds 127.0.0.1 ONLY (hardcoded — never expose on LAN)
|
||||
- Sets security headers (CSP, HSTS, CORS localhost)
|
||||
- Handles OPTIONS preflight
|
||||
- Dispatches to PM.Router; 404 if no match
|
||||
}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes, System.IOUtils,
|
||||
IdHTTPServer, IdContext, IdCustomHTTPServer, IdSocketHandle,
|
||||
PM.Router, PM.JSON, PM.Database, PM.StaticFiles, PM.EmbeddedAssets;
|
||||
|
||||
type
|
||||
TLogProc = reference to procedure(const AMsg: string);
|
||||
|
||||
TPMHTTPServer = class
|
||||
private
|
||||
FServer: TIdHTTPServer;
|
||||
FOnLog: TLogProc;
|
||||
procedure HandleCommand(AContext: TIdContext;
|
||||
ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo);
|
||||
procedure HandleCommandOther(AContext: TIdContext;
|
||||
ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo);
|
||||
procedure HandleParseAuthentication(AContext: TIdContext;
|
||||
const AAuthType, AAuthData: string;
|
||||
var VUsername, VPassword: string; var VHandled: Boolean);
|
||||
procedure HandleException(AContext: TIdContext; AException: Exception);
|
||||
procedure ApplySecurityHeaders(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo);
|
||||
procedure Log(const AMsg: string);
|
||||
function GetActive: Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Start(APort: Integer);
|
||||
procedure Stop;
|
||||
property Active: Boolean read GetActive;
|
||||
property OnLog: TLogProc read FOnLog write FOnLog;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TPMHTTPServer.Create;
|
||||
begin
|
||||
inherited;
|
||||
FServer := TIdHTTPServer.Create(nil);
|
||||
FServer.OnCommandGet := HandleCommand;
|
||||
FServer.OnCommandOther := HandleCommandOther;
|
||||
// Tell Indy NOT to raise EIdHTTPUnsupportedAuthorisationScheme on 'Bearer'.
|
||||
// We parse the Authorization header ourselves in PM.Session.
|
||||
FServer.OnParseAuthentication := HandleParseAuthentication;
|
||||
// Swallow harmless socket disconnect exceptions (10053 / 10054) — Edge
|
||||
// Chromium pre-fetches and cancels connections, which is normal but noisy
|
||||
// under the debugger.
|
||||
FServer.OnException := HandleException;
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.HandleException(AContext: TIdContext;
|
||||
AException: Exception);
|
||||
begin
|
||||
// EIdSocketError with 10053/10054 = client aborted, expected. Log everything
|
||||
// else.
|
||||
if (AException.ClassName = 'EIdSocketError')
|
||||
or (AException.ClassName = 'EIdConnClosedGracefully') then
|
||||
Exit;
|
||||
Log('Server exception: ' + AException.ClassName + ' - ' + AException.Message);
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.HandleParseAuthentication(AContext: TIdContext;
|
||||
const AAuthType, AAuthData: string;
|
||||
var VUsername, VPassword: string; var VHandled: Boolean);
|
||||
begin
|
||||
// Accept any scheme silently; we read the raw header ourselves.
|
||||
VHandled := True;
|
||||
end;
|
||||
|
||||
destructor TPMHTTPServer.Destroy;
|
||||
begin
|
||||
Stop;
|
||||
FServer.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TPMHTTPServer.GetActive: Boolean;
|
||||
begin
|
||||
Result := Assigned(FServer) and FServer.Active;
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.Log(const AMsg: string);
|
||||
begin
|
||||
if Assigned(FOnLog) then FOnLog(AMsg);
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.Start(APort: Integer);
|
||||
var
|
||||
LBinding: TIdSocketHandle;
|
||||
LDBPath, LWebRoot: string;
|
||||
begin
|
||||
if FServer.Active then Exit;
|
||||
|
||||
// Resolve vault.db AND the web root (parent of the exe = Z:\password-manager\)
|
||||
LDBPath := TPath.GetFullPath(TPath.Combine(ExtractFilePath(ParamStr(0)), '..\vault.db'));
|
||||
LWebRoot := TPath.GetFullPath(TPath.Combine(ExtractFilePath(ParamStr(0)), '..\'));
|
||||
Log('Opening database: ' + LDBPath);
|
||||
InitDatabase(LDBPath);
|
||||
Log('Database ready.');
|
||||
Log('Web root: ' + LWebRoot);
|
||||
InitStaticServer(LWebRoot);
|
||||
|
||||
FServer.Bindings.Clear;
|
||||
LBinding := FServer.Bindings.Add;
|
||||
LBinding.IP := '127.0.0.1';
|
||||
LBinding.Port := APort;
|
||||
|
||||
FServer.Active := True;
|
||||
Log('Server started on http://127.0.0.1:' + IntToStr(APort));
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.Stop;
|
||||
begin
|
||||
if not Assigned(FServer) then Exit;
|
||||
if FServer.Active then
|
||||
begin
|
||||
FServer.Active := False;
|
||||
Log('Server stopped.');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.ApplySecurityHeaders(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo);
|
||||
var
|
||||
LOrigin: string;
|
||||
begin
|
||||
AResponse.CustomHeaders.Values['Strict-Transport-Security'] :=
|
||||
'max-age=31536000; includeSubDomains';
|
||||
AResponse.CustomHeaders.Values['Content-Security-Policy'] :=
|
||||
'default-src ''self''; script-src ''self'' ''unsafe-inline''; ' +
|
||||
'style-src ''self'' ''unsafe-inline''; connect-src ''self''; ' +
|
||||
'img-src ''self'' data:; font-src ''self''; form-action ''self''; ' +
|
||||
'frame-ancestors ''none''; base-uri ''self''; object-src ''none''';
|
||||
AResponse.CustomHeaders.Values['X-Content-Type-Options'] := 'nosniff';
|
||||
AResponse.CustomHeaders.Values['Referrer-Policy'] := 'no-referrer';
|
||||
|
||||
// CORS — accept only localhost / 127.0.0.1 origins (any port)
|
||||
LOrigin := ARequest.RawHeaders.Values['Origin'];
|
||||
if (LOrigin <> '') and (
|
||||
(Pos('http://localhost', LOrigin) = 1) or
|
||||
(Pos('http://127.0.0.1', LOrigin) = 1) or
|
||||
(Pos('https://localhost', LOrigin) = 1) or
|
||||
(Pos('https://127.0.0.1', LOrigin) = 1)
|
||||
) then
|
||||
begin
|
||||
AResponse.CustomHeaders.Values['Access-Control-Allow-Origin'] := LOrigin;
|
||||
AResponse.CustomHeaders.Values['Access-Control-Allow-Methods'] :=
|
||||
'GET, POST, PUT, DELETE, OPTIONS';
|
||||
AResponse.CustomHeaders.Values['Access-Control-Allow-Headers'] :=
|
||||
'Content-Type, Authorization, X-CSRF-Token';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.HandleCommand(AContext: TIdContext;
|
||||
ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo);
|
||||
begin
|
||||
ApplySecurityHeaders(ARequest, AResponse);
|
||||
try
|
||||
// Order: API route → embedded resource (production) → disk static (dev) → 404
|
||||
if Router.DispatchRequest(ARequest, AResponse) then Exit;
|
||||
if TryServeEmbedded(ARequest, AResponse) then Exit;
|
||||
if Assigned(StaticServer) and StaticServer.TryServe(ARequest, AResponse) then Exit;
|
||||
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
Log('ERROR ' + ARequest.Command + ' ' + ARequest.Document + ' : ' + E.Message);
|
||||
TJSONHelper.SendError(AResponse, 500, 'Internal server error');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPMHTTPServer.HandleCommandOther(AContext: TIdContext;
|
||||
ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo);
|
||||
begin
|
||||
ApplySecurityHeaders(ARequest, AResponse);
|
||||
// OPTIONS preflight
|
||||
if SameText(ARequest.Command, 'OPTIONS') then
|
||||
begin
|
||||
AResponse.ResponseNo := 204;
|
||||
AResponse.ContentText := '';
|
||||
Exit;
|
||||
end;
|
||||
// Routes for PUT / DELETE go through here in Indy
|
||||
try
|
||||
if not Router.DispatchRequest(ARequest, AResponse) then
|
||||
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
Log('ERROR ' + ARequest.Command + ' ' + ARequest.Document + ' : ' + E.Message);
|
||||
TJSONHelper.SendError(AResponse, 500, 'Internal server error');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user