unit PMA.Vault; { Le coffre en memoire : lecture de l'instantane dechiffre, et recherche. Volontairement des ENREGISTREMENTS et un tableau, pas une hierarchie d'objets : l'instantane est lu d'un bloc, consulte, puis jete au verrouillage. Rien ne justifie de la mutabilite ni des references croisees. CE QUE CETTE UNITE MANIPULE EST EN CLAIR. Elle ne doit rien ecrire sur le disque : la persistance passe par PMA.Store, qui chiffre. } interface uses System.SysUtils, System.Classes, System.JSON, System.Generics.Collections; type /// Un champ personnalise. Le poste Windows nomme la cle "is_secret" - c'est /// lui qui decide si la valeur s'affiche masquee. TVaultField = record Caption, Value: string; Secret: Boolean; end; TVaultEntry = record Uuid, Title, Site, Username, Password, Folder, Tags, Kind, Totp: string; Fields: TArray; Deleted: Boolean; /// Le corps d'une note EST son mot de passe cote stockage : il n'y a pas /// de colonne separee. L'affichage doit donc l'intituler autrement. function IsNote: Boolean; /// Ce qu'on affiche en tete de ligne : le nom donne par l'utilisateur, /// sinon le site, sinon l'identifiant. Une entree sans aucun des trois /// existe (note vide) et ne doit pas apparaitre comme une ligne muette. function Display: string; end; TVault = class private FEntries: TArray; FUsername: string; FExportedAt: string; public /// Remplit depuis le JSON dechiffre. Leve si la structure est absente. procedure LoadFromJson(const APlainJson: string); /// Efface le contenu. Appele au verrouillage. procedure Clear; /// Indices des entrees correspondant a AQuery, dans l'ordre d'affichage. /// Requete vide = tout ce qui n'est pas en corbeille. /// La recherche porte sur le nom, le site, l'identifiant et les tags - /// PAS sur le mot de passe : personne ne cherche par mot de passe, et le /// comparer allongerait inutilement son sejour en memoire de travail. function Search(const AQuery: string; AIncludeTrash: Boolean = False): TArray; function Count: Integer; function LiveCount: Integer; function TrashCount: Integer; function Entry(AIndex: Integer): TVaultEntry; property Username: string read FUsername; property ExportedAt: string read FExportedAt; end; implementation uses System.Character; { TVaultEntry } function TVaultEntry.IsNote: Boolean; begin Result := SameText(Kind, 'note'); end; function TVaultEntry.Display: string; begin Result := Title.Trim; if Result = '' then Result := Site.Trim; if Result = '' then Result := Username.Trim; if Result = '' then Result := '(sans nom)'; end; { TVault } procedure TVault.Clear; begin SetLength(FEntries, 0); FUsername := ''; FExportedAt := ''; end; /// Les tags arrivent en tableau JSON depuis nos conteneurs, mais en chaine /// separee par des virgules depuis un import CSV etranger. On accepte les deux. function TagsToString(const AVal: TJSONValue): string; var LArr: TJSONArray; I: Integer; begin Result := ''; if AVal = nil then Exit; if AVal is TJSONArray then begin LArr := AVal as TJSONArray; for I := 0 to LArr.Count - 1 do begin if Result <> '' then Result := Result + ', '; Result := Result + LArr.Items[I].Value; end; end else Result := AVal.Value; end; /// Les champs personnalises : tableau d'objets {label, value, is_secret}. /// Un champ sans intitule ET sans valeur ne vaut pas une ligne a l'ecran. function ParseFields(const AVal: TJSONValue): TArray; var LArr: TJSONArray; LObj: TJSONObject; I, N: Integer; begin Result := nil; if not (AVal is TJSONArray) then Exit; LArr := AVal as TJSONArray; SetLength(Result, LArr.Count); N := 0; for I := 0 to LArr.Count - 1 do begin if not (LArr.Items[I] is TJSONObject) then Continue; LObj := LArr.Items[I] as TJSONObject; Result[N].Caption := LObj.GetValue('label', ''); Result[N].Value := LObj.GetValue('value', ''); Result[N].Secret := LObj.GetValue('is_secret', False); if (Result[N].Caption = '') and (Result[N].Value = '') then Continue; Inc(N); end; SetLength(Result, N); end; procedure TVault.LoadFromJson(const APlainJson: string); var LRoot, LObj: TJSONObject; LArr: TJSONArray; I, N: Integer; begin Clear; LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject; if LRoot = nil then raise Exception.Create('Instantane illisible : ce n''est pas du JSON'); try FUsername := LRoot.GetValue('username', ''); FExportedAt := LRoot.GetValue('exported_at', LRoot.GetValue('snapshot_at', '')); if not LRoot.TryGetValue('entries', LArr) then raise Exception.Create('Instantane sans tableau "entries"'); SetLength(FEntries, LArr.Count); N := 0; for I := 0 to LArr.Count - 1 do begin if not (LArr.Items[I] is TJSONObject) then Continue; LObj := LArr.Items[I] as TJSONObject; FEntries[N].Uuid := LObj.GetValue('uuid', ''); FEntries[N].Title := LObj.GetValue('title', ''); FEntries[N].Site := LObj.GetValue('site', ''); FEntries[N].Username := LObj.GetValue('username', ''); FEntries[N].Password := LObj.GetValue('password', ''); FEntries[N].Folder := LObj.GetValue('folder', ''); FEntries[N].Kind := LObj.GetValue('kind', 'login'); FEntries[N].Totp := LObj.GetValue('totp_secret', ''); FEntries[N].Tags := TagsToString(LObj.GetValue('tags')); FEntries[N].Fields := ParseFields(LObj.GetValue('custom_fields')); // deleted arrive en 0/1 depuis nos conteneurs ; absent = vivant. FEntries[N].Deleted := LObj.GetValue('deleted', 0) = 1; Inc(N); end; SetLength(FEntries, N); finally LRoot.Free; end; end; function TVault.Count: Integer; begin Result := Length(FEntries); end; function TVault.LiveCount: Integer; var E: TVaultEntry; begin Result := 0; for E in FEntries do if not E.Deleted then Inc(Result); end; function TVault.TrashCount: Integer; begin Result := Count - LiveCount; end; function TVault.Entry(AIndex: Integer): TVaultEntry; begin Result := FEntries[AIndex]; end; function TVault.Search(const AQuery: string; AIncludeTrash: Boolean): TArray; var LQ: string; LRes: TList; I: Integer; E: TVaultEntry; function Matches(const E: TVaultEntry): Boolean; begin Result := (LQ = '') or (Pos(LQ, E.Title.ToLower) > 0) or (Pos(LQ, E.Site.ToLower) > 0) or (Pos(LQ, E.Username.ToLower) > 0) or (Pos(LQ, E.Tags.ToLower) > 0); end; begin LQ := AQuery.Trim.ToLower; LRes := TList.Create; try for I := 0 to High(FEntries) do begin E := FEntries[I]; if E.Deleted and not AIncludeTrash then Continue; if Matches(E) then LRes.Add(I); end; Result := LRes.ToArray; finally LRes.Free; end; end; end.