Zaki/Password-Manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a911f2588fa0eb54e1478508b9af0c06eff11568
Password-Manager/delphi-backend/Handlers/PM.Handler.Entries.pas
T
r-zakarya a911f2588f fix(sync): preserve created_at/updated_at when sync adds a remote entry 
Same class as the reported import bug, other door: POST /entries always
stamped now, so an entry arriving on a device via sync lost its original
creation date (and advertised a fake edit via fresh updated_at).
HandleCreateEntry now honours body timestamps like bulk-import (absent ->
now); applyRemoteSnapshot already ships them through encryptImportEntry,
normalized to the DB format. Regular saves/duplicates send none - unchanged.
password_changed_at shares the created_at param, which is faithful: the
password is at least as old as the entry.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-13 00:18:13 +01:00

1449 lines
54 KiB
ObjectPascal
Raw Blame History

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,
System.Generics.Collections,
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;
// RFC 4122 v4 UUID — lowercase canonical hex with dashes, no braces.
// Used as the cross-device stable identity for vault_entries.
function NewUUIDv4: string;
var
G: TGUID;
S: string;
begin
CreateGUID(G);
S := GUIDToString(G);
// Strip surrounding braces RTL adds, lowercase the rest.
if (Length(S) > 0) and (S[1] = '{') then
S := Copy(S, 2, Length(S) - 2);
Result := LowerCase(S);
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;
// Emit a TEXT field as a JSON string, or JSON null when the column is NULL.
// Used for the *_enc/*_iv encrypted-metadata columns so the client can tell
// "not migrated yet" (null) from "encrypted, empty plaintext" (a string).
procedure AddNullableField(AObj: TJSONObject; const AName: string; AField: TField);
begin
if AField.IsNull then
AObj.AddPair(AName, TJSONNull.Create)
else
AObj.AddPair(AName, AField.AsString);
end;
// Bind a TEXT param as NULL when empty, else the value (ftMemo so long
// ciphertext isn't truncated). For the encrypted-metadata *_enc/*_iv params.
procedure BindNullable(AQ: TFDQuery; const AParam, AValue: string);
begin
AQ.ParamByName(AParam).DataType := ftMemo;
if AValue = '' then AQ.ParamByName(AParam).Clear
else AQ.ParamByName(AParam).Value := AValue;
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;
// The ?search= query param is now ignored server-side: site AND username
// are both encrypted at rest, so a SQL LIKE can't match them. The
// frontend loads the whole (decrypted) vault and filters client-side —
// it never sends ?search=. Kept LSearch read for API back-compat only.
LQ.SQL.Text :=
'SELECT * FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = :del ' +
'ORDER BY updated_at DESC';
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));
// site/username/title/tags cleartext columns dropped — the client
// reads them from *_enc only (decryptEntryMeta).
if LQ.FieldByName('username_enc').IsNull then
LObj.AddPair('username_enc', TJSONNull.Create)
else
LObj.AddPair('username_enc', LQ.FieldByName('username_enc').AsString);
if LQ.FieldByName('username_iv').IsNull then
LObj.AddPair('username_iv', TJSONNull.Create)
else
LObj.AddPair('username_iv', LQ.FieldByName('username_iv').AsString);
// Encrypted site / title / tags — same scheme as username_enc. NULL →
// JSON null so the client falls back to the cleartext siblings above.
AddNullableField(LObj, 'site_enc', LQ.FieldByName('site_enc'));
AddNullableField(LObj, 'site_iv', LQ.FieldByName('site_iv'));
AddNullableField(LObj, 'title_enc', LQ.FieldByName('title_enc'));
AddNullableField(LObj, 'title_iv', LQ.FieldByName('title_iv'));
AddNullableField(LObj, 'tags_enc', LQ.FieldByName('tags_enc'));
AddNullableField(LObj, 'tags_iv', LQ.FieldByName('tags_iv'));
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('pinned', TJSONNumber.Create(LQ.FieldByName('pinned').AsInteger));
// TOTP fields are NULL when the entry has no 2FA configured. We emit
// JSON null instead of '' so the client can distinguish "no TOTP" from
// "TOTP configured with empty ciphertext" (which shouldn't happen).
if LQ.FieldByName('totp_secret').IsNull then
LObj.AddPair('totp_secret', TJSONNull.Create)
else
LObj.AddPair('totp_secret', LQ.FieldByName('totp_secret').AsString);
if LQ.FieldByName('totp_iv').IsNull then
LObj.AddPair('totp_iv', TJSONNull.Create)
else
LObj.AddPair('totp_iv', LQ.FieldByName('totp_iv').AsString);
// Cached favicon (base64 data URI). NULL = no icon cached yet —
// the JS layer falls back to first-letter avatar.
if LQ.FieldByName('icon_b64').IsNull then
LObj.AddPair('icon_b64', TJSONNull.Create)
else
LObj.AddPair('icon_b64', LQ.FieldByName('icon_b64').AsString);
// Entry kind. Legacy / unset → 'login'.
var LKindVal := LQ.FieldByName('kind').AsString;
if LKindVal = '' then LKindVal := 'login';
LObj.AddPair('kind', LKindVal);
// Template subtype — encrypted at rest only (template_enc/iv); the
// cleartext column was dropped post-migration like site/username.
AddNullableField(LObj, 'template_enc', LQ.FieldByName('template_enc'));
AddNullableField(LObj, 'template_iv', LQ.FieldByName('template_iv'));
// Stable cross-device identity (always populated post-migration).
LObj.AddPair('uuid', LQ.FieldByName('uuid').AsString);
// Custom fields: opaque ciphertext + IV, treated identically to
// password / totp_secret. NULL → JSON null so the client can
// distinguish "never set" from "empty array stored".
if LQ.FieldByName('custom_fields').IsNull then
LObj.AddPair('custom_fields', TJSONNull.Create)
else
LObj.AddPair('custom_fields', LQ.FieldByName('custom_fields').AsString);
if LQ.FieldByName('custom_fields_iv').IsNull then
LObj.AddPair('custom_fields_iv', TJSONNull.Create)
else
LObj.AddPair('custom_fields_iv', LQ.FieldByName('custom_fields_iv').AsString);
LObj.AddPair('created_at', ISODateTimeField(LQ.FieldByName('created_at')));
LObj.AddPair('updated_at', ISODateTimeField(LQ.FieldByName('updated_at')));
if LQ.FieldByName('accessed_at').IsNull then
LObj.AddPair('accessed_at', TJSONNull.Create)
else
LObj.AddPair('accessed_at', ISODateTimeField(LQ.FieldByName('accessed_at')));
if LQ.FieldByName('password_changed_at').IsNull then
LObj.AddPair('password_changed_at', TJSONNull.Create)
else
LObj.AddPair('password_changed_at', ISODateTimeField(LQ.FieldByName('password_changed_at')));
LArr.Add(LObj);
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendJSON(AResponse, LArr);
end;
// ===== GET /entries/tombstones ==============================================
// Sync helper — returns the uuid + deleted_at of every permanently-removed
// entry so the merge engine can propagate deletes to other devices.
procedure HandleGetTombstones(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId: Integer;
LQ: TFDQuery;
LArr: TJSONArray;
LObj: TJSONObject;
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 uuid, deleted_at FROM entry_tombstones ' +
'WHERE user_id = :uid ORDER BY deleted_at DESC';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
while not LQ.Eof do
begin
LObj := TJSONObject.Create;
LObj.AddPair('uuid', LQ.FieldByName('uuid').AsString);
LObj.AddPair('deleted_at', ISODateTimeField(LQ.FieldByName('deleted_at')));
LArr.Add(LObj);
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendJSON(AResponse, LArr);
end;
// ===== POST /entries/tombstones =============================================
// Sync helper — body {uuids: ["x","y", ...]} adds tombstones for entries
// deleted on another device. Idempotent (UNIQUE constraint).
procedure HandlePostTombstones(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, I, LAdded: Integer;
LBody: TJSONObject;
LArr: TJSONArray;
LQ: TFDQuery;
LUuid: string;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
LAdded := 0;
try
LArr := LBody.GetValue<TJSONArray>('uuids');
if (LArr = nil) or (LArr.Count = 0) then
begin
TJSONHelper.SendOK(AResponse, 'No tombstones');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'VALUES (:uid, :u)';
for I := 0 to LArr.Count - 1 do
begin
LUuid := Trim(LArr.Items[I].Value);
if LUuid = '' then Continue;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('u').AsString := LUuid;
LQ.ExecSQL;
if LQ.RowsAffected > 0 then Inc(LAdded);
end;
// Hard-delete any local entries whose UUID just received a
// tombstone — propagates remote deletes during sync pull.
LQ.SQL.Text :=
'DELETE FROM vault_entries WHERE user_id = :uid AND uuid IN ' +
' (SELECT uuid FROM entry_tombstones WHERE user_id = :uid)';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
finally
LBody.Free;
end;
TJSONHelper.SendOK(AResponse, IntToStr(LAdded) + ' tombstones added');
end;
// ===== POST /entries =========================================================
procedure HandleCreateEntry(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LNewId: Integer;
LBody, LObj: TJSONObject;
LSite, LTitle, LUser, LUserEnc, LUserIv, LFolder, LEnc, LIV, LTags, LNow,
LTotpSec, LTotpIv, LKind, LCf, LCfIv, LIcon, LUuid,
LTemplateEnc, LTemplateIv, LCreatedAt, LUpdatedAt,
LSiteEnc, LSiteIv, LTitleEnc, LTitleIv, LTagsEnc, LTagsIv: 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', ''));
LTitle := Trim(LBody.GetValue<string>('title', ''));
LUser := Trim(LBody.GetValue<string>('username', ''));
// Encrypted username (metadata-at-rest). When present the client has
// already wiped the cleartext `username` to '' — the ciphertext is stored
// in username_enc/username_iv instead.
LUserEnc := LBody.GetValue<string>('username_enc', '');
LUserIv := LBody.GetValue<string>('username_iv', '');
// Encrypted site / title / tags — same scheme. Cleartext siblings are ''
// when these are present.
LSiteEnc := LBody.GetValue<string>('site_enc', '');
LSiteIv := LBody.GetValue<string>('site_iv', '');
LTitleEnc:= LBody.GetValue<string>('title_enc', '');
LTitleIv := LBody.GetValue<string>('title_iv', '');
LTagsEnc := LBody.GetValue<string>('tags_enc', '');
LTagsIv := LBody.GetValue<string>('tags_iv', '');
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
LEnc := LBody.GetValue<string>('encrypted_password', '');
LIV := LBody.GetValue<string>('iv', '');
LTags := Trim(LBody.GetValue<string>('tags', ''));
// TOTP secret + IV — optional. Empty string = no TOTP configured.
LTotpSec := LBody.GetValue<string>('totp_secret', '');
LTotpIv := LBody.GetValue<string>('totp_iv', '');
LKind := LBody.GetValue<string>('kind', 'login');
LCf := LBody.GetValue<string>('custom_fields', '');
LCfIv := LBody.GetValue<string>('custom_fields_iv', '');
LIcon := LBody.GetValue<string>('icon_b64', '');
LTemplateEnc := LBody.GetValue<string>('template_enc', '');
LTemplateIv := LBody.GetValue<string>('template_iv', '');
// Caller may bring its own UUID (sync restore / import preserving
// identity). Otherwise the server mints a fresh one.
LUuid := Trim(LBody.GetValue<string>('uuid', ''));
if LUuid = '' then LUuid := NewUUIDv4;
// Preserve original timestamps when the caller carries them (sync adds
// a remote entry via applyRemoteSnapshot -> encryptImportEntry). Same
// contract as bulk-import: absent/empty -> stamp now. Regular saves
// (soSave, duplicate) don't send them, so nothing changes there.
LCreatedAt := Trim(LBody.GetValue<string>('created_at', ''));
LUpdatedAt := Trim(LBody.GetValue<string>('updated_at', ''));
finally
LBody.Free;
end;
if (LKind <> 'login') and (LKind <> 'note') then LKind := 'login';
if LEnc = '' then
begin
TJSONHelper.SendError(AResponse, 400, 'Content required');
Exit;
end;
// NOTE: the old "Site required" check is gone — site is now encrypted at
// rest (LSite is '' when the client sent site_enc), so the server can't
// read it. The client already enforces "site + password required" before
// saving a login.
LNow := NowUTCStr; // UTC — matches SQLite CURRENT_TIMESTAMP (see CODE_AUDIT §2.2)
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT INTO vault_entries ' +
'(user_id, username_enc, username_iv, ' +
' site_enc, site_iv, title_enc, title_iv, tags_enc, tags_iv, ' +
' encrypted_password, iv, encryption_method, ' +
' folder, totp_secret, totp_iv, kind, custom_fields, custom_fields_iv,' +
' icon_b64, template_enc, template_iv, uuid, created_at, updated_at, password_changed_at) ' +
'VALUES (:uid, :uenc, :uiv, :senc, :siv, :tenc, :tiv2, :genc, :giv, ' +
' :e, :i, ''client'', :f, :ts, :tiv, :k, ' +
' :cf, :cfiv, :ic, :tplenc, :tpliv, :uuid, :c, :c2, :c)';
LQ.ParamByName('uid').AsInteger := LUserId;
// site/username/title/tags cleartext columns dropped — only *_enc written.
BindNullable(LQ, 'uenc', LUserEnc);
BindNullable(LQ, 'uiv', LUserIv);
BindNullable(LQ, 'senc', LSiteEnc);
BindNullable(LQ, 'siv', LSiteIv);
BindNullable(LQ, 'tenc', LTitleEnc);
BindNullable(LQ, 'tiv2', LTitleIv);
BindNullable(LQ, 'genc', LTagsEnc);
BindNullable(LQ, 'giv', LTagsIv);
LQ.ParamByName('e').AsString := LEnc;
LQ.ParamByName('i').AsString := LIV;
LQ.ParamByName('f').AsString := LFolder;
// FireDAC needs an explicit DataType on params that are sometimes
// assigned a string and sometimes Clear()ed to NULL — without a
// prior typed assignment, .Clear raises "data type unknown" on
// SQLite. Declare ftString up front for the optional TOTP fields.
LQ.ParamByName('ts').DataType := ftMemo;
LQ.ParamByName('tiv').DataType := ftMemo;
// Store empty TOTP fields as NULL so the GET endpoint emits JSON null
// rather than '' — keeps client-side "has TOTP?" checks unambiguous.
if LTotpSec = '' then
LQ.ParamByName('ts').Clear
else
LQ.ParamByName('ts').Value := LTotpSec;
if LTotpIv = '' then
LQ.ParamByName('tiv').Clear
else
LQ.ParamByName('tiv').Value := LTotpIv;
LQ.ParamByName('k').AsString := LKind;
LQ.ParamByName('cf').DataType := ftMemo;
LQ.ParamByName('cfiv').DataType := ftMemo;
if LCf = '' then LQ.ParamByName('cf').Clear else LQ.ParamByName('cf').Value := LCf;
if LCfIv = '' then LQ.ParamByName('cfiv').Clear else LQ.ParamByName('cfiv').Value := LCfIv;
LQ.ParamByName('ic').DataType := ftMemo;
if LIcon = '' then LQ.ParamByName('ic').Clear else LQ.ParamByName('ic').Value := LIcon;
BindNullable(LQ, 'tplenc', LTemplateEnc);
BindNullable(LQ, 'tpliv', LTemplateIv);
LQ.ParamByName('uuid').AsString := LUuid;
if LCreatedAt = '' then LCreatedAt := LNow;
if LUpdatedAt = '' then LUpdatedAt := LNow;
LQ.ParamByName('c').AsString := LCreatedAt;
LQ.ParamByName('c2').AsString := LUpdatedAt;
LQ.ExecSQL;
LNewId := DB.Connection.GetLastAutoGenValue('vault_entries');
// Clear any tombstone shadowing this uuid — a re-created entry
// (sync restore keeping its identity, or an undo of a hard
// delete) must not be silently re-killed on the next sync.
LQ.SQL.Text :=
'DELETE FROM entry_tombstones WHERE user_id = :uid AND uuid = :uuid';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('uuid').AsString := LUuid;
LQ.ExecSQL;
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('uuid', LUuid);
LObj.AddPair('site', LSite);
LObj.AddPair('title', LTitle);
LObj.AddPair('username', LUser);
LObj.AddPair('folder', LFolder);
LObj.AddPair('tags', LTags);
LObj.AddPair('kind', LKind);
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, LTitle, LUser, LUserEnc, LUserIv, LFolder, LEnc, LIV, LTags, LNow,
LTotpSec, LTotpIv, LKind, LCf, LCfIv, LTemplateEnc, LTemplateIv,
LSiteEnc, LSiteIv, LTitleEnc, LTitleIv, LTagsEnc, LTagsIv: string;
LHasTemplate: 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;
LBody := TJSONHelper.ReadBody(ARequest);
try
LSite := Trim(LBody.GetValue<string>('site', ''));
LTitle := Trim(LBody.GetValue<string>('title', ''));
LUser := Trim(LBody.GetValue<string>('username', ''));
LUserEnc := LBody.GetValue<string>('username_enc', '');
LUserIv := LBody.GetValue<string>('username_iv', '');
LSiteEnc := LBody.GetValue<string>('site_enc', '');
LSiteIv := LBody.GetValue<string>('site_iv', '');
LTitleEnc:= LBody.GetValue<string>('title_enc', '');
LTitleIv := LBody.GetValue<string>('title_iv', '');
LTagsEnc := LBody.GetValue<string>('tags_enc', '');
LTagsIv := LBody.GetValue<string>('tags_iv', '');
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
LEnc := LBody.GetValue<string>('encrypted_password', '');
LIV := LBody.GetValue<string>('iv', '');
LTags := Trim(LBody.GetValue<string>('tags', ''));
LTotpSec := LBody.GetValue<string>('totp_secret', '');
LTotpIv := LBody.GetValue<string>('totp_iv', '');
LKind := LBody.GetValue<string>('kind', 'login');
LCf := LBody.GetValue<string>('custom_fields', '');
LCfIv := LBody.GetValue<string>('custom_fields_iv', '');
// Template is only updated when the caller explicitly sends it —
// partial PUTs (drag-to-folder) must not wipe it. withEncryptedMeta always
// ships template (blanked cleartext key) + template_enc together, so the
// presence of the 'template' JSON key gates the ciphertext columns.
// (Cleartext template column dropped — only *_enc/_iv are stored.)
LHasTemplate := LBody.GetValue('template') <> nil;
LTemplateEnc := LBody.GetValue<string>('template_enc', '');
LTemplateIv := LBody.GetValue<string>('template_iv', '');
finally
LBody.Free;
end;
if (LKind <> 'login') and (LKind <> 'note') then LKind := 'login';
if LEnc = '' then
begin
TJSONHelper.SendError(AResponse, 400, 'Content required');
Exit;
end;
// "Site required" removed — site is encrypted at rest (LSite is '' when the
// client sent site_enc). The client enforces it before saving.
LNow := NowUTCStr; // UTC — matches SQLite CURRENT_TIMESTAMP (see CODE_AUDIT §2.2)
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
// Insert pre-update ciphertext into history ONLY when it actually
// changed (JS reuses originalEncrypted bit-for-bit otherwise).
LQ.SQL.Text :=
'INSERT INTO entries_password_history ' +
' (entry_id, user_id, encrypted_password, iv, kind, changed_at) ' +
'SELECT id, user_id, encrypted_password, iv, ' +
' COALESCE(NULLIF(kind, ''''), ''login''), :now ' +
'FROM vault_entries ' +
'WHERE id = :id AND user_id = :uid ' +
' AND encrypted_password <> :newenc';
LQ.ParamByName('now').AsString := LNow;
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('newenc').AsString := LEnc;
LQ.ExecSQL;
// Cap to last 20 versions.
LQ.SQL.Text :=
'DELETE FROM entries_password_history WHERE id IN (' +
' SELECT id FROM entries_password_history ' +
' WHERE entry_id = :id ' +
' ORDER BY changed_at DESC ' +
' LIMIT -1 OFFSET 20)';
LQ.ParamByName('id').AsInteger := LId;
LQ.ExecSQL;
// password_changed_at fires only when the ciphertext actually
// changes — same conditional used above for history insertion.
// template column is updated only when the caller sent it, so a
// partial PUT (drag-to-folder, move-to-folder) doesn't wipe it.
var LTemplateSet := '';
if LHasTemplate then
LTemplateSet := ', template_enc=:tplenc, template_iv=:tpliv';
LQ.SQL.Text :=
'UPDATE vault_entries ' +
'SET username_enc=:uenc, username_iv=:uiv, ' +
' site_enc=:senc, site_iv=:siv, title_enc=:tenc, title_iv=:tiv2, ' +
' tags_enc=:genc, tags_iv=:giv, ' +
' encrypted_password=:e, iv=:i, ' +
' folder=:f, totp_secret=:ts, totp_iv=:tiv, kind=:k, ' +
' custom_fields=:cf, custom_fields_iv=:cfiv, ' +
' updated_at=:c, ' +
' password_changed_at = CASE WHEN encrypted_password <> :e ' +
' THEN :c ELSE password_changed_at END' +
LTemplateSet + ' ' +
'WHERE id=:id AND user_id=:uid';
// site/username/title/tags cleartext columns dropped — only *_enc written.
BindNullable(LQ, 'uenc', LUserEnc);
BindNullable(LQ, 'uiv', LUserIv);
BindNullable(LQ, 'senc', LSiteEnc);
BindNullable(LQ, 'siv', LSiteIv);
BindNullable(LQ, 'tenc', LTitleEnc);
BindNullable(LQ, 'tiv2', LTitleIv);
BindNullable(LQ, 'genc', LTagsEnc);
BindNullable(LQ, 'giv', LTagsIv);
LQ.ParamByName('e').AsString := LEnc;
LQ.ParamByName('i').AsString := LIV;
LQ.ParamByName('f').AsString := LFolder;
// Declare TOTP param types so .Clear works on first use (FireDAC
// needs an inferred or explicit DataType before NULL binding).
LQ.ParamByName('ts').DataType := ftMemo;
LQ.ParamByName('tiv').DataType := ftMemo;
// Clearing TOTP (user removed 2FA from this entry) is signaled by an
// empty string in the request → store NULL in the DB.
if LTotpSec = '' then
LQ.ParamByName('ts').Clear
else
LQ.ParamByName('ts').Value := LTotpSec;
if LTotpIv = '' then
LQ.ParamByName('tiv').Clear
else
LQ.ParamByName('tiv').Value := LTotpIv;
LQ.ParamByName('k').AsString := LKind;
LQ.ParamByName('cf').DataType := ftMemo;
LQ.ParamByName('cfiv').DataType := ftMemo;
if LCf = '' then LQ.ParamByName('cf').Clear else LQ.ParamByName('cf').Value := LCf;
if LCfIv = '' then LQ.ParamByName('cfiv').Clear else LQ.ParamByName('cfiv').Value := LCfIv;
if LHasTemplate then
begin
BindNullable(LQ, 'tplenc', LTemplateEnc);
BindNullable(LQ, 'tpliv', LTemplateIv);
end;
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
begin
// Record a tombstone BEFORE the delete so the sync engine can
// propagate this removal to other devices. UPSERT semantics —
// re-deleting an already-tombstoned uuid is a no-op.
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'SELECT user_id, uuid FROM vault_entries ' +
'WHERE id = :id AND user_id = :uid AND uuid IS NOT NULL';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE id=:id AND user_id=:uid';
end
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;
// ===== POST /entries/{id}/pin ================================================
// Same shape as /favorite: flip the pinned bit, no body required.
procedure HandleTogglePin(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 pinned = CASE WHEN pinned=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_pin', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Toggled');
end;
// ===== POST /entries/{id}/touch ==============================================
// Bumps accessed_at. Called from JS on copy / slideover-open so the sidebar
// "Recent" view can show what the user actually uses. Auth-only (no CSRF
// requirement — this is a write but harmless to forge across sessions, and
// the call is fire-and-forget from clipboard handlers where blocking on
// CSRF would be visibly laggy).
procedure HandleTouchEntry(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
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 accessed_at = CURRENT_TIMESTAMP ' +
'WHERE id = :id AND user_id = :uid AND deleted = 0';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendOK(AResponse);
end;
// ===== POST /entries/{id}/icon ===============================================
// Stores (or clears) a cached favicon for one entry. Separate endpoint so the
// client can save the icon without re-PUT-ing the full entry (which would
// require re-encrypting the password). Body: {"icon_b64":"data:image/...;base64,..."}
// — empty string clears the cached icon.
procedure HandleSetEntryIcon(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LBody: TJSONObject;
LIcon: 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
LIcon := LBody.GetValue<string>('icon_b64', '');
finally
LBody.Free;
end;
// Soft cap on the SERIALISED data URI ('data:image/...;base64,...'). The
// favicon fetcher allows 256 KB raw, which becomes ~350 KB after base64
// + prefix overhead. Cap at 512 KB chars so a max-raw fetch + a bit of
// headroom still passes (the silent 413 here was deleting deepseek's
// 200+ KB icon on lock/unlock since saveEntryIcon swallows the error).
if Length(LIcon) > 524288 then
begin
TJSONHelper.SendError(AResponse, 413, 'Icon too large');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
// Bump updated_at (UTC) so the icon change wins last-write-wins on
// sync — without it the new icon_b64 rides in the snapshot but other
// devices skip it (timestamp unchanged → "not newer").
'UPDATE vault_entries SET icon_b64 = :ic, updated_at = datetime(''now'') ' +
'WHERE id=:id AND user_id=:uid';
LQ.ParamByName('ic').DataType := ftMemo; // long text → ftMemo on SQLite
if LIcon = '' then LQ.ParamByName('ic').Clear
else LQ.ParamByName('ic').Value := LIcon;
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendOK(AResponse, 'Icon saved');
end;
// ===== DELETE /entries/icons/all =============================================
// Bulk-clear cached favicons for all entries of the current user. Used by the
// Settings "Clear cached icons" button.
procedure HandleClearAllIcons(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 :=
'UPDATE vault_entries SET icon_b64 = NULL WHERE user_id = :uid';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LogAudit(LUserId, 'clear_icons', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Icons cleared');
end;
// ===== GET /entries/{id}/history =============================================
// Returns up to 20 prior versions of one entry's encrypted_password+iv.
// The client decrypts with the current vault key (rotation re-encrypts the
// whole history table, see HandleChangeMasterPassword in PM.Handler.Auth).
procedure HandleGetEntryHistory(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LQ: TFDQuery;
LArr: TJSONArray;
LObj: TJSONObject;
begin
try
LUserId := Authenticate(ARequest, AResponse);
except
on ESessionRejected do Exit;
end;
LId := StrToIntDef(AParams[0], 0);
if LId = 0 then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
Exit;
end;
LArr := TJSONArray.Create;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'SELECT id, encrypted_password, iv, kind, changed_at ' +
'FROM entries_password_history ' +
'WHERE entry_id = :id AND user_id = :uid ' +
'ORDER BY changed_at DESC';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
while not LQ.Eof do
begin
LObj := TJSONObject.Create;
LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
LObj.AddPair('encrypted_password', LQ.FieldByName('encrypted_password').AsString);
LObj.AddPair('iv', LQ.FieldByName('iv').AsString);
LObj.AddPair('kind', LQ.FieldByName('kind').AsString);
LObj.AddPair('changed_at', ISODateTimeField(LQ.FieldByName('changed_at')));
LArr.Add(LObj);
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendJSON(AResponse, LArr);
end;
// ===== DELETE /entries/trash/old?days=N ======================================
// Permanently deletes trashed entries whose deleted_at is older than N days.
// Driven by the user's "Auto-purge trash" setting; called from JS at login.
procedure HandleAutoPurgeTrash(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LDays, LPurged: Integer;
LQ: TFDQuery;
LObj: TJSONObject;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LDays := StrToIntDef(GetQueryParam(ARequest, 'days', '0'), 0);
if (LDays <= 0) or (LDays > 3650) then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid days');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
// Tombstones FIRST so the sync engine can propagate the purge.
LQ.SQL.Text :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'SELECT user_id, uuid FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = 1 AND uuid IS NOT NULL ' +
' AND deleted_at IS NOT NULL ' +
' AND (julianday(''now'') - julianday(deleted_at)) >= :d';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('d').AsInteger := LDays;
LQ.ExecSQL;
LQ.SQL.Text :=
'DELETE FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = 1 ' +
' AND deleted_at IS NOT NULL ' +
' AND (julianday(''now'') - julianday(deleted_at)) >= :d';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('d').AsInteger := LDays;
LQ.ExecSQL;
LPurged := LQ.RowsAffected;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
if LPurged > 0 then
LogAudit(LUserId, Format('auto_purge_trash %d entries (> %d days)',
[LPurged, LDays]), GetClientIP(ARequest));
LObj := TJSONObject.Create;
LObj.AddPair('purged', TJSONNumber.Create(LPurged));
TJSONHelper.SendJSON(AResponse, LObj);
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 :=
'INSERT OR IGNORE INTO entry_tombstones (user_id, uuid) ' +
'SELECT user_id, uuid FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = 1 AND uuid IS NOT NULL';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
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;
// ===== POST /entries/bulk-import =============================================
// Accepts an array of already-encrypted entries (the client encrypts each
// entry with the vault key before posting). Inserts them all in a single
// transaction so a partial failure rolls back cleanly. Used by the JSON / CSV
// import flow — much faster than N sequential POST /entries for large vaults.
procedure HandleBulkImport(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, I, LImported, LNewId: Integer;
LBody, LObj, LEntry: TJSONObject;
LArr, LIds: TJSONArray;
LSite, LTitle, LUser, LUserEnc, LUserIv, LFolder, LEnc, LIV, LTags, LTotpSec,
LTotpIv, LNow, LKind, LCf, LCfIv, LIcon, LTemplateEnc, LTemplateIv, LUuid,
LCreatedAt, LUpdatedAt,
LSiteEnc, LSiteIv, LTitleEnc, LTitleIv, LTagsEnc, LTagsIv: string;
LQ, LTomb: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LArr := LBody.GetValue<TJSONArray>('entries');
if (LArr = nil) or (LArr.Count = 0) then
begin
TJSONHelper.SendError(AResponse, 400, 'Missing or empty entries array');
Exit;
end;
// Sanity cap. A real vault rarely has > 10k entries; if someone uploads
// a 100k-row CSV it's probably an attack or a mistake.
if LArr.Count > 10000 then
begin
TJSONHelper.SendError(AResponse, 413, 'Too many entries (max 10000 per request)');
Exit;
end;
LNow := NowUTCStr; // UTC — matches SQLite CURRENT_TIMESTAMP (see CODE_AUDIT §2.2)
LImported := 0;
// Track newly-inserted IDs in input order so the client can upload
// attachments to the right entry afterwards. Skipped rows emit -1
// so the array remains positionally aligned with the input.
LIds := TJSONArray.Create;
DB.Lock;
try
DB.Connection.StartTransaction;
try
LQ := TFDQuery.Create(nil);
// Reused across the batch to clear any tombstone shadowing an
// imported uuid. Without this, restoring a backup whose entries
// were previously hard-deleted (and tombstoned) would get those
// entries wiped again on the next sync — the tombstone outlives
// the resurrection. Purging here lets a restore actually stick.
LTomb := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LTomb.Connection := DB.Connection;
LTomb.SQL.Text :=
'DELETE FROM entry_tombstones ' +
'WHERE user_id = :uid AND uuid = :uuid';
LQ.SQL.Text :=
'INSERT INTO vault_entries ' +
'(user_id, username_enc, username_iv, ' +
' site_enc, site_iv, title_enc, title_iv, tags_enc, tags_iv, ' +
' encrypted_password, iv, encryption_method, ' +
' folder, totp_secret, totp_iv, kind, custom_fields, custom_fields_iv,' +
' icon_b64, template_enc, template_iv, uuid, created_at, updated_at) ' +
'VALUES (:uid, :uenc, :uiv, :senc, :siv, :tenc, :tiv2, :genc, :giv, ' +
' :e, :i, ''client'', :f, :ts, :tiv, :k, ' +
' :cf, :cfiv, :ic, :tplenc, :tpliv, :uuid, :c, :c2)';
// Declare optional param types ONCE — the prepared statement is
// reused across every imported entry, and FireDAC needs the
// type set before the first .Clear call would otherwise fail
// for a row that omits the field. ftMemo (unlimited TEXT) is
// mandatory for icon_b64 + custom_fields which often exceed
// FireDAC's default ftString cap (~4000 chars) — a 256 KB
// icon would otherwise be silently truncated to nothing on
// the next read.
LQ.ParamByName('ts').DataType := ftMemo;
LQ.ParamByName('tiv').DataType := ftMemo;
LQ.ParamByName('cf').DataType := ftMemo;
LQ.ParamByName('cfiv').DataType := ftMemo;
LQ.ParamByName('ic').DataType := ftMemo;
LQ.ParamByName('uenc').DataType := ftMemo;
LQ.ParamByName('uiv').DataType := ftMemo;
LQ.ParamByName('senc').DataType := ftMemo;
LQ.ParamByName('siv').DataType := ftMemo;
LQ.ParamByName('tenc').DataType := ftMemo;
LQ.ParamByName('tiv2').DataType := ftMemo;
LQ.ParamByName('genc').DataType := ftMemo;
LQ.ParamByName('giv').DataType := ftMemo;
for I := 0 to LArr.Count - 1 do
begin
LEntry := LArr.Items[I] as TJSONObject;
LSite := Trim(LEntry.GetValue<string>('site', ''));
LTitle := Trim(LEntry.GetValue<string>('title', ''));
LUser := Trim(LEntry.GetValue<string>('username', ''));
LUserEnc := LEntry.GetValue<string>('username_enc', '');
LUserIv := LEntry.GetValue<string>('username_iv', '');
LSiteEnc := LEntry.GetValue<string>('site_enc', '');
LSiteIv := LEntry.GetValue<string>('site_iv', '');
LTitleEnc:= LEntry.GetValue<string>('title_enc', '');
LTitleIv := LEntry.GetValue<string>('title_iv', '');
LTagsEnc := LEntry.GetValue<string>('tags_enc', '');
LTagsIv := LEntry.GetValue<string>('tags_iv', '');
LFolder := Trim(LEntry.GetValue<string>('folder', 'All'));
LEnc := LEntry.GetValue<string>('encrypted_password', '');
LIV := LEntry.GetValue<string>('iv', '');
LTags := Trim(LEntry.GetValue<string>('tags', ''));
LTotpSec := LEntry.GetValue<string>('totp_secret', '');
LTotpIv := LEntry.GetValue<string>('totp_iv', '');
LKind := LEntry.GetValue<string>('kind', 'login');
if (LKind <> 'login') and (LKind <> 'note') then LKind := 'login';
LCf := LEntry.GetValue<string>('custom_fields', '');
LCfIv := LEntry.GetValue<string>('custom_fields_iv', '');
LIcon := LEntry.GetValue<string>('icon_b64', '');
LTemplateEnc := LEntry.GetValue<string>('template_enc', '');
LTemplateIv := LEntry.GetValue<string>('template_iv', '');
LUuid := Trim(LEntry.GetValue<string>('uuid', ''));
if LUuid = '' then LUuid := NewUUIDv4;
// Preserve the file's original timestamps on restore; fall back
// to now for foreign imports (CSV) that carry none.
LCreatedAt := Trim(LEntry.GetValue<string>('created_at', ''));
if LCreatedAt = '' then LCreatedAt := LNow;
LUpdatedAt := Trim(LEntry.GetValue<string>('updated_at', ''));
if LUpdatedAt = '' then LUpdatedAt := LNow;
// Ciphertext is always required. Site is required only for
// logins — notes legitimately have no site (their body lives
// inside the encrypted blob). Skip silently rather than fail
// the whole batch on one bad row.
if (LEnc = '') or (LIV = '') then
begin
LIds.AddElement(TJSONNumber.Create(-1));
Continue;
end;
// No "site required" skip — site is encrypted (LSite = '' when the
// row carries site_enc); the client validated before import.
LQ.ParamByName('uid').AsInteger := LUserId;
BindNullable(LQ, 'uenc', LUserEnc);
BindNullable(LQ, 'uiv', LUserIv);
BindNullable(LQ, 'senc', LSiteEnc);
BindNullable(LQ, 'siv', LSiteIv);
BindNullable(LQ, 'tenc', LTitleEnc);
BindNullable(LQ, 'tiv2', LTitleIv);
BindNullable(LQ, 'genc', LTagsEnc);
BindNullable(LQ, 'giv', LTagsIv);
LQ.ParamByName('e').AsString := LEnc;
LQ.ParamByName('i').AsString := LIV;
LQ.ParamByName('f').AsString := LFolder;
if LTotpSec = '' then LQ.ParamByName('ts').Clear
else LQ.ParamByName('ts').Value := LTotpSec;
if LTotpIv = '' then LQ.ParamByName('tiv').Clear
else LQ.ParamByName('tiv').Value := LTotpIv;
LQ.ParamByName('k').AsString := LKind;
if LCf = '' then LQ.ParamByName('cf').Clear else LQ.ParamByName('cf').Value := LCf;
if LCfIv = '' then LQ.ParamByName('cfiv').Clear else LQ.ParamByName('cfiv').Value := LCfIv;
if LIcon = '' then LQ.ParamByName('ic').Clear else LQ.ParamByName('ic').Value := LIcon;
BindNullable(LQ, 'tplenc', LTemplateEnc);
BindNullable(LQ, 'tpliv', LTemplateIv);
LQ.ParamByName('uuid').AsString := LUuid;
LQ.ParamByName('c').AsString := LCreatedAt;
LQ.ParamByName('c2').AsString := LUpdatedAt;
LQ.ExecSQL;
LNewId := DB.Connection.GetLastAutoGenValue('vault_entries');
LIds.AddElement(TJSONNumber.Create(LNewId));
Inc(LImported);
// Clear any tombstone that would otherwise resurrect-then-kill
// this uuid on the next sync.
LTomb.ParamByName('uid').AsInteger := LUserId;
LTomb.ParamByName('uuid').AsString := LUuid;
LTomb.ExecSQL;
end;
finally
LQ.Free;
LTomb.Free;
end;
DB.Connection.Commit;
except
DB.Connection.Rollback;
raise;
end;
finally
DB.Unlock;
end;
finally
LBody.Free;
end;
LogAudit(LUserId, Format('bulk_import %d entries', [LImported]), GetClientIP(ARequest));
LObj := TJSONObject.Create;
LObj.AddPair('imported', TJSONNumber.Create(LImported));
LObj.AddPair('ids', LIds);
TJSONHelper.SendJSON(AResponse, LObj);
end;
procedure HandleEntriesCount(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LActive, LTrashed: Integer;
LQ: TFDQuery;
LObj: TJSONObject;
begin
try
LUserId := Authenticate(ARequest, AResponse);
except
on ESessionRejected do Exit;
end;
LActive := 0;
LTrashed := 0;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'SELECT deleted, COUNT(*) AS cnt FROM vault_entries ' +
'WHERE user_id = :uid GROUP BY deleted';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
while not LQ.Eof do
begin
if LQ.FieldByName('deleted').AsInteger = 0 then
LActive := LQ.FieldByName('cnt').AsInteger
else
LTrashed := LQ.FieldByName('cnt').AsInteger;
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LObj := TJSONObject.Create;
LObj.AddPair('active', TJSONNumber.Create(LActive));
LObj.AddPair('trashed', TJSONNumber.Create(LTrashed));
TJSONHelper.SendJSON(AResponse, LObj);
end;
initialization
// /entries/trash/empty must be registered BEFORE /entries/{id} to win the regex match.
// Same logic for /entries/bulk-import — register before the catch-all /entries/{id}.
Router.Register('DELETE', '/entries/trash/empty', HandleEmptyTrash);
Router.Register('DELETE', '/entries/trash/old', HandleAutoPurgeTrash);
Router.Register('DELETE', '/entries/icons/all', HandleClearAllIcons);
Router.Register('GET', '/entries/tombstones', HandleGetTombstones);
Router.Register('POST', '/entries/tombstones', HandlePostTombstones);
Router.Register('POST', '/entries/bulk-import', HandleBulkImport);
Router.Register('POST', '/entries/(\d+)/restore', HandleRestoreEntry);
Router.Register('POST', '/entries/(\d+)/favorite', HandleToggleFavorite);
Router.Register('POST', '/entries/(\d+)/touch', HandleTouchEntry);
Router.Register('POST', '/entries/(\d+)/pin', HandleTogglePin);
Router.Register('POST', '/entries/(\d+)/icon', HandleSetEntryIcon);
Router.Register('GET', '/entries/(\d+)/history', HandleGetEntryHistory);
Router.Register('GET', '/entries/count', HandleEntriesCount);
Router.Register('GET', '/entries', HandleGetEntries);
Router.Register('POST', '/entries', HandleCreateEntry);
Router.Register('PUT', '/entries/(\d+)', HandleUpdateEntry);
Router.Register('DELETE', '/entries/(\d+)', HandleDeleteEntry);
end.
Reference in New Issue View Git Blame Copy Permalink