r-zakarya
ac909f4f09
Sync optimistic concurrency (ETag/If-Match) - webdav GET captures the response ETag; PUT sends it back as If-Match so the server rejects (412) our write when another device changed the file between our pull and push. A 412 re-runs the whole pull→merge→push (bounded to 3) so the other device's changes are folded in instead of clobbered. Servers without ETags → empty etag → no If-Match → falls back to last-write-wins (no regression). onWebdavResult gained a 4th etag arg. Chunked webdav PUT (big vaults no longer black-screen on sync) - The whole encrypted snapshot base64'd into a single cmd://webdav/put URL blew past WebView2's cap → black screen once the vault grew (20MB of attachments). PUT bodies now stream through the file/chunk transport and commit via a new webdav/put-commit (reads the accumulated buffer). Chunk-transfer hang fix (root cause of the stuck "Preparing…" sync) - All chunked transfers (saveFile/writeFile/webdav PUT) share one reqId-keyed resolver. A resolved chunk's stale 30s timeout would later delete the CURRENT chunk's resolver and fire the wrong res(), leaving that chunk's await pending forever. Extracted a single _streamChunks() helper whose ack CLEARS the pending timeout, so resolvers stay strictly one-at-a-time. Also fixed _webdavCall referencing the Bridge-local cmd() from module scope (latent ReferenceError). Sync busy overlay - syncStatus() now drives the global busy overlay too, so a running sync blocks stray clicks (e.g. the auto-backup "Choose…" picker) and reads like the manual backup. The account-mismatch confirm hideBusy()s first so it's visible above the overlay. Auto-VACUUM (reclaim space after deleting large attachments) - SQLite never shrinks the file on DELETE, so deleting big attachments left vault.db bloated (35MB for 11 tiny entries). DB.CompactIfBloated VACUUMs when >20% of pages are free AND >~2MB is reclaimable — called on startup and after each attachment delete. A healthy small vault pays nothing. (Verified: 35MB → 695KB after the deletes.) Rebuild: BuildAssets + F9 (UMainForm + PM.Database + PM.Handler.Attachments). Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
452 lines
13 KiB
ObjectPascal
452 lines
13 KiB
ObjectPascal
unit PM.Handler.Attachments;
|
|
|
|
(*
|
|
Encrypted file attachments per entry.
|
|
|
|
GET /entries/{id}/attachments -> [{id, filename, mime, size_bytes, created_at}, ...]
|
|
POST /entries/{id}/attachments body {filename, mime, encrypted_blob, iv, size_bytes}
|
|
-> {id, filename, mime, size_bytes, created_at}
|
|
GET /attachments/{id} -> {id, filename, mime, size_bytes, encrypted_blob, iv}
|
|
DELETE /attachments/{id} -> {message}
|
|
|
|
encrypted_blob is the base64-encoded AES-GCM ciphertext of the raw file
|
|
bytes, produced by the JS client with the per-user vault key. Server
|
|
never sees plaintext.
|
|
|
|
Per-attachment cap: ~10 MB of ciphertext-as-base64 (≈ 7.5 MB raw file).
|
|
Heavier attachments aren't appropriate for SQLite TEXT storage anyway.
|
|
*)
|
|
|
|
interface
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils, System.JSON,
|
|
Data.DB,
|
|
FireDAC.Comp.Client, FireDAC.Stan.Param,
|
|
IdCustomHTTPServer,
|
|
PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit;
|
|
|
|
const
|
|
MAX_ATTACHMENT_B64 = 10 * 1024 * 1024; // 10 MB of base64 text
|
|
|
|
function GetClientIP(ARequest: TIdHTTPRequestInfo): string;
|
|
begin
|
|
Result := ARequest.RemoteIP;
|
|
if Result = '' then Result := '127.0.0.1';
|
|
end;
|
|
|
|
// Ownership check: returns True iff the entry exists and belongs to LUserId.
|
|
function EntryBelongsToUser(LEntryId, LUserId: Integer): Boolean;
|
|
var
|
|
LQ: TFDQuery;
|
|
begin
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT 1 FROM vault_entries WHERE id = :id AND user_id = :uid';
|
|
LQ.ParamByName('id').AsInteger := LEntryId;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.Open;
|
|
Result := not LQ.Eof;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
end;
|
|
|
|
// ===== GET /entries/{id}/attachments =========================================
|
|
|
|
procedure HandleListAttachments(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, LEntryId: Integer;
|
|
LQ: TFDQuery;
|
|
LArr: TJSONArray;
|
|
LObj: TJSONObject;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LEntryId := StrToIntDef(AParams[0], 0);
|
|
if LEntryId = 0 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Invalid entry id');
|
|
Exit;
|
|
end;
|
|
|
|
LArr := TJSONArray.Create;
|
|
DB.Lock;
|
|
try
|
|
if not EntryBelongsToUser(LEntryId, LUserId) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Entry not found');
|
|
LArr.Free;
|
|
Exit;
|
|
end;
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT id, filename, mime, size_bytes, created_at ' +
|
|
'FROM entry_attachments WHERE entry_id = :eid AND user_id = :uid ' +
|
|
'ORDER BY created_at DESC';
|
|
LQ.ParamByName('eid').AsInteger := LEntryId;
|
|
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('filename', LQ.FieldByName('filename').AsString);
|
|
LObj.AddPair('mime', LQ.FieldByName('mime').AsString);
|
|
LObj.AddPair('size_bytes', TJSONNumber.Create(LQ.FieldByName('size_bytes').AsInteger));
|
|
LObj.AddPair('created_at',
|
|
FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', LQ.FieldByName('created_at').AsDateTime));
|
|
LArr.Add(LObj);
|
|
LQ.Next;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
TJSONHelper.SendJSON(AResponse, LArr);
|
|
end;
|
|
|
|
// ===== POST /entries/{id}/attachments ========================================
|
|
|
|
procedure HandleCreateAttachment(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, LEntryId, LNewId: Integer;
|
|
LBody: TJSONObject;
|
|
LFilename, LMime, LBlob, LIv: string;
|
|
LSize: Integer;
|
|
LQ: TFDQuery;
|
|
LObj: TJSONObject;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LEntryId := StrToIntDef(AParams[0], 0);
|
|
if LEntryId = 0 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Invalid entry id');
|
|
Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LFilename := Trim(LBody.GetValue<string>('filename', ''));
|
|
LMime := LBody.GetValue<string>('mime', '');
|
|
LBlob := LBody.GetValue<string>('encrypted_blob', '');
|
|
LIv := LBody.GetValue<string>('iv', '');
|
|
LSize := LBody.GetValue<Integer>('size_bytes', 0);
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
if (LFilename = '') or (LBlob = '') or (LIv = '') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Missing required fields');
|
|
Exit;
|
|
end;
|
|
if Length(LBlob) > MAX_ATTACHMENT_B64 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 413, 'Attachment too large (max ~7.5 MB raw)');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
if not EntryBelongsToUser(LEntryId, LUserId) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Entry not found');
|
|
Exit;
|
|
end;
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'INSERT INTO entry_attachments ' +
|
|
'(user_id, entry_id, filename, mime, size_bytes, encrypted_blob, iv) ' +
|
|
'VALUES (:uid, :eid, :name, :mime, :sz, :blob, :iv)';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('eid').AsInteger := LEntryId;
|
|
// Force ftWideString / ftMemo so unicode filenames (Arabic,
|
|
// Chinese, emoji…) survive the round-trip. The default ftString
|
|
// inferred from .AsString maps to ANSI on SQLite and replaces
|
|
// anything outside the local codepage with '?'.
|
|
LQ.ParamByName('name').DataType := ftWideString;
|
|
LQ.ParamByName('name').AsWideString := LFilename;
|
|
LQ.ParamByName('mime').DataType := ftWideString;
|
|
LQ.ParamByName('mime').AsWideString := LMime;
|
|
LQ.ParamByName('sz').AsInteger := LSize;
|
|
LQ.ParamByName('blob').DataType := ftMemo;
|
|
LQ.ParamByName('blob').Value := LBlob;
|
|
LQ.ParamByName('iv').AsString := LIv;
|
|
LQ.ExecSQL;
|
|
LNewId := DB.Connection.GetLastAutoGenValue('entry_attachments');
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
LogAudit(LUserId, 'add_attachment', GetClientIP(ARequest));
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('id', TJSONNumber.Create(LNewId));
|
|
LObj.AddPair('filename', LFilename);
|
|
LObj.AddPair('mime', LMime);
|
|
LObj.AddPair('size_bytes', TJSONNumber.Create(LSize));
|
|
LObj.AddPair('created_at', FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', Now));
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
end;
|
|
|
|
// ===== GET /attachments/{id} =================================================
|
|
|
|
procedure HandleGetAttachment(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, LId: Integer;
|
|
LQ: TFDQuery;
|
|
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;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT id, filename, mime, size_bytes, encrypted_blob, iv ' +
|
|
'FROM entry_attachments WHERE id = :id AND user_id = :uid';
|
|
LQ.ParamByName('id').AsInteger := LId;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.Open;
|
|
if LQ.Eof then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
|
Exit;
|
|
end;
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
|
|
LObj.AddPair('filename', LQ.FieldByName('filename').AsString);
|
|
LObj.AddPair('mime', LQ.FieldByName('mime').AsString);
|
|
LObj.AddPair('size_bytes', TJSONNumber.Create(LQ.FieldByName('size_bytes').AsInteger));
|
|
LObj.AddPair('encrypted_blob', LQ.FieldByName('encrypted_blob').AsString);
|
|
LObj.AddPair('iv', LQ.FieldByName('iv').AsString);
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
end;
|
|
|
|
// ===== GET /attachments/all ==================================================
|
|
// Lightweight listing of every attachment id+iv for the current user.
|
|
// Used by the master-pw rotation flow to enumerate what needs re-encryption.
|
|
// No blob shipped — fetched per-id only when the client is ready to re-encrypt.
|
|
|
|
procedure HandleListAllAttachments(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 id, entry_id FROM entry_attachments ' +
|
|
'WHERE user_id = :uid';
|
|
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('entry_id', TJSONNumber.Create(LQ.FieldByName('entry_id').AsInteger));
|
|
LArr.Add(LObj);
|
|
LQ.Next;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
TJSONHelper.SendJSON(AResponse, LArr);
|
|
end;
|
|
|
|
// ===== PUT /attachments/{id} =================================================
|
|
// Update only the ciphertext + iv. Used by master-pw rotation to swap to
|
|
// the new vault key. Filename/mime/size stay untouched.
|
|
|
|
procedure HandleUpdateAttachmentBlob(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId, LId: Integer;
|
|
LBody: TJSONObject;
|
|
LBlob, LIv: 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
|
|
LBlob := LBody.GetValue<string>('encrypted_blob', '');
|
|
LIv := LBody.GetValue<string>('iv', '');
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
if (LBlob = '') or (LIv = '') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Missing encrypted_blob / iv');
|
|
Exit;
|
|
end;
|
|
if Length(LBlob) > MAX_ATTACHMENT_B64 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 413, 'Attachment too large');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'UPDATE entry_attachments SET encrypted_blob = :blob, iv = :iv ' +
|
|
'WHERE id = :id AND user_id = :uid';
|
|
LQ.ParamByName('id').AsInteger := LId;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('blob').AsString := LBlob;
|
|
LQ.ParamByName('iv').AsString := LIv;
|
|
LQ.ExecSQL;
|
|
if LQ.RowsAffected = 0 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
|
Exit;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
TJSONHelper.SendOK(AResponse, 'Updated');
|
|
end;
|
|
|
|
// ===== DELETE /attachments/{id} ==============================================
|
|
|
|
procedure HandleDeleteAttachment(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 :=
|
|
'DELETE FROM entry_attachments WHERE id = :id AND user_id = :uid';
|
|
LQ.ParamByName('id').AsInteger := LId;
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ExecSQL;
|
|
if LQ.RowsAffected = 0 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
|
Exit;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
// Attachments are the big rows; deleting one leaves the file bloated
|
|
// until VACUUM'd. Compact now (no-op unless the free ratio is high) so
|
|
// disk space is reclaimed immediately, not just on the next launch.
|
|
DB.CompactIfBloated;
|
|
|
|
LogAudit(LUserId, 'delete_attachment', GetClientIP(ARequest));
|
|
TJSONHelper.SendOK(AResponse, 'Deleted');
|
|
end;
|
|
|
|
initialization
|
|
Router.Register('GET', '/entries/(\d+)/attachments', HandleListAttachments);
|
|
Router.Register('POST', '/entries/(\d+)/attachments', HandleCreateAttachment);
|
|
Router.Register('GET', '/attachments/all', HandleListAllAttachments);
|
|
Router.Register('GET', '/attachments/(\d+)', HandleGetAttachment);
|
|
Router.Register('PUT', '/attachments/(\d+)', HandleUpdateAttachmentBlob);
|
|
Router.Register('DELETE', '/attachments/(\d+)', HandleDeleteAttachment);
|
|
|
|
end.
|