2010dec22a
Fetching https://<site>/favicon.ico directly would resolve a DNS name - and open a connection - to EVERY domain kept in the vault. The list of sites where someone holds an account is precisely what this vault protects; handing it to the network for a sixteen-pixel drawing would be a poor trade. The relay sees only that someone is interested in one domain, which is why the call is asked for entry by entry and never happens on its own. Two tries: the full host, then the second-level domain - chat.qwen.ai has no icon at the relay, qwen.ai does. The type comes from the first bytes, never from the extension: the relay answers PNG under a .ico address. A dedicated patch rather than PatchEntryField, because icon_custom is a NUMBER in the snapshot and writing it as a string would give "0" - which the desktop reads with GetValue<Boolean> and would choke on. It is set to zero: the icon comes from an automatic lookup, not from a choice, and that flag is what stops the desktop from ever replacing a chosen icon during a refresh. Base64 without line breaks. Delphi's encoder wraps at 76 characters by default, a wrapped data: URI does not display, and that trap has already been paid once on the containers.
584 lines
22 KiB
ObjectPascal
584 lines
22 KiB
ObjectPascal
unit PMA.VaultPatch;
|
|
{
|
|
Modifier UN champ d'UNE entree dans l'instantane, sans toucher au reste.
|
|
|
|
LA CONTRAINTE QUI GOUVERNE CETTE UNITE. TVault ne lit qu'une partie des
|
|
champs : il ignore `content_b64` des pieces jointes, `created_at`, l'avatar du
|
|
compte, les tombstones, et tout ce que le poste ajoutera demain. Reserialiser
|
|
le coffre a partir de ce qu'il a compris EFFACERAIT tout cela - et le poste
|
|
adopterait cette version amputee au tirage suivant, la fusion etant un
|
|
dernier-ecrit-gagne sur `updated_at`. La perte serait silencieuse et
|
|
definitive.
|
|
|
|
Donc on ne reconstruit rien : on prend le JSON RECU, on change une valeur
|
|
dedans, et on rend le reste tel quel. Ce que le telephone ne comprend pas
|
|
voyage intact, par construction plutot que par vigilance.
|
|
|
|
COROLLAIRE SUR LA FUSION. Comme le patch s'applique a l'instantane qu'on
|
|
vient de tirer, il n'y a pas de fusion a ecrire : ce qui n'est pas touche est
|
|
deja la version la plus recente du serveur. Le seul conflit possible est
|
|
qu'un autre appareil publie entre notre lecture et notre ecriture, et Gitea
|
|
le refuse par le sha (409) - il suffit alors de recommencer.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.JSON, System.DateUtils;
|
|
|
|
type
|
|
EPMAPatch = class(Exception);
|
|
|
|
/// Remplace AField de l'entree AUuid par AValue, et bump `updated_at`.
|
|
/// Rend le JSON complet, tout le reste inchange. Leve si l'entree est absente -
|
|
/// ce qui veut dire que le distant ne la contient pas (supprimee ailleurs), et
|
|
/// ecrire quand meme la ferait reapparaitre.
|
|
function PatchEntryField(const APlainJson, AUuid, AField, AValue: string): string;
|
|
|
|
/// Un instantane vide, au nom de ce compte. Sert a l'inscription depuis le
|
|
/// telephone : meme forme que ce qu'ecrit le poste, pour qu'un coffre ne
|
|
/// naisse pas dans un dialecte a part.
|
|
function NewEmptySnapshot(const AUsername: string): string;
|
|
|
|
/// Ajoute une entree a l'instantane et rend le JSON complet.
|
|
///
|
|
/// LA MEME FORME QUE CE QU'ECRIT LE POSTE, cles vides comprises : une entree
|
|
/// nee ici sera relue la-bas, et une cle absente ne se comporte pas toujours
|
|
/// comme une cle vide. `folder` vaut 'All' parce que c'est le dossier par
|
|
/// defaut du poste, pas parce que c'est joli.
|
|
///
|
|
/// Un uuid neuf, et lui seul : pas de tombstone, on ne supprime pas encore.
|
|
function AddEntry(const APlainJson, ATitle, ASite, AUsername, APassword,
|
|
AKind, AFolder: string): string;
|
|
|
|
/// Retire une entree de l'instantane et laisse une PIERRE TOMBALE a sa place.
|
|
///
|
|
/// LES DEUX, SINON RIEN. Retirer la ligne sans la tombstone ne supprime pas :
|
|
/// le poste tient toujours la sienne, et le prochain tirage la ramenerait comme
|
|
/// une entree qu'on n'a jamais eue. C'est la tombstone qui dit "celle-ci a ete
|
|
/// supprimee, et a telle heure" - et l'heure compte, parce que l'arbitrage du
|
|
/// poste garde une entree modifiee APRES la suppression plutot que de la tuer
|
|
/// une seconde fois.
|
|
///
|
|
/// SANS RETOUR depuis le telephone : il n'y a pas de corbeille ici. Celle du
|
|
/// poste est un drapeau `deleted` qui ne voyage pas dans la synchronisation ;
|
|
/// une suppression qui s'y arreterait ne se propagerait donc nulle part.
|
|
function DeleteEntry(const APlainJson, AUuid: string): string;
|
|
|
|
/// Duplique une entree : meme contenu, uuid neuf, nom suffixe.
|
|
///
|
|
/// COPIE INTEGRALE, pieces jointes comprises. Le poste fait de meme, et une
|
|
/// copie qui perdrait le document attache serait une surprise le jour ou l'on
|
|
/// s'en apercevrait - c'est-a-dire trop tard. Le prix est un instantane plus
|
|
/// lourd a publier ; il se voit tout de suite, lui.
|
|
function DuplicateEntry(const APlainJson, AUuid: string): string;
|
|
|
|
/// Le contenu base64 d'une piece jointe, relu dans l'instantane BRUT.
|
|
///
|
|
/// TVault le jette expres a la lecture - une seule piece jointe faisait passer
|
|
/// le cache de 13 a 174 Ko, et le garder en memoire pour tout le coffre alors
|
|
/// que rien ne l'affiche serait payer sans rien acheter. Il ne se relit donc
|
|
/// qu'ici, au moment ou quelqu'un demande a l'enregistrer, et pour une seule
|
|
/// entree.
|
|
///
|
|
/// Rend '' si l'entree, le rang ou le contenu manquent - une piece jointe
|
|
/// listee sans contenu existe : le poste peut avoir echoue a le joindre a
|
|
/// l'instantane.
|
|
function AttachmentContent(const APlainJson, AUuid: string;
|
|
AIndex: Integer): string;
|
|
|
|
/// Pose l'icone d'une entree, et le drapeau de provenance avec elle.
|
|
///
|
|
/// PAS PatchEntryField : `icon_custom` est un NOMBRE dans l'instantane, et
|
|
/// l'ecrire comme une chaine donnerait `"icon_custom": "0"` - que le poste lit
|
|
/// avec GetValue<Boolean>, qui echouerait sur une chaine. Deux champs de types
|
|
/// differents, donc une fonction qui les connait tous les deux.
|
|
///
|
|
/// AUri vide efface l'icone. Le drapeau retombe alors a zero comme sur le
|
|
/// poste : une icone absente n'est pas une icone choisie.
|
|
function PatchEntryIcon(const APlainJson, AUuid, AUri: string;
|
|
ACustom: Boolean): string;
|
|
|
|
/// Fond l'instantane LOCAL dans l'instantane DISTANT et rend le resultat.
|
|
///
|
|
/// LE DISTANT SERT DE BASE, jamais le local. Il porte ce que le telephone ne
|
|
/// sait pas reconstruire - le contenu des pieces jointes, l'avatar du compte,
|
|
/// la couleur des dossiers, et tout ce que le poste ajoutera demain. Repartir
|
|
/// du local amputerait tout cela, et le poste adopterait la version amputee au
|
|
/// tirage suivant : la meme perte silencieuse et definitive contre laquelle
|
|
/// cette unite entiere est ecrite.
|
|
///
|
|
/// L'arbitrage est celui du poste, terme a terme : dernier ecrit gagnant sur
|
|
/// `updated_at`, et une pierre tombale l'emporte sur une entree plus ancienne
|
|
/// qu'elle. Les horodatages sont de l'ISO 8601 UTC des deux cotes,
|
|
/// millisecondes comprises, donc l'ordre lexicographique EST l'ordre
|
|
/// chronologique - aucune date a analyser.
|
|
///
|
|
/// Une entree sans uuid est ignoree : rien ne permettrait de la reconnaitre
|
|
/// chez l'autre, et l'ajouter en creerait un doublon a chaque fusion.
|
|
function MergeSnapshots(const ALocalJson, ARemoteJson: string): string;
|
|
|
|
/// Horodatage UTC au format que tout le reste emploie (toISOString cote JS).
|
|
/// MELANGER heure locale et UTC a deja decale l'arbitrage de la fusion une
|
|
/// fois : il n'y a qu'une source d'heure ici, et elle est en UTC.
|
|
function NowUtcIso: string;
|
|
|
|
implementation
|
|
|
|
function NowUtcIso: string;
|
|
begin
|
|
Result := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz"Z"',
|
|
TTimeZone.Local.ToUniversalTime(Now));
|
|
end;
|
|
|
|
function NewEmptySnapshot(const AUsername: string): string;
|
|
var
|
|
LRoot: TJSONObject;
|
|
begin
|
|
LRoot := TJSONObject.Create;
|
|
try
|
|
// Les memes cles que buildSyncSnapshot, tableaux vides compris : un lecteur
|
|
// qui trouve la cle absente et un lecteur qui la trouve vide ne se
|
|
// comportent pas forcement pareil, et ce coffre sera lu par le poste.
|
|
LRoot.AddPair('version', TJSONNumber.Create(1));
|
|
LRoot.AddPair('snapshot_at', NowUtcIso);
|
|
LRoot.AddPair('username', AUsername);
|
|
LRoot.AddPair('folders', TJSONArray.Create);
|
|
LRoot.AddPair('avatar_b64', '');
|
|
LRoot.AddPair('entries', TJSONArray.Create);
|
|
LRoot.AddPair('tombstones', TJSONArray.Create);
|
|
Result := LRoot.ToJSON;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
/// L'heure de suppression retenue pour un uuid, ou '' s'il n'en a pas.
|
|
/// La plus recente des deux listes : une entree ressuscitee puis resupprimee
|
|
/// doit rester supprimee.
|
|
function TombstoneTime(const AStones: TJSONArray; const AUuid: string): string;
|
|
var
|
|
I: Integer;
|
|
LObj: TJSONObject;
|
|
LWhen: string;
|
|
begin
|
|
Result := '';
|
|
if AStones = nil then Exit;
|
|
for I := 0 to AStones.Count - 1 do
|
|
begin
|
|
if not (AStones.Items[I] is TJSONObject) then Continue;
|
|
LObj := AStones.Items[I] as TJSONObject;
|
|
if LObj.GetValue<string>('uuid', '') <> AUuid then Continue;
|
|
LWhen := LObj.GetValue<string>('deleted_at', '');
|
|
if LWhen > Result then Result := LWhen;
|
|
end;
|
|
end;
|
|
|
|
/// Copie profonde d'un objet JSON : le reparser est le moyen le plus court, et
|
|
/// le seul qui n'oublie aucun champ.
|
|
/// Inscrit un dossier dans la liste du coffre s'il n'y figure pas deja.
|
|
///
|
|
/// Ranger une entree dans un dossier ne suffit pas : c'est `folders` qui peuple
|
|
/// la colonne du poste, et un nom qui n'y figure pas donne une entree rangee
|
|
/// dans un dossier que rien n'affiche - elle semble disparue. Les deux vont
|
|
/// donc ensemble, et 'All' ne s'inscrit jamais : c'est le defaut, pas un
|
|
/// dossier.
|
|
procedure EnsureFolder(const ARoot: TJSONObject; const AName: string);
|
|
var
|
|
LFolders: TJSONArray;
|
|
LObj: TJSONObject;
|
|
I: Integer;
|
|
begin
|
|
if (AName = '') or (AName = 'All') then Exit;
|
|
if not ARoot.TryGetValue<TJSONArray>('folders', LFolders) then
|
|
begin
|
|
LFolders := TJSONArray.Create;
|
|
ARoot.AddPair('folders', LFolders);
|
|
end;
|
|
for I := 0 to LFolders.Count - 1 do
|
|
if (LFolders.Items[I] is TJSONObject) and
|
|
((LFolders.Items[I] as TJSONObject).GetValue<string>('name', '') = AName) then
|
|
Exit;
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('name', AName);
|
|
// Le poste lit aussi 'color' et 'icon' ; vides, il met ses defauts.
|
|
LObj.AddPair('color', '');
|
|
LObj.AddPair('icon', '');
|
|
LFolders.AddElement(LObj);
|
|
end;
|
|
|
|
function CloneJson(const AObj: TJSONObject): TJSONObject;
|
|
begin
|
|
Result := TJSONObject.ParseJSONValue(AObj.ToJSON) as TJSONObject;
|
|
end;
|
|
|
|
function MergeSnapshots(const ALocalJson, ARemoteJson: string): string;
|
|
var
|
|
LLocal, LMerged: TJSONObject;
|
|
LLocalEntries, LOutEntries, LLocalStones, LOutStones,
|
|
LLocalFolders: TJSONArray;
|
|
LEntry, LOther: TJSONObject;
|
|
I, J: Integer;
|
|
LUuid, LMine, LTheirs, LKilled: string;
|
|
LFound: Boolean;
|
|
begin
|
|
LLocal := TJSONObject.ParseJSONValue(ALocalJson) as TJSONObject;
|
|
if LLocal = nil then raise EPMAPatch.Create('Instantane local illisible');
|
|
try
|
|
LMerged := TJSONObject.ParseJSONValue(ARemoteJson) as TJSONObject;
|
|
if LMerged = nil then raise EPMAPatch.Create('Instantane distant illisible');
|
|
try
|
|
if not LMerged.TryGetValue<TJSONArray>('entries', LOutEntries) then
|
|
raise EPMAPatch.Create('Instantane distant sans tableau "entries"');
|
|
if not LMerged.TryGetValue<TJSONArray>('tombstones', LOutStones) then
|
|
begin
|
|
LOutStones := TJSONArray.Create;
|
|
LMerged.AddPair('tombstones', LOutStones);
|
|
end;
|
|
|
|
// 0. LES DOSSIERS DU LOCAL REJOIGNENT CEUX DU DISTANT.
|
|
//
|
|
// Oubli trouve a la relecture : la fusion ne portait qu'entrees et
|
|
// pierres tombales. Un dossier cree ici - hors connexion, ou juste avant
|
|
// qu'un autre appareil publie - disparaissait donc de `folders`, tandis
|
|
// que les entrees gardaient son nom. Elles se retrouvaient rangees dans
|
|
// un dossier que rien n'affiche : introuvables sans le savoir.
|
|
//
|
|
// Additif, jamais destructif : on n'enleve pas un dossier du distant
|
|
// parce qu'il manque ici, c'est aussi la regle du poste.
|
|
if LLocal.TryGetValue<TJSONArray>('folders', LLocalFolders) then
|
|
for I := 0 to LLocalFolders.Count - 1 do
|
|
if LLocalFolders.Items[I] is TJSONObject then
|
|
EnsureFolder(LMerged,
|
|
(LLocalFolders.Items[I] as TJSONObject).GetValue<string>('name', ''));
|
|
|
|
// 1. Les pierres tombales locales rejoignent celles du distant. Avant les
|
|
// entrees : l'etape suivante s'en sert pour arbitrer.
|
|
if LLocal.TryGetValue<TJSONArray>('tombstones', LLocalStones) then
|
|
for I := 0 to LLocalStones.Count - 1 do
|
|
if LLocalStones.Items[I] is TJSONObject then
|
|
LOutStones.AddElement(CloneJson(LLocalStones.Items[I] as TJSONObject));
|
|
|
|
// 2. Chaque entree locale : absente du distant on l'ajoute, presente on
|
|
// garde la plus recente des deux.
|
|
if LLocal.TryGetValue<TJSONArray>('entries', LLocalEntries) then
|
|
for I := 0 to LLocalEntries.Count - 1 do
|
|
begin
|
|
if not (LLocalEntries.Items[I] is TJSONObject) then Continue;
|
|
LEntry := LLocalEntries.Items[I] as TJSONObject;
|
|
LUuid := LEntry.GetValue<string>('uuid', '');
|
|
if LUuid = '' then Continue;
|
|
LMine := LEntry.GetValue<string>('updated_at', '');
|
|
|
|
LFound := False;
|
|
for J := 0 to LOutEntries.Count - 1 do
|
|
begin
|
|
if not (LOutEntries.Items[J] is TJSONObject) then Continue;
|
|
LOther := LOutEntries.Items[J] as TJSONObject;
|
|
if LOther.GetValue<string>('uuid', '') <> LUuid then Continue;
|
|
LFound := True;
|
|
LTheirs := LOther.GetValue<string>('updated_at', '');
|
|
if LMine > LTheirs then
|
|
begin
|
|
LOutEntries.Remove(J).Free;
|
|
LOutEntries.AddElement(CloneJson(LEntry));
|
|
end;
|
|
Break;
|
|
end;
|
|
if not LFound then LOutEntries.AddElement(CloneJson(LEntry));
|
|
end;
|
|
|
|
// 3. Une pierre tombale posterieure a l'entree la retire. Posterieure
|
|
// SEULEMENT : une entree modifiee apres coup a ete ressuscitee
|
|
// volontairement, et la retuer effacerait ce geste.
|
|
for J := LOutEntries.Count - 1 downto 0 do
|
|
begin
|
|
if not (LOutEntries.Items[J] is TJSONObject) then Continue;
|
|
LOther := LOutEntries.Items[J] as TJSONObject;
|
|
LKilled := TombstoneTime(LOutStones, LOther.GetValue<string>('uuid', ''));
|
|
if (LKilled <> '') and (LKilled > LOther.GetValue<string>('updated_at', '')) then
|
|
LOutEntries.Remove(J).Free;
|
|
end;
|
|
|
|
Result := LMerged.ToJSON;
|
|
finally
|
|
LMerged.Free;
|
|
end;
|
|
finally
|
|
LLocal.Free;
|
|
end;
|
|
end;
|
|
|
|
function PatchEntryIcon(const APlainJson, AUuid, AUri: string;
|
|
ACustom: Boolean): string;
|
|
var
|
|
LRoot, LEntry: TJSONObject;
|
|
LEntries: TJSONArray;
|
|
I: Integer;
|
|
LFound: Boolean;
|
|
begin
|
|
if AUuid = '' then
|
|
raise EPMAPatch.Create('Entree sans uuid : rien a retrouver');
|
|
LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LRoot = nil then
|
|
raise EPMAPatch.Create('Instantane illisible');
|
|
try
|
|
if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then
|
|
raise EPMAPatch.Create('Instantane sans tableau "entries"');
|
|
LFound := False;
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
if not (LEntries.Items[I] is TJSONObject) then Continue;
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;
|
|
|
|
LEntry.RemovePair('icon_b64').Free;
|
|
LEntry.AddPair('icon_b64', AUri);
|
|
LEntry.RemovePair('icon_custom').Free;
|
|
LEntry.AddPair('icon_custom',
|
|
TJSONNumber.Create(Ord(ACustom and (AUri <> ''))));
|
|
LEntry.RemovePair('updated_at').Free;
|
|
LEntry.AddPair('updated_at', NowUtcIso);
|
|
|
|
LFound := True;
|
|
Break;
|
|
end;
|
|
if not LFound then
|
|
raise EPMAPatch.CreateFmt('Entree %s introuvable', [AUuid]);
|
|
Result := LRoot.ToJSON;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
function AttachmentContent(const APlainJson, AUuid: string;
|
|
AIndex: Integer): string;
|
|
var
|
|
LRoot, LEntry: TJSONObject;
|
|
LEntries, LAtt: TJSONArray;
|
|
I: Integer;
|
|
begin
|
|
Result := '';
|
|
if (AUuid = '') or (AIndex < 0) then Exit;
|
|
LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LRoot = nil then Exit;
|
|
try
|
|
if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then Exit;
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
if not (LEntries.Items[I] is TJSONObject) then Continue;
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;
|
|
if not LEntry.TryGetValue<TJSONArray>('attachments', LAtt) then Exit;
|
|
if AIndex >= LAtt.Count then Exit;
|
|
if not (LAtt.Items[AIndex] is TJSONObject) then Exit;
|
|
Result := (LAtt.Items[AIndex] as TJSONObject)
|
|
.GetValue<string>('content_b64', '');
|
|
Exit;
|
|
end;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
function DuplicateEntry(const APlainJson, AUuid: string): string;
|
|
var
|
|
LRoot, LEntry, LCopy: TJSONObject;
|
|
LEntries: TJSONArray;
|
|
I: Integer;
|
|
LNow, LTitle: string;
|
|
begin
|
|
if AUuid = '' then
|
|
raise EPMAPatch.Create('Entree sans uuid : rien a dupliquer');
|
|
|
|
LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LRoot = nil then
|
|
raise EPMAPatch.Create('Instantane illisible');
|
|
try
|
|
if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then
|
|
raise EPMAPatch.Create('Instantane sans tableau "entries"');
|
|
|
|
LCopy := nil;
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
if not (LEntries.Items[I] is TJSONObject) then Continue;
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;
|
|
// Reparser plutot que recopier champ par champ : c'est le seul moyen qui
|
|
// n'oublie rien de ce que le telephone ne comprend pas.
|
|
LCopy := CloneJson(LEntry);
|
|
Break;
|
|
end;
|
|
if LCopy = nil then
|
|
raise EPMAPatch.CreateFmt('Entree %s introuvable', [AUuid]);
|
|
|
|
LNow := NowUtcIso;
|
|
LCopy.RemovePair('uuid').Free;
|
|
LCopy.AddPair('uuid', LowerCase(Copy(GUIDToString(TGUID.NewGuid), 2, 36)));
|
|
LCopy.RemovePair('created_at').Free;
|
|
LCopy.AddPair('created_at', LNow);
|
|
LCopy.RemovePair('updated_at').Free;
|
|
LCopy.AddPair('updated_at', LNow);
|
|
// Le nom change, sinon les deux lignes sont indiscernables dans la liste.
|
|
// Retirer PUIS ajouter, comme partout ici : AddPair seul laisserait deux
|
|
// paires 'title', et le lecteur prendrait la premiere - donc l'ancienne.
|
|
LTitle := Trim(LCopy.GetValue<string>('title', '') + ' (copy)');
|
|
LCopy.RemovePair('title').Free;
|
|
LCopy.AddPair('title', LTitle);
|
|
LEntries.AddElement(LCopy);
|
|
|
|
Result := LRoot.ToJSON;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
function DeleteEntry(const APlainJson, AUuid: string): string;
|
|
var
|
|
LRoot, LEntry, LStone: TJSONObject;
|
|
LEntries, LStones: TJSONArray;
|
|
I: Integer;
|
|
LFound: Boolean;
|
|
begin
|
|
if AUuid = '' then
|
|
raise EPMAPatch.Create('Entree sans uuid : rien a supprimer chez le distant');
|
|
|
|
LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LRoot = nil then
|
|
raise EPMAPatch.Create('Instantane illisible');
|
|
try
|
|
if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then
|
|
raise EPMAPatch.Create('Instantane sans tableau "entries"');
|
|
|
|
LFound := False;
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
if not (LEntries.Items[I] is TJSONObject) then Continue;
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;
|
|
// Remove REND la valeur retiree : a l'appelant de la liberer.
|
|
LEntries.Remove(I).Free;
|
|
LFound := True;
|
|
Break;
|
|
end;
|
|
|
|
if not LFound then
|
|
raise EPMAPatch.CreateFmt(
|
|
'Entree %s absente du distant - supprimee ailleurs ?', [AUuid]);
|
|
|
|
// Le tableau peut manquer : un conteneur ecrit par un poste qui n'avait
|
|
// encore rien supprime n'a aucune raison de le porter.
|
|
if not LRoot.TryGetValue<TJSONArray>('tombstones', LStones) then
|
|
begin
|
|
LStones := TJSONArray.Create;
|
|
LRoot.AddPair('tombstones', LStones);
|
|
end;
|
|
LStone := TJSONObject.Create;
|
|
LStone.AddPair('uuid', AUuid);
|
|
LStone.AddPair('deleted_at', NowUtcIso);
|
|
LStones.AddElement(LStone);
|
|
|
|
Result := LRoot.ToJSON;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
function AddEntry(const APlainJson, ATitle, ASite, AUsername, APassword,
|
|
AKind, AFolder: string): string;
|
|
var
|
|
LRoot, LEntry: TJSONObject;
|
|
LEntries: TJSONArray;
|
|
LNow: string;
|
|
begin
|
|
LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LRoot = nil then
|
|
raise EPMAPatch.Create('Snapshot is not a JSON object');
|
|
try
|
|
LEntries := LRoot.GetValue('entries') as TJSONArray;
|
|
if LEntries = nil then
|
|
raise EPMAPatch.Create('Snapshot has no entries array');
|
|
|
|
LNow := NowUtcIso;
|
|
LEntry := TJSONObject.Create;
|
|
// Minuscules et sans accolades : la forme que tout le reste emploie.
|
|
LEntry.AddPair('uuid', LowerCase(Copy(GUIDToString(TGUID.NewGuid), 2, 36)));
|
|
LEntry.AddPair('title', ATitle);
|
|
LEntry.AddPair('site', ASite);
|
|
LEntry.AddPair('username', AUsername);
|
|
// Le corps d'une note EST son mot de passe cote stockage - il n'y a pas de
|
|
// colonne separee, ni ici ni sur le poste.
|
|
LEntry.AddPair('password', APassword);
|
|
if AFolder <> '' then LEntry.AddPair('folder', AFolder)
|
|
else LEntry.AddPair('folder', 'All');
|
|
EnsureFolder(LRoot, AFolder);
|
|
LEntry.AddPair('tags', TJSONArray.Create);
|
|
LEntry.AddPair('totp_secret', '');
|
|
LEntry.AddPair('kind', AKind);
|
|
LEntry.AddPair('template', '');
|
|
LEntry.AddPair('custom_fields', TJSONArray.Create);
|
|
LEntry.AddPair('attachments', TJSONArray.Create);
|
|
LEntry.AddPair('icon_b64', '');
|
|
LEntry.AddPair('icon_custom', TJSONNumber.Create(0));
|
|
LEntry.AddPair('created_at', LNow);
|
|
LEntry.AddPair('updated_at', LNow);
|
|
LEntries.AddElement(LEntry);
|
|
|
|
Result := LRoot.ToJSON;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
function PatchEntryField(const APlainJson, AUuid, AField, AValue: string): string;
|
|
var
|
|
LRoot, LEntry: TJSONObject;
|
|
LEntries: TJSONArray;
|
|
I: Integer;
|
|
LFound: Boolean;
|
|
begin
|
|
if AUuid = '' then
|
|
raise EPMAPatch.Create('Entree sans uuid : rien a retrouver chez le distant');
|
|
|
|
LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LRoot = nil then
|
|
raise EPMAPatch.Create('Instantane illisible');
|
|
try
|
|
if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then
|
|
raise EPMAPatch.Create('Instantane sans tableau "entries"');
|
|
|
|
LFound := False;
|
|
for I := 0 to LEntries.Count - 1 do
|
|
begin
|
|
if not (LEntries.Items[I] is TJSONObject) then Continue;
|
|
LEntry := LEntries.Items[I] as TJSONObject;
|
|
if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;
|
|
|
|
// RemovePair puis AddPair : AddPair seul ajouterait un DOUBLON, et le
|
|
// lecteur prendrait le premier - donc l'ancienne valeur.
|
|
LEntry.RemovePair(AField).Free;
|
|
LEntry.AddPair(AField, AValue);
|
|
|
|
// Sans ce bump, la modification voyage mais les autres appareils
|
|
// l'ignorent : leur arbitrage compare `updated_at`, et le notre serait
|
|
// reste plus ancien que le leur.
|
|
LEntry.RemovePair('updated_at').Free;
|
|
LEntry.AddPair('updated_at', NowUtcIso);
|
|
if AField = 'folder' then EnsureFolder(LRoot, AValue);
|
|
|
|
LFound := True;
|
|
Break;
|
|
end;
|
|
|
|
if not LFound then
|
|
raise EPMAPatch.CreateFmt(
|
|
'Entree %s absente du distant - supprimee ailleurs ?', [AUuid]);
|
|
|
|
Result := LRoot.ToJSON;
|
|
finally
|
|
LRoot.Free;
|
|
end;
|
|
end;
|
|
|
|
end.
|