Zaki/Password-Manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
e07488e8b4569ee8cf9931e10d402d8bc707dfce
Password-Manager/delphi-backend/Handlers/PM.Handler.Entries.pas
T
r-zakarya 5eb279ff31 fix(entries): 404 on PUT when the row no longer exists 
The UPDATE matched nothing but the handler still answered 200 Updated, so the editor reported Saved for an edit that went nowhere - the entry had been deleted by a sync or a purge after the editor opened it. Silent data loss; the client already surfaces a failed save as an error toast.
2026-08-01 16:20:45 +01:00

1496 lines
56 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);
// Icon provenance so the client knows which icons the automatic
// fetch/clear may touch (0) vs a user upload to preserve (1).
LObj.AddPair('icon_custom',
TJSONBool.Create(LQ.FieldByName('icon_custom').AsInteger = 1));
// 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;
LIconCustom, LFavorite, LPinned: Boolean;
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', '');
// Icon provenance (0 = fetched cache, 1 = user upload). Absent → 0.
LIconCustom := LBody.GetValue<Boolean>('icon_custom', False);
// Restore flags (import/backup carry them; sync omits them → 0).
LFavorite := LBody.GetValue<Boolean>('favorite', False);
LPinned := LBody.GetValue<Boolean>('pinned', False);
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, icon_custom, favorite, pinned, 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, :iconcust, :fav, :pin, :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;
if (LIcon <> '') and LIconCustom then LQ.ParamByName('iconcust').AsInteger := 1
else LQ.ParamByName('iconcust').AsInteger := 0;
if LFavorite then LQ.ParamByName('fav').AsInteger := 1
else LQ.ParamByName('fav').AsInteger := 0;
if LPinned then LQ.ParamByName('pin').AsInteger := 1
else LQ.ParamByName('pin').AsInteger := 0;
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;
LRows: Integer;
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;
LRows := LQ.RowsAffected;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
// No row matched: the entry was deleted (another device's sync, a purge)
// between the editor opening it and this save. Reporting 200 here made the
// client show "Saved" for an edit that went nowhere — silent data loss.
if LRows <= 0 then
begin
TJSONHelper.SendError(AResponse, 404, 'Entry no longer exists');
Exit;
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;
LIconCustom: 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
LIcon := LBody.GetValue<string>('icon_b64', '');
// 1 = user upload (preserve from auto fetch/clear), 0 = fetched/cleared.
LIconCustom := LBody.GetValue<Boolean>('custom', False);
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, icon_custom = :cust, ' +
' 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;
// A cleared icon (LIcon='') is never "custom" regardless of the flag.
if (LIcon <> '') and LIconCustom then LQ.ParamByName('cust').AsInteger := 1
else LQ.ParamByName('cust').AsInteger := 0;
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 :=
// Only the auto-fetched cache (icon_custom=0). User uploads (=1) are
// deliberate and survive — removed per entry, never by bulk clear.
'UPDATE vault_entries SET icon_b64 = NULL ' +
'WHERE user_id = :uid AND COALESCE(icon_custom, 0) = 0';
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;
LIconCustom, LFavorite, LPinned: Boolean;
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, icon_custom, favorite, pinned, 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, :iconcust, :fav, :pin, :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', '');
LIconCustom := LEntry.GetValue<Boolean>('icon_custom', False);
LFavorite := LEntry.GetValue<Boolean>('favorite', False);
LPinned := LEntry.GetValue<Boolean>('pinned', False);
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;
if (LIcon <> '') and LIconCustom then LQ.ParamByName('iconcust').AsInteger := 1
else LQ.ParamByName('iconcust').AsInteger := 0;
if LFavorite then LQ.ParamByName('fav').AsInteger := 1
else LQ.ParamByName('fav').AsInteger := 0;
if LPinned then LQ.ParamByName('pin').AsInteger := 1
else LQ.ParamByName('pin').AsInteger := 0;
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