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:
2026-06-08 21:31:39 +01:00
parent 664db65437
commit 40b3154a34
38 changed files with 8165 additions and 548 deletions
+290 -21
View File
@@ -4,12 +4,14 @@ interface
uses
System.SysUtils, System.Classes, System.UITypes, System.NetEncoding,
System.StrUtils,
Winapi.Windows,
FMX.Forms, FMX.Controls, FMX.Controls.Presentation, FMX.StdCtrls,
FMX.Memo, FMX.Memo.Types, FMX.ScrollBox, FMX.Edit, FMX.Layouts, FMX.Types,
FMX.Dialogs,
FMX.Dialogs, FMX.DialogService,
FMX.TMSFNCTypes, FMX.TMSFNCUtils, FMX.TMSFNCGraphics, FMX.TMSFNCGraphicsTypes,
FMX.TMSFNCCustomControl, FMX.TMSFNCWebBrowser,
PM.HTTPServer, PM.Bridge, PM.QuickUnlock;
PM.HTTPServer, PM.Bridge, PM.QuickUnlock, PM.UserPrefs;
type
TMainForm = class(TForm)
@@ -37,9 +39,17 @@ type
FBridge: TPMBridge;
FPendingURL: string;
FNavTimer: TTimer;
FNavAttempts: Integer;
FRequireAccessToken: Boolean;
FRequireProcessCheck: Boolean;
FQuitting: Boolean; // set when user picks "Quit" in tray menu — bypasses
// FormCloseQuery's minimize-to-tray intercept.
FAutofillTargetHWND: HWND; // saved at hotkey time, consumed on /execute
// Pending payload for the 60ms delay timer (focus settle before SendInput).
// Cleared inside AutofillTimerTick.
FAutofillPendingHWND: HWND;
FAutofillPendingUser: string;
FAutofillPendingPass: string;
procedure AutofillTimerTick(Sender: TObject);
procedure LogLine(const AMsg: string);
procedure UpdateButtons;
procedure NavigateToVault;
@@ -52,6 +62,11 @@ type
procedure BridgeTrayRestore;
procedure BridgeLockRequest;
procedure BridgeQuit;
procedure BridgeAutofillRequest(AKind: TAutofillKind;
ATargetHWND: HWND; const ATitle: string);
procedure BridgeDebugHotkey;
procedure BridgeNewEntryHotkey(const AWindowTitle: string);
procedure WebBrowserInitialized(Sender: TObject);
end;
var
@@ -67,13 +82,19 @@ begin
FServer.OnLog := LogLine;
FBridge := TPMBridge.Create(Self);
FBridge.OnSystemLock := BridgeSystemLock;
FBridge.OnTrayRestore := BridgeTrayRestore;
FBridge.OnLockRequest := BridgeLockRequest;
FBridge.OnQuit := BridgeQuit;
FBridge.OnSystemLock := BridgeSystemLock;
FBridge.OnTrayRestore := BridgeTrayRestore;
FBridge.OnLockRequest := BridgeLockRequest;
FBridge.OnQuit := BridgeQuit;
FBridge.OnAutofillRequest := BridgeAutofillRequest;
FBridge.OnDebugHotkey := BridgeDebugHotkey;
FBridge.OnNewEntryHotkey := BridgeNewEntryHotkey;
FBridge.RegisterAutofillHotkey; // Ctrl+Shift+L active from startup
FBridge.ApplyTitleBarTheme(True); // dark by default, JS may toggle later
FAutofillTargetHWND := 0;
// Wire the cmd:// bridge before any navigation happens.
WebBrowser.OnBeforeNavigate := WebBrowserBeforeNavigate;
WebBrowser.OnInitialized := WebBrowserInitialized;
// Delayed-Navigate timer: TTMSFNCWebBrowser (WebView2 backend) ignores
// Navigate() calls until Edge Chromium finishes its async init (~1-2s).
@@ -88,6 +109,28 @@ begin
UpdateButtons;
LogLine('Password Manager - Delphi backend ready.');
LogLine('Click Start to launch server + embedded web vault.');
PanelTop.Visible := False;
FRequireAccessToken := True;
FRequireProcessCheck := True;
edtPort.Text := '0';
if FileExists('config.txt') then
begin
var configList := TStringList.Create;
configList.LoadFromFile('config.txt');
try
var defPort := StrToIntDef(configList.Values['port'], 0);
edtPort.Text := defPort.ToString;
PanelTop.Visible := configList.Values['debug'].ToLower.Equals('true');
if configList.Values['require_token'].ToLower.Equals('false') then
FRequireAccessToken := False;
if configList.Values['require_process_check'].ToLower.Equals('false') then
FRequireProcessCheck := False;
finally
FreeAndNil(configList);
end;
end;
btnStartClick(Nil);
btnToggleLogClick(nil);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
@@ -96,7 +139,36 @@ begin
FServer.Free;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure TMainForm.WebBrowserInitialized(Sender: TObject);
begin
WebBrowser.EnableContextMenu := False;
WebBrowser.EnableShowDebugConsole := False;
end;
procedure TMainForm.BridgeNewEntryHotkey(const AWindowTitle: string);
var
EscapedTitle: string;
begin
if not FServer.Active then Exit;
FBridge.RestoreFromTray;
EscapedTitle := StringReplace(AWindowTitle, '\', '\\', [rfReplaceAll]);
EscapedTitle := StringReplace(EscapedTitle, '"', '\"', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onNewEntryFromTitle==="function")' +
'Bridge.onNewEntryFromTitle("' + EscapedTitle + '")');
LogLine('New entry hotkey — title: "' + AWindowTitle + '"');
end;
procedure TMainForm.BridgeDebugHotkey;
begin
if not FileExists('config.txt') then
Exit;
PanelTop.Visible := not PanelTop.Visible;
LogLine('Debug panel ' + IfThen(PanelTop.Visible, 'shown', 'hidden') +
' via Ctrl+Shift+D');
end;
Procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
// The tray-menu "Quit" handler sets FQuitting before triggering close,
// so we bypass the minimize-to-tray intercept in that case.
@@ -138,20 +210,31 @@ begin
lblStatus.Text := 'Stopped';
end;
function MaskAccessToken(const AUrl: string): string;
var
TokenPos: Integer;
begin
Result := AUrl;
TokenPos := Pos('?pmt=', Result);
if TokenPos > 0 then
Result := Copy(Result, 1, TokenPos + 4) + '***';
end;
procedure TMainForm.NavigateToVault;
begin
FPendingURL := 'http://127.0.0.1:' + edtPort.Text + '/index.html';
LogLine('Will navigate embedded browser in ~1.5s to: ' + FPendingURL);
// Schedule a single Navigate after Edge has had time to initialize.
FNavTimer.Enabled := False; // restart timer if already running
FPendingURL := 'http://127.0.0.1:' + FServer.BoundPort.ToString + '/index.html';
if FServer.RequireAccessToken then
FPendingURL := FPendingURL + '?pmt=' + FServer.AccessToken;
LogLine('Will navigate embedded browser in ~1.5s to: ' + MaskAccessToken(FPendingURL));
FNavTimer.Enabled := False;
FNavTimer.Enabled := True;
end;
procedure TMainForm.NavTimerTick(Sender: TObject);
begin
FNavTimer.Enabled := False; // one-shot
FNavTimer.Enabled := False;
if FPendingURL = '' then Exit;
LogLine('Navigating to: ' + FPendingURL);
LogLine('Navigating to: ' + MaskAccessToken(FPendingURL));
WebBrowser.Navigate(FPendingURL);
FPendingURL := '';
end;
@@ -162,15 +245,16 @@ var
begin
LPort := StrToIntDef(edtPort.Text, 8765);
try
FServer.Start(LPort);
FServer.Start(LPort, True, FRequireAccessToken, FRequireProcessCheck);
edtPort.Text := FServer.BoundPort.ToString;
UpdateButtons;
NavigateToVault;
except
on E: Exception do
begin
LogLine('ERROR starting server: ' + E.Message);
MessageDlg('Failed to start: ' + E.Message,
TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
TDialogService.MessageDialog('Failed to start: ' + E.Message,
TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0, nil);
end;
end;
end;
@@ -279,6 +363,17 @@ begin
LogLine('Clipboard cleared by JS request');
end
else if ACmd = 'clipboard/read' then
begin
var ClipText := FBridge.SecureClipboard.ReadText;
var Escaped := StringReplace(ClipText, '\', '\\', [rfReplaceAll]);
Escaped := StringReplace(Escaped, '"', '\"', [rfReplaceAll]);
Escaped := StringReplace(Escaped, #13, '\r', [rfReplaceAll]);
Escaped := StringReplace(Escaped, #10, '\n', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onClipboardRead)Bridge.onClipboardRead("' + Escaped + '")');
end
// ---- Quick unlock (DPAPI persistence of the vault key) ----
// store: client provides a base64-encoded blob (UTF-8 JSON, content
// opaque to us). We DPAPI-encrypt and stash on disk.
@@ -332,15 +427,145 @@ begin
BoolToStr(PM.QuickUnlock.HasQuickUnlock, True).ToLower + ')');
end
// ---- Autofill --------------------------------------------------------
// configure: JS calls this on page load / settings change to sync the
// hotkey registration state with the user's localStorage preference.
// Uses the historical defaults (Ctrl+Shift+L / Ctrl+Shift+P) — for
// custom combos, JS sends cmd://autofill/hotkeys instead.
else if ACmd = 'autofill/configure' then
begin
if GetParam('enabled') = '1' then
begin
FBridge.RegisterAutofillHotkey;
LogLine('Autofill hotkeys registered (defaults)');
end
else
begin
FBridge.UnregisterAutofillHotkey;
LogLine('Autofill hotkeys unregistered');
end;
end
// hotkeys: JS pushes the user-configured combos. Params:
// enabled = '1' | '0'
// full_mods = MOD_x bitmask (decimal), full_vk = VK code (decimal)
// pwd_mods, pwd_vk = same for the password-only hotkey
// If enabled=0, we just unregister and ignore the rest. If enabled=1,
// we register both with the supplied combos (replacing any prior).
else if ACmd = 'autofill/hotkeys' then
begin
if GetParam('enabled') <> '1' then
begin
FBridge.UnregisterAutofillHotkey;
LogLine('Autofill hotkeys unregistered (custom)');
end
else
begin
var LFullMods := Word(StrToIntDef(GetParam('full_mods'), 6)); // Ctrl+Shift
var LFullVk := Word(StrToIntDef(GetParam('full_vk'), Ord('L')));
var LPwdMods := Word(StrToIntDef(GetParam('pwd_mods'), 6));
var LPwdVk := Word(StrToIntDef(GetParam('pwd_vk'), Ord('P')));
var LAllOk := FBridge.SetAutofillHotkeys(LFullMods, LFullVk,
LPwdMods, LPwdVk);
LogLine(Format('Autofill hotkeys set — full=mods:%d vk:%d pwd=mods:%d vk:%d (all_ok=%s)',
[LFullMods, LFullVk, LPwdMods, LPwdVk, BoolToStr(LAllOk, True)]));
// Notify JS of the result so the UI can flag a failed-to-register combo
// (typically a clash with another app's global hotkey).
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onAutofillHotkeysResult)' +
'Bridge.onAutofillHotkeysResult(' + BoolToStr(LAllOk, True).ToLower + ')');
end;
end
// execute: JS has matched an entry, decrypted the password, and is
// telling Delphi to type username + Tab + password into the saved HWND.
else if ACmd = 'autofill/execute' then
begin
FAutofillPendingUser := GetParam('username');
FAutofillPendingPass := GetParam('password');
FAutofillPendingHWND := FAutofillTargetHWND;
FAutofillTargetHWND := 0;
// Small timer so SetForegroundWindow has time to take effect before
// SendInput fires — avoids the first keystrokes going to our window.
// TTimer.OnTimer is a TNotifyEvent (method, not anon proc) → we use a
// dedicated method on the form and stash the payload in fields.
var LTimer := TTimer.Create(Self);
LTimer.Interval := 60;
LTimer.OnTimer := AutofillTimerTick;
LTimer.Enabled := True;
end
// cancel: JS found no match or user dismissed the picker — nothing to type.
else if ACmd = 'autofill/cancel' then
begin
FAutofillTargetHWND := 0;
LogLine('Autofill cancelled (no match or dismissed)');
end
// focus: JS asks us to bring the main window to front (e.g. when the
// autofill picker opens — without this the picker is shown in the
// WebView but the user might not notice if our window was minimised
// or behind other apps). The Target HWND stays saved; ExecuteAutofill
// restores it later via ForceForegroundWindow.
else if ACmd = 'app/focus' then
begin
FBridge.RestoreFromTray;
LogLine('App brought to front (autofill picker)');
end
else if ACmd = 'app/ready' then
begin
WebBrowser.SetFocus;
WebBrowser.ExecuteJavaScript(
'setTimeout(()=>{var u=document.getElementById("loginUsername"),' +
'p=document.getElementById("loginPassword");' +
'if(u&&u.value){p&&p.focus();}else{u&&u.focus();}},0)');
end
else if ACmd = 'app/theme' then
FBridge.ApplyTitleBarTheme(GetParam('mode') = 'dark')
// ---- Device-bound prefs (DPAPI key/value) ----------------------------
// Used for prefs that must survive the ephemeral-port reset of the
// WebView2 localStorage (rememberedUsername, etc.).
else if ACmd = 'prefs/get' then
begin
var LKey := GetParam('key');
if LKey = '' then Exit;
var LVal := PM.UserPrefs.GetPref(LKey);
var LEscapedKey := StringReplace(LKey, '\', '\\', [rfReplaceAll]);
LEscapedKey := StringReplace(LEscapedKey, '"', '\"', [rfReplaceAll]);
var LEscapedVal := StringReplace(LVal, '\', '\\', [rfReplaceAll]);
LEscapedVal := StringReplace(LEscapedVal, '"', '\"', [rfReplaceAll]);
LEscapedVal := StringReplace(LEscapedVal, #13, '\r', [rfReplaceAll]);
LEscapedVal := StringReplace(LEscapedVal, #10, '\n', [rfReplaceAll]);
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onPrefResult)' +
'Bridge.onPrefResult("' + LEscapedKey + '","' + LEscapedVal + '")');
end
else if ACmd = 'prefs/set' then
begin
var LKey := GetParam('key');
if LKey = '' then Exit;
PM.UserPrefs.SetPref(LKey, GetParam('value'));
end
else
LogLine('Bridge: unknown command "' + ACmd + '"');
end;
procedure TMainForm.BridgeSystemLock;
begin
// Windows session locked — lock the vault in the JS layer immediately.
LogLine('Windows session locked — locking vault');
WebBrowser.ExecuteJavaScript('if(typeof lockVault==="function")lockVault()');
// Windows session locked or system suspending — delegate to Bridge.onSystemLock
// in JS which honours the "quick unlock" opt-out (DPAPI already gates
// access via the Windows account, so re-locking on top of Windows lock
// is redundant for users who enabled it).
LogLine('Windows session locked / suspend — notifying JS');
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onSystemLock==="function")Bridge.onSystemLock();' +
'else if(typeof lockVault==="function")lockVault()');
end;
procedure TMainForm.BridgeTrayRestore;
@@ -375,4 +600,48 @@ begin
Application.Terminate;
end;
procedure TMainForm.AutofillTimerTick(Sender: TObject);
var
TargetHwnd: HWND;
PendingUser, PendingPass: string;
ForegroundAfter: HWND;
begin
TargetHwnd := FAutofillPendingHWND;
PendingUser := FAutofillPendingUser;
PendingPass := FAutofillPendingPass;
FAutofillPendingHWND := 0;
FAutofillPendingUser := '';
FAutofillPendingPass := '';
TTimer(Sender).Enabled := False;
TTimer(Sender).Free;
FBridge.ExecuteAutofill(TargetHwnd, PendingUser, PendingPass);
ForegroundAfter := GetForegroundWindow;
LogLine(Format('Autofill executed — target=%s, foreground_after=%s, match=%s',
[IntToHex(TargetHwnd, 8), IntToHex(ForegroundAfter, 8),
BoolToStr(ForegroundAfter = TargetHwnd, True)]));
end;
procedure TMainForm.BridgeAutofillRequest(AKind: TAutofillKind;
ATargetHWND: HWND; const ATitle: string);
var
LTitle, LKind: string;
begin
if not FServer.Active then Exit;
FAutofillTargetHWND := ATargetHWND;
// Escape the title for safe injection into a JS string literal.
LTitle := ATitle;
LTitle := LTitle.Replace('\', '\\');
LTitle := LTitle.Replace('"', '\"');
if AKind = akPasswordOnly then LKind := 'password' else LKind := 'full';
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&typeof Bridge.onAutofillRequest==="function")' +
'Bridge.onAutofillRequest("' + LTitle + '","' + LKind + '")');
LogLine('Autofill hotkey (' + LKind + ') — foreground: "' + ATitle + '"');
end;
end.