bf7aac478b
Replaces the crypto test bench with the three screens the client actually needs. PMA.Vault holds the decrypted snapshot and answers the search; mainApk builds unlock/list/detail in code rather than three .fmx files. Two safety rules live in the UI because nowhere else can hold them: the plaintext is dropped when the app backgrounds (screen hidden on WillBecomeInactive, which precedes the recents-preview capture), and the clipboard is cleared after 45 s only if it still holds what we put there. The search deliberately ignores the password field. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
199 lines
5.6 KiB
ObjectPascal
199 lines
5.6 KiB
ObjectPascal
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
|
|
TVaultEntry = record
|
|
Uuid, Title, Site, Username, Password, Folder, Tags, Kind, Totp: string;
|
|
Deleted: 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<TVaultEntry>;
|
|
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<Integer>;
|
|
|
|
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.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;
|
|
|
|
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<string>('username', '');
|
|
FExportedAt := LRoot.GetValue<string>('exported_at',
|
|
LRoot.GetValue<string>('snapshot_at', ''));
|
|
|
|
if not LRoot.TryGetValue<TJSONArray>('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<string>('uuid', '');
|
|
FEntries[N].Title := LObj.GetValue<string>('title', '');
|
|
FEntries[N].Site := LObj.GetValue<string>('site', '');
|
|
FEntries[N].Username := LObj.GetValue<string>('username', '');
|
|
FEntries[N].Password := LObj.GetValue<string>('password', '');
|
|
FEntries[N].Folder := LObj.GetValue<string>('folder', '');
|
|
FEntries[N].Kind := LObj.GetValue<string>('kind', 'login');
|
|
FEntries[N].Totp := LObj.GetValue<string>('totp_secret', '');
|
|
FEntries[N].Tags := TagsToString(LObj.GetValue('tags'));
|
|
// deleted arrive en 0/1 depuis nos conteneurs ; absent = vivant.
|
|
FEntries[N].Deleted := LObj.GetValue<Integer>('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<Integer>;
|
|
var
|
|
LQ: string;
|
|
LRes: TList<Integer>;
|
|
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<Integer>.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.
|