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' + ')'); // Per-username lockout state, complementing the per-IP login_attempts // counter. On a loopback-only deployment the per-IP counter is mostly // useless (everyone hits 127.0.0.1), so the per-username counter is the // real defense against brute-force. // - failed_count: total failures since the last successful auth // - locked_until: timestamp the account becomes available again (NULL = not locked) // - last_attempt_at / _ip: forensic info for the audit log FConn.ExecSQL( 'CREATE TABLE IF NOT EXISTS account_lockouts (' + ' username TEXT PRIMARY KEY,' + ' failed_count INTEGER NOT NULL DEFAULT 0,' + ' locked_until DATETIME,' + ' last_attempt_at DATETIME DEFAULT CURRENT_TIMESTAMP,' + ' last_attempt_ip TEXT' + ')'); 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'')'); // Account lockout entries: prune rows that are no longer locked AND haven't // been touched in 30 days (the user clearly isn't being attacked anymore). // Active lockouts and recent attempts are preserved. FConn.ExecSQL( 'DELETE FROM account_lockouts ' + 'WHERE (locked_until IS NULL OR locked_until < datetime(''now'')) ' + 'AND last_attempt_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.