506aee7e6f
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.
230 lines
7.1 KiB
ObjectPascal
230 lines
7.1 KiB
ObjectPascal
unit PM.Database;
|
|
|
|
{
|
|
SQLite connection (FireDAC) toward the shared vault.db file.
|
|
CreateSchema mirrors api.php (CREATE TABLE IF NOT EXISTS + ALTER migrations).
|
|
Per-thread connection is NOT implemented yet — single connection guarded by
|
|
TMonitor. Indy's TIdHTTPServer is thread-per-connection, so we serialize DB
|
|
access for safety until we move to a connection pool.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, System.IOUtils, System.SyncObjs,
|
|
FireDAC.Comp.Client, FireDAC.Stan.Def, FireDAC.Stan.Async,
|
|
FireDAC.Phys.SQLite, FireDAC.DApt, FireDAC.Stan.Param,
|
|
FireDAC.FMXUI.Wait, FireDAC.Stan.Intf, FireDAC.UI.Intf,
|
|
Data.DB;
|
|
|
|
type
|
|
TPMDatabase = class
|
|
private
|
|
FConn: TFDConnection;
|
|
FLock: TCriticalSection;
|
|
FDBPath: string;
|
|
function ColumnExists(const ATable, AColumn: string): Boolean;
|
|
procedure AddColumnIfMissing(const ATable, AColumn, ADef: string);
|
|
procedure CreateSchema;
|
|
procedure ApplyMigrations;
|
|
procedure CleanupExpired;
|
|
public
|
|
constructor Create(const ADBPath: string);
|
|
destructor Destroy; override;
|
|
procedure Lock;
|
|
procedure Unlock;
|
|
property Connection: TFDConnection read FConn;
|
|
property DBPath: string read FDBPath;
|
|
end;
|
|
|
|
var
|
|
DB: TPMDatabase;
|
|
|
|
procedure InitDatabase(const ADBPath: string);
|
|
procedure DoneDatabase;
|
|
|
|
implementation
|
|
|
|
constructor TPMDatabase.Create(const ADBPath: string);
|
|
begin
|
|
inherited Create;
|
|
FDBPath := ADBPath;
|
|
FLock := TCriticalSection.Create;
|
|
FConn := TFDConnection.Create(nil);
|
|
FConn.DriverName := 'SQLite';
|
|
FConn.Params.Values['Database'] := FDBPath;
|
|
FConn.Params.Values['LockingMode'] := 'Normal';
|
|
FConn.Params.Values['Synchronous'] := 'Normal';
|
|
FConn.Params.Values['BusyTimeout'] := '5000';
|
|
FConn.Params.Values['JournalMode'] := 'WAL';
|
|
FConn.Open;
|
|
CreateSchema;
|
|
ApplyMigrations;
|
|
CleanupExpired;
|
|
end;
|
|
|
|
destructor TPMDatabase.Destroy;
|
|
begin
|
|
FConn.Free;
|
|
FLock.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPMDatabase.Lock;
|
|
begin
|
|
FLock.Enter;
|
|
end;
|
|
|
|
procedure TPMDatabase.Unlock;
|
|
begin
|
|
FLock.Leave;
|
|
end;
|
|
|
|
procedure TPMDatabase.CreateSchema;
|
|
begin
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS users (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' username TEXT UNIQUE NOT NULL,' +
|
|
' password_hash TEXT NOT NULL,' +
|
|
' salt TEXT NOT NULL,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
|
|
' hash_algo TEXT DEFAULT ''pbkdf2''' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS folders (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' user_id INTEGER NOT NULL,' +
|
|
' name TEXT NOT NULL,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
|
|
' FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE,' +
|
|
' UNIQUE(user_id, name)' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS vault_entries (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' user_id INTEGER NOT NULL,' +
|
|
' site TEXT NOT NULL,' +
|
|
' username TEXT NOT NULL,' +
|
|
' encrypted_password TEXT NOT NULL,' +
|
|
' iv TEXT NOT NULL,' +
|
|
' encryption_method TEXT DEFAULT ''server'',' +
|
|
' folder TEXT DEFAULT ''All'',' +
|
|
' deleted INTEGER DEFAULT 0,' +
|
|
' deleted_at DATETIME,' +
|
|
' favorite INTEGER DEFAULT 0,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
|
|
' updated_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS sessions (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' user_id INTEGER NOT NULL,' +
|
|
' token_hash TEXT UNIQUE NOT NULL,' +
|
|
' csrf_token TEXT,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
|
|
' expires_at DATETIME NOT NULL,' +
|
|
' FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS login_attempts (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' ip TEXT NOT NULL,' +
|
|
' attempted_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS audit_log (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' user_id INTEGER,' +
|
|
' action TEXT NOT NULL,' +
|
|
' ip TEXT,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS passkey_challenges (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' user_id INTEGER,' +
|
|
' challenge BLOB NOT NULL,' +
|
|
' type TEXT NOT NULL,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
|
|
')');
|
|
FConn.ExecSQL(
|
|
'CREATE TABLE IF NOT EXISTS passkey_credentials (' +
|
|
' id INTEGER PRIMARY KEY AUTOINCREMENT,' +
|
|
' user_id INTEGER NOT NULL,' +
|
|
' credential_id BLOB NOT NULL UNIQUE,' +
|
|
' public_key BLOB NOT NULL,' +
|
|
' counter INTEGER DEFAULT 0,' +
|
|
' created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
|
|
' FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE' +
|
|
')');
|
|
end;
|
|
|
|
function TPMDatabase.ColumnExists(const ATable, AColumn: string): Boolean;
|
|
var
|
|
LQ: TFDQuery;
|
|
begin
|
|
Result := False;
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := FConn;
|
|
// PRAGMA table_info returns one row per column with name in column 'name'
|
|
LQ.SQL.Text := 'PRAGMA table_info(' + ATable + ')';
|
|
LQ.Open;
|
|
while not LQ.Eof do
|
|
begin
|
|
if SameText(LQ.FieldByName('name').AsString, AColumn) then
|
|
Exit(True);
|
|
LQ.Next;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TPMDatabase.AddColumnIfMissing(const ATable, AColumn, ADef: string);
|
|
begin
|
|
if not ColumnExists(ATable, AColumn) then
|
|
FConn.ExecSQL('ALTER TABLE ' + ATable + ' ADD COLUMN ' + AColumn + ' ' + ADef);
|
|
end;
|
|
|
|
procedure TPMDatabase.ApplyMigrations;
|
|
begin
|
|
// Idempotent: only ALTER when the column is actually missing — no exception
|
|
// bubbling up to the debugger like api.php's try/catch did.
|
|
AddColumnIfMissing('vault_entries', 'encryption_method', 'TEXT DEFAULT ''server''');
|
|
AddColumnIfMissing('vault_entries', 'folder', 'TEXT DEFAULT ''All''');
|
|
AddColumnIfMissing('vault_entries', 'deleted', 'INTEGER DEFAULT 0');
|
|
AddColumnIfMissing('vault_entries', 'deleted_at', 'DATETIME');
|
|
AddColumnIfMissing('vault_entries', 'favorite', 'INTEGER DEFAULT 0');
|
|
// UI V2: tags stored as comma-separated TEXT (e.g. "work,important,2fa").
|
|
// Simple format, search via LIKE %tag%. Frontend handles parsing/joining.
|
|
AddColumnIfMissing('vault_entries', 'tags', 'TEXT DEFAULT ''''');
|
|
AddColumnIfMissing('users', 'hash_algo', 'TEXT DEFAULT ''pbkdf2''');
|
|
AddColumnIfMissing('sessions', 'csrf_token', 'TEXT');
|
|
end;
|
|
|
|
procedure TPMDatabase.CleanupExpired;
|
|
begin
|
|
FConn.ExecSQL('DELETE FROM sessions WHERE expires_at < datetime(''now'')');
|
|
FConn.ExecSQL('DELETE FROM login_attempts WHERE attempted_at < datetime(''now'', ''-15 minutes'')');
|
|
FConn.ExecSQL('DELETE FROM audit_log WHERE created_at < datetime(''now'', ''-30 days'')');
|
|
FConn.ExecSQL('DELETE FROM passkey_challenges WHERE created_at < datetime(''now'', ''-10 minutes'')');
|
|
end;
|
|
|
|
procedure InitDatabase(const ADBPath: string);
|
|
begin
|
|
if DB = nil then
|
|
DB := TPMDatabase.Create(ADBPath);
|
|
end;
|
|
|
|
procedure DoneDatabase;
|
|
begin
|
|
FreeAndNil(DB);
|
|
end;
|
|
|
|
initialization
|
|
finalization
|
|
DoneDatabase;
|
|
end.
|