Password-Manager/android-client/PMA.Vault.pas

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<TVaultField>;
    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<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.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<TVaultField>;
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<string>('label', '');
    Result[N].Value   := LObj.GetValue<string>('value', '');
    Result[N].Secret  := LObj.GetValue<Boolean>('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<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'));
      FEntries[N].Fields   := ParseFields(LObj.GetValue('custom_fields'));
      // 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.