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,343 @@
|
||||
unit PM.Handler.Auth;
|
||||
|
||||
(*
|
||||
/register POST body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
|
||||
/login POST body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
|
||||
/logout POST auth + csrf -> {message}
|
||||
/reauth POST auth + csrf + body{masterPassword} -> {message}
|
||||
|
||||
Hashing strategy:
|
||||
- Delphi creates new accounts with PBKDF2-SHA256 100k iterations (hash_algo='pbkdf2'),
|
||||
same format as PHP hash_pbkdf2. PHP can verify these too.
|
||||
- For login, we read hash_algo:
|
||||
pbkdf2 -> verify natively
|
||||
bcrypt -> reject with clear message (bcrypt verify not implemented yet)
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.Classes,
|
||||
FireDAC.Comp.Client,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON, PM.Database, PM.Crypto,
|
||||
PM.Session, PM.RateLimit, PM.Audit;
|
||||
|
||||
const
|
||||
PBKDF2_ITERATIONS = 100000;
|
||||
DEFAULT_FOLDERS: array[0..4] of string = ('All', 'Social', 'Banking', 'Work', 'Personal');
|
||||
|
||||
procedure EnsureDefaultFolders(AUserId: Integer);
|
||||
var
|
||||
LQ: TFDQuery;
|
||||
I: Integer;
|
||||
begin
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'INSERT OR IGNORE INTO folders (user_id, name) VALUES (:uid, :name)';
|
||||
for I := Low(DEFAULT_FOLDERS) to High(DEFAULT_FOLDERS) do
|
||||
begin
|
||||
LQ.ParamByName('uid').AsInteger := AUserId;
|
||||
LQ.ParamByName('name').AsString := DEFAULT_FOLDERS[I];
|
||||
LQ.ExecSQL;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SendAuthSuccess(AResponse: TIdHTTPResponseInfo;
|
||||
AUserId: Integer; const AToken, ASalt, ACSRFToken: string);
|
||||
var
|
||||
LObj: TJSONObject;
|
||||
begin
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('message', 'OK');
|
||||
LObj.AddPair('token', AToken);
|
||||
LObj.AddPair('userId', TJSONNumber.Create(AUserId));
|
||||
LObj.AddPair('salt', ASalt);
|
||||
LObj.AddPair('csrfToken', ACSRFToken);
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
// ===== /register =============================================================
|
||||
|
||||
procedure HandleRegister(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LBody: TJSONObject;
|
||||
LUser, LPwd, LSalt, LHash, LToken, LCSRF, LIP: string;
|
||||
LQ: TFDQuery;
|
||||
LUserId: Integer;
|
||||
begin
|
||||
LIP := GetClientIP(ARequest);
|
||||
if CheckRateLimit(LIP) >= 5 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LUser := Trim(LBody.GetValue<string>('username', ''));
|
||||
LPwd := LBody.GetValue<string>('masterPassword', '');
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
if (Length(LUser) < 3) or (Length(LPwd) < 8) then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Min 3/8 chars');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'SELECT id FROM users WHERE username = :u';
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.Open;
|
||||
if not LQ.IsEmpty then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 409, 'Username exists');
|
||||
Exit;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
|
||||
LSalt := RandomHex(32);
|
||||
LHash := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
|
||||
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'INSERT INTO users (username, password_hash, salt, hash_algo) ' +
|
||||
'VALUES (:u, :h, :s, ''pbkdf2'')';
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.ParamByName('h').AsString := LHash;
|
||||
LQ.ParamByName('s').AsString := LSalt;
|
||||
LQ.ExecSQL;
|
||||
LUserId := DB.Connection.GetLastAutoGenValue('users');
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
EnsureDefaultFolders(LUserId);
|
||||
CreateSession(LUserId, LToken, LCSRF);
|
||||
LogAudit(LUserId, 'register', LIP);
|
||||
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF);
|
||||
end;
|
||||
|
||||
// ===== /login ================================================================
|
||||
|
||||
procedure HandleLogin(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LBody: TJSONObject;
|
||||
LUser, LPwd, LSalt, LStoredHash, LAlgo, LToken, LCSRF, LIP: string;
|
||||
LUserId: Integer;
|
||||
LQ: TFDQuery;
|
||||
LComputed: string;
|
||||
LValid: Boolean;
|
||||
begin
|
||||
LIP := GetClientIP(ARequest);
|
||||
if CheckRateLimit(LIP) >= 10 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LUser := Trim(LBody.GetValue<string>('username', ''));
|
||||
LPwd := LBody.GetValue<string>('masterPassword', '');
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'SELECT id, password_hash, salt, hash_algo FROM users WHERE username = :u';
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.Open;
|
||||
if LQ.IsEmpty then
|
||||
begin
|
||||
RecordAttempt(LIP);
|
||||
TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
|
||||
Exit;
|
||||
end;
|
||||
LUserId := LQ.FieldByName('id').AsInteger;
|
||||
LStoredHash := LQ.FieldByName('password_hash').AsString;
|
||||
LSalt := LQ.FieldByName('salt').AsString;
|
||||
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
||||
if LAlgo = '' then LAlgo := 'pbkdf2';
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LValid := False;
|
||||
if SameText(LAlgo, 'pbkdf2') then
|
||||
begin
|
||||
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
|
||||
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
||||
end
|
||||
else if SameText(LAlgo, 'bcrypt') then
|
||||
begin
|
||||
// Not implemented in Delphi backend yet
|
||||
RecordAttempt(LIP);
|
||||
LogAudit(LUserId, 'failed_login_bcrypt', LIP);
|
||||
TJSONHelper.SendError(AResponse, 501,
|
||||
'This account was created with bcrypt (PHP). The Delphi backend does ' +
|
||||
'not verify bcrypt yet. Register a new account here, or login via PHP.');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not LValid then
|
||||
begin
|
||||
RecordAttempt(LIP);
|
||||
LogAudit(LUserId, 'failed_login', LIP);
|
||||
TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ClearAttempts(LIP);
|
||||
DeleteAllUserSessions(LUserId);
|
||||
EnsureDefaultFolders(LUserId);
|
||||
CreateSession(LUserId, LToken, LCSRF);
|
||||
LogAudit(LUserId, 'login', LIP);
|
||||
SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF);
|
||||
end;
|
||||
|
||||
// ===== /logout ===============================================================
|
||||
|
||||
procedure HandleLogout(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LToken, LAuth: string;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LAuth := ARequest.RawHeaders.Values['Authorization'];
|
||||
if LAuth.StartsWith('Bearer ', True) then
|
||||
begin
|
||||
LToken := Copy(LAuth, 8, MaxInt);
|
||||
DeleteSessionByTokenHash(SHA256Hex(LToken));
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'logout', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Logged out');
|
||||
end;
|
||||
|
||||
// ===== /reauth ===============================================================
|
||||
|
||||
procedure HandleReauth(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LBody: TJSONObject;
|
||||
LPwd, LStoredHash, LSalt, LAlgo, LIP, LComputed: string;
|
||||
LQ: TFDQuery;
|
||||
LValid: Boolean;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LIP := GetClientIP(ARequest);
|
||||
if CheckRateLimit(LIP) >= 5 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LPwd := LBody.GetValue<string>('masterPassword', '');
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'SELECT password_hash, salt, hash_algo FROM users WHERE id = :uid';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.Open;
|
||||
if LQ.IsEmpty then
|
||||
begin
|
||||
RecordAttempt(LIP);
|
||||
TJSONHelper.SendError(AResponse, 401, 'User not found');
|
||||
Exit;
|
||||
end;
|
||||
LStoredHash := LQ.FieldByName('password_hash').AsString;
|
||||
LSalt := LQ.FieldByName('salt').AsString;
|
||||
LAlgo := LQ.FieldByName('hash_algo').AsString;
|
||||
if LAlgo = '' then LAlgo := 'pbkdf2';
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LValid := False;
|
||||
if SameText(LAlgo, 'pbkdf2') then
|
||||
begin
|
||||
LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
|
||||
LValid := ConstantTimeEquals(LComputed, LStoredHash);
|
||||
end;
|
||||
|
||||
if not LValid then
|
||||
begin
|
||||
RecordAttempt(LIP);
|
||||
LogAudit(LUserId, 'failed_reauth', LIP);
|
||||
TJSONHelper.SendError(AResponse, 401, 'Invalid password');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ClearAttempts(LIP);
|
||||
LogAudit(LUserId, 'reauth', LIP);
|
||||
TJSONHelper.SendOK(AResponse, 'OK');
|
||||
end;
|
||||
|
||||
initialization
|
||||
Router.Register('POST', '/register', HandleRegister);
|
||||
Router.Register('POST', '/login', HandleLogin);
|
||||
Router.Register('POST', '/logout', HandleLogout);
|
||||
Router.Register('POST', '/reauth', HandleReauth);
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,456 @@
|
||||
unit PM.Handler.Entries;
|
||||
|
||||
(*
|
||||
GET /entries?search=&deleted=0 -> JSON array of entries
|
||||
POST /entries body {site,username,encrypted_password,iv,folder} -> {id,site,username,folder}
|
||||
PUT /entries/{id} body {site,username,encrypted_password,iv,folder} -> {message}
|
||||
DELETE /entries/{id}?permanent=0|1 -> {message}
|
||||
POST /entries/{id}/restore -> {message}
|
||||
POST /entries/{id}/favorite -> {message}
|
||||
DELETE /entries/trash/empty -> {message}
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.StrUtils, System.NetEncoding,
|
||||
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
IdCustomHTTPServer, IdGlobalProtocols, IdURI,
|
||||
PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit;
|
||||
|
||||
function GetQueryParam(ARequest: TIdHTTPRequestInfo; const AName: string;
|
||||
const ADefault: string = ''): string;
|
||||
begin
|
||||
Result := ARequest.Params.Values[AName];
|
||||
if Result = '' then Result := ADefault;
|
||||
end;
|
||||
|
||||
// SQLite DATETIME columns: FireDAC parses to TDateTime internally, then AsString
|
||||
// would format in system locale (DD/MM/YYYY in French). Force ISO format
|
||||
// 'yyyy-mm-dd hh:nn:ss' which is what api.php / SQLite text storage uses and
|
||||
// what the JS frontend parses.
|
||||
function ISODateTimeField(AField: TField): string;
|
||||
begin
|
||||
if AField.IsNull then
|
||||
Result := ''
|
||||
else
|
||||
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', AField.AsDateTime);
|
||||
end;
|
||||
|
||||
// ===== GET /entries ==========================================================
|
||||
|
||||
procedure HandleGetEntries(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LQ: TFDQuery;
|
||||
LArr: TJSONArray;
|
||||
LObj: TJSONObject;
|
||||
LSearch, LDeletedStr: string;
|
||||
LDeleted: Integer;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LSearch := GetQueryParam(ARequest, 'search', '');
|
||||
LDeletedStr := GetQueryParam(ARequest, 'deleted', '0');
|
||||
if LDeletedStr = '1' then LDeleted := 1 else LDeleted := 0;
|
||||
|
||||
LArr := TJSONArray.Create;
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
if LSearch <> '' then
|
||||
begin
|
||||
LQ.SQL.Text :=
|
||||
'SELECT * FROM vault_entries ' +
|
||||
'WHERE user_id = :uid AND deleted = :del ' +
|
||||
'AND (site LIKE :q OR username LIKE :q) ' +
|
||||
'ORDER BY updated_at DESC';
|
||||
LQ.ParamByName('q').AsString := '%' + LSearch + '%';
|
||||
end
|
||||
else
|
||||
begin
|
||||
LQ.SQL.Text :=
|
||||
'SELECT * FROM vault_entries ' +
|
||||
'WHERE user_id = :uid AND deleted = :del ' +
|
||||
'ORDER BY updated_at DESC';
|
||||
end;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('del').AsInteger := LDeleted;
|
||||
LQ.Open;
|
||||
while not LQ.Eof do
|
||||
begin
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
|
||||
LObj.AddPair('site', LQ.FieldByName('site').AsString);
|
||||
LObj.AddPair('username', LQ.FieldByName('username').AsString);
|
||||
LObj.AddPair('encrypted_password', LQ.FieldByName('encrypted_password').AsString);
|
||||
LObj.AddPair('iv', LQ.FieldByName('iv').AsString);
|
||||
LObj.AddPair('encryption_method', LQ.FieldByName('encryption_method').AsString);
|
||||
LObj.AddPair('folder', LQ.FieldByName('folder').AsString);
|
||||
LObj.AddPair('deleted', TJSONNumber.Create(LQ.FieldByName('deleted').AsInteger));
|
||||
if LQ.FieldByName('deleted_at').IsNull then
|
||||
LObj.AddPair('deleted_at', TJSONNull.Create)
|
||||
else
|
||||
LObj.AddPair('deleted_at', ISODateTimeField(LQ.FieldByName('deleted_at')));
|
||||
LObj.AddPair('favorite', TJSONNumber.Create(LQ.FieldByName('favorite').AsInteger));
|
||||
LObj.AddPair('tags', LQ.FieldByName('tags').AsString);
|
||||
LObj.AddPair('created_at', ISODateTimeField(LQ.FieldByName('created_at')));
|
||||
LObj.AddPair('updated_at', ISODateTimeField(LQ.FieldByName('updated_at')));
|
||||
LArr.Add(LObj);
|
||||
LQ.Next;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
TJSONHelper.SendJSON(AResponse, LArr);
|
||||
end;
|
||||
|
||||
// ===== POST /entries =========================================================
|
||||
|
||||
procedure HandleCreateEntry(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId, LNewId: Integer;
|
||||
LBody, LObj: TJSONObject;
|
||||
LSite, LUser, LFolder, LEnc, LIV, LTags, LNow: string;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LSite := Trim(LBody.GetValue<string>('site', ''));
|
||||
LUser := Trim(LBody.GetValue<string>('username', ''));
|
||||
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
|
||||
LEnc := LBody.GetValue<string>('encrypted_password', '');
|
||||
LIV := LBody.GetValue<string>('iv', '');
|
||||
LTags := Trim(LBody.GetValue<string>('tags', ''));
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
if (LSite = '') or (LEnc = '') then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Site & password required');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'INSERT INTO vault_entries ' +
|
||||
'(user_id, site, username, encrypted_password, iv, encryption_method, ' +
|
||||
' folder, tags, created_at, updated_at) ' +
|
||||
'VALUES (:uid, :s, :u, :e, :i, ''client'', :f, :t, :c, :c2)';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('s').AsString := LSite;
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.ParamByName('e').AsString := LEnc;
|
||||
LQ.ParamByName('i').AsString := LIV;
|
||||
LQ.ParamByName('f').AsString := LFolder;
|
||||
LQ.ParamByName('t').AsString := LTags;
|
||||
LQ.ParamByName('c').AsString := LNow;
|
||||
LQ.ParamByName('c2').AsString := LNow;
|
||||
LQ.ExecSQL;
|
||||
LNewId := DB.Connection.GetLastAutoGenValue('vault_entries');
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'add_entry', GetClientIP(ARequest));
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('id', TJSONNumber.Create(LNewId));
|
||||
LObj.AddPair('site', LSite);
|
||||
LObj.AddPair('username', LUser);
|
||||
LObj.AddPair('folder', LFolder);
|
||||
LObj.AddPair('tags', LTags);
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
// ===== PUT /entries/{id} =====================================================
|
||||
|
||||
procedure HandleUpdateEntry(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId, LId: Integer;
|
||||
LBody: TJSONObject;
|
||||
LSite, LUser, LFolder, LEnc, LIV, LTags, LNow: string;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LId := StrToIntDef(AParams[0], 0);
|
||||
if LId = 0 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LSite := Trim(LBody.GetValue<string>('site', ''));
|
||||
LUser := Trim(LBody.GetValue<string>('username', ''));
|
||||
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
|
||||
LEnc := LBody.GetValue<string>('encrypted_password', '');
|
||||
LIV := LBody.GetValue<string>('iv', '');
|
||||
LTags := Trim(LBody.GetValue<string>('tags', ''));
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
if (LSite = '') or (LEnc = '') then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Site & password required');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'UPDATE vault_entries ' +
|
||||
'SET site=:s, username=:u, encrypted_password=:e, iv=:i, ' +
|
||||
' folder=:f, tags=:t, updated_at=:c ' +
|
||||
'WHERE id=:id AND user_id=:uid';
|
||||
LQ.ParamByName('s').AsString := LSite;
|
||||
LQ.ParamByName('u').AsString := LUser;
|
||||
LQ.ParamByName('e').AsString := LEnc;
|
||||
LQ.ParamByName('i').AsString := LIV;
|
||||
LQ.ParamByName('f').AsString := LFolder;
|
||||
LQ.ParamByName('t').AsString := LTags;
|
||||
LQ.ParamByName('c').AsString := LNow;
|
||||
LQ.ParamByName('id').AsInteger := LId;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'edit_entry', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Updated');
|
||||
end;
|
||||
|
||||
// ===== DELETE /entries/{id} ==================================================
|
||||
|
||||
procedure HandleDeleteEntry(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId, LId: Integer;
|
||||
LPermanent: Boolean;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LId := StrToIntDef(AParams[0], 0);
|
||||
if LId = 0 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
LPermanent := GetQueryParam(ARequest, 'permanent', '0') = '1';
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
if LPermanent then
|
||||
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE id=:id AND user_id=:uid'
|
||||
else
|
||||
LQ.SQL.Text :=
|
||||
'UPDATE vault_entries SET deleted=1, deleted_at=datetime(''now'') ' +
|
||||
'WHERE id=:id AND user_id=:uid';
|
||||
LQ.ParamByName('id').AsInteger := LId;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
if LPermanent then
|
||||
LogAudit(LUserId, 'permanent_delete', GetClientIP(ARequest))
|
||||
else
|
||||
LogAudit(LUserId, 'delete_entry', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Deleted');
|
||||
end;
|
||||
|
||||
// ===== POST /entries/{id}/restore ============================================
|
||||
|
||||
procedure HandleRestoreEntry(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId, LId: Integer;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LId := StrToIntDef(AParams[0], 0);
|
||||
if LId = 0 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'UPDATE vault_entries SET deleted=0, deleted_at=NULL, ' +
|
||||
' updated_at=datetime(''now'') ' +
|
||||
'WHERE id=:id AND user_id=:uid';
|
||||
LQ.ParamByName('id').AsInteger := LId;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'restore_entry', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Restored');
|
||||
end;
|
||||
|
||||
// ===== POST /entries/{id}/favorite ===========================================
|
||||
|
||||
procedure HandleToggleFavorite(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId, LId: Integer;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LId := StrToIntDef(AParams[0], 0);
|
||||
if LId = 0 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'UPDATE vault_entries ' +
|
||||
'SET favorite = CASE WHEN favorite=1 THEN 0 ELSE 1 END ' +
|
||||
'WHERE id=:id AND user_id=:uid';
|
||||
LQ.ParamByName('id').AsInteger := LId;
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'toggle_favorite', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Toggled');
|
||||
end;
|
||||
|
||||
// ===== DELETE /entries/trash/empty ===========================================
|
||||
|
||||
procedure HandleEmptyTrash(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LQ: TFDQuery;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE user_id=:uid AND deleted=1';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'empty_trash', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Trash emptied');
|
||||
end;
|
||||
|
||||
initialization
|
||||
// /entries/trash/empty must be registered BEFORE /entries/{id} to win the regex match
|
||||
Router.Register('DELETE', '/entries/trash/empty', HandleEmptyTrash);
|
||||
Router.Register('POST', '/entries/(\d+)/restore', HandleRestoreEntry);
|
||||
Router.Register('POST', '/entries/(\d+)/favorite', HandleToggleFavorite);
|
||||
Router.Register('GET', '/entries', HandleGetEntries);
|
||||
Router.Register('POST', '/entries', HandleCreateEntry);
|
||||
Router.Register('PUT', '/entries/(\d+)', HandleUpdateEntry);
|
||||
Router.Register('DELETE', '/entries/(\d+)', HandleDeleteEntry);
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,200 @@
|
||||
unit PM.Handler.Folders;
|
||||
|
||||
(*
|
||||
GET /folders -> JSON array of folder names
|
||||
POST /folders body {name} -> {message,name}
|
||||
DELETE /folders/{name} -> {message}
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.JSON, System.NetEncoding,
|
||||
FireDAC.Comp.Client, FireDAC.Stan.Param,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit;
|
||||
|
||||
// ===== GET /folders ==========================================================
|
||||
|
||||
procedure HandleGetFolders(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LQ: TFDQuery;
|
||||
LArr: TJSONArray;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LArr := TJSONArray.Create;
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'SELECT name FROM folders WHERE user_id = :uid ORDER BY name';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.Open;
|
||||
while not LQ.Eof do
|
||||
begin
|
||||
LArr.Add(LQ.FieldByName('name').AsString);
|
||||
LQ.Next;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
TJSONHelper.SendJSON(AResponse, LArr);
|
||||
end;
|
||||
|
||||
// ===== POST /folders =========================================================
|
||||
|
||||
procedure HandleCreateFolder(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LBody: TJSONObject;
|
||||
LName: string;
|
||||
LQ: TFDQuery;
|
||||
LObj: TJSONObject;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
LBody := TJSONHelper.ReadBody(ARequest);
|
||||
try
|
||||
LName := Trim(LBody.GetValue<string>('name', ''));
|
||||
finally
|
||||
LBody.Free;
|
||||
end;
|
||||
|
||||
if LName = '' then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Folder name required');
|
||||
Exit;
|
||||
end;
|
||||
if SameText(LName, 'All') then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Cannot use All');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'INSERT INTO folders (user_id, name) VALUES (:uid, :name)';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('name').AsString := LName;
|
||||
try
|
||||
LQ.ExecSQL;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 409, 'Folder exists');
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'add_folder', GetClientIP(ARequest));
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('message', 'Created');
|
||||
LObj.AddPair('name', LName);
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
// ===== DELETE /folders/{name} ================================================
|
||||
|
||||
procedure HandleDeleteFolder(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LUserId: Integer;
|
||||
LName: string;
|
||||
LQ: TFDQuery;
|
||||
LChanges: Integer;
|
||||
begin
|
||||
try
|
||||
LUserId := Authenticate(ARequest, AResponse);
|
||||
RequireCSRF(ARequest, AResponse, LUserId);
|
||||
except
|
||||
on ESessionRejected do Exit;
|
||||
end;
|
||||
|
||||
if Length(AParams) < 1 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Folder name required');
|
||||
Exit;
|
||||
end;
|
||||
LName := TNetEncoding.URL.Decode(AParams[0]);
|
||||
|
||||
if SameText(LName, 'All') then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 400, 'Cannot delete All');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DB.Lock;
|
||||
try
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text := 'DELETE FROM folders WHERE user_id = :uid AND name = :name';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('name').AsString := LName;
|
||||
LQ.ExecSQL;
|
||||
LChanges := LQ.RowsAffected;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
|
||||
if LChanges = 0 then
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// Reassign entries from the deleted folder to 'All'
|
||||
LQ := TFDQuery.Create(nil);
|
||||
try
|
||||
LQ.Connection := DB.Connection;
|
||||
LQ.SQL.Text :=
|
||||
'UPDATE vault_entries SET folder = ''All'' ' +
|
||||
'WHERE user_id = :uid AND folder = :name';
|
||||
LQ.ParamByName('uid').AsInteger := LUserId;
|
||||
LQ.ParamByName('name').AsString := LName;
|
||||
LQ.ExecSQL;
|
||||
finally
|
||||
LQ.Free;
|
||||
end;
|
||||
finally
|
||||
DB.Unlock;
|
||||
end;
|
||||
|
||||
LogAudit(LUserId, 'delete_folder', GetClientIP(ARequest));
|
||||
TJSONHelper.SendOK(AResponse, 'Deleted');
|
||||
end;
|
||||
|
||||
initialization
|
||||
Router.Register('GET', '/folders', HandleGetFolders);
|
||||
Router.Register('POST', '/folders', HandleCreateFolder);
|
||||
Router.Register('DELETE', '/folders/(.+)', HandleDeleteFolder);
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,47 @@
|
||||
unit PM.Handler.Passkey;
|
||||
|
||||
(*
|
||||
WebAuthn / Passkey endpoints — stubbed to 501 Not Implemented.
|
||||
|
||||
Why stubbed: full WebAuthn server requires:
|
||||
- CBOR decoder for COSE keys + attestation objects
|
||||
- DER ASN.1 encoder for ES256/RS256 public keys
|
||||
- ECDSA P-256 signature verification (no native Delphi support)
|
||||
- Challenge management with constant-time compares
|
||||
Roughly 500-700 lines of crypto-sensitive code. The PHP version (api.php
|
||||
lines 168-657) handles this with OpenSSL bindings. A faithful Delphi port
|
||||
would either bind libssl/libcrypto DLLs or pull in a pure-Pascal EC lib.
|
||||
|
||||
For v1 of the Delphi backend we return 501 with a clear message so the
|
||||
frontend gracefully falls back to master password login. The PHP backend
|
||||
remains the reference for passkey-enabled deployments.
|
||||
|
||||
When implemented, see:
|
||||
api.php :169-211 cbor_decode, derLen, coseToPem
|
||||
api.php :537-657 register/begin, register/complete, login/begin, login/complete
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON;
|
||||
|
||||
procedure HandleStub(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
begin
|
||||
TJSONHelper.SendError(AResponse, 501,
|
||||
'Passkey/WebAuthn is not implemented in the Delphi backend yet. ' +
|
||||
'Use master-password login, or run the PHP backend for passkey support.');
|
||||
end;
|
||||
|
||||
initialization
|
||||
Router.Register('POST', '/passkey/register/begin', HandleStub);
|
||||
Router.Register('POST', '/passkey/register/complete', HandleStub);
|
||||
Router.Register('POST', '/passkey/login/begin', HandleStub);
|
||||
Router.Register('POST', '/passkey/login/complete', HandleStub);
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,31 @@
|
||||
unit PM.Handler.Ping;
|
||||
|
||||
(*
|
||||
Minimal stub route to verify the build/run pipeline.
|
||||
GET /ping returns a small JSON object with message=pong and server=delphi.
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.JSON, System.SysUtils,
|
||||
IdCustomHTTPServer,
|
||||
PM.Router, PM.JSON;
|
||||
|
||||
procedure HandlePing(ARequest: TIdHTTPRequestInfo;
|
||||
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
||||
var
|
||||
LObj: TJSONObject;
|
||||
begin
|
||||
LObj := TJSONObject.Create;
|
||||
LObj.AddPair('message', 'pong');
|
||||
LObj.AddPair('server', 'delphi');
|
||||
TJSONHelper.SendJSON(AResponse, LObj);
|
||||
end;
|
||||
|
||||
initialization
|
||||
Router.Register('GET', '/ping', HandlePing);
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user