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;
    /// Sous-type (carte, cle SSH, serveur...). Vide pour un identifiant ou
    /// une note ordinaire.
    Template: string;
    /// Icone en data URI. Non chiffree, purement cosmetique.
    IconB64: string;
    /// ISO 8601 UTC. Sert d'abord a l'affichage ; ce sera l'arbitre de la
    /// fusion le jour ou le client ecrira.
    UpdatedAt: 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>;
    FFolders: TArray<string>;
    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, TRIES par nom affiche -
    /// l'ordre de l'instantane est celui de la base, donc arbitraire a l'oeil.
    /// 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.
    /// Comme les etiquettes sont couvertes par la recherche texte, il n'y a
    /// pas de filtre d'etiquette separe : taper son nom suffit.
    ///
    /// AFolder vide = tous les dossiers.
    function Search(const AQuery: string; const AFolder: string = '';
      AIncludeTrash: Boolean = False): TArray<Integer>;

    /// Dossiers declares par l'instantane, dans son ordre.
    property Folders: TArray<string> read FFolders;

    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, System.Generics.Defaults;

{ 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);
  SetLength(FFolders, 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', ''));

    // Dossiers : l'instantane porte {name, color, icon}, seul le nom sert ici.
    // Un instantane ancien peut ne pas avoir le tableau du tout.
    if LRoot.TryGetValue<TJSONArray>('folders', LArr) then
    begin
      SetLength(FFolders, LArr.Count);
      N := 0;
      for I := 0 to LArr.Count - 1 do
      begin
        if not (LArr.Items[I] is TJSONObject) then Continue;
        FFolders[N] := (LArr.Items[I] as TJSONObject).GetValue<string>('name', '');
        if FFolders[N] <> '' then Inc(N);
      end;
      SetLength(FFolders, N);
    end;

    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'));
      FEntries[N].Template  := LObj.GetValue<string>('template', '');
      FEntries[N].IconB64   := LObj.GetValue<string>('icon_b64', '');
      FEntries[N].UpdatedAt := LObj.GetValue<string>('updated_at', '');
      // 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; const AFolder: 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 (AFolder <> '') and not SameText(E.Folder, AFolder) then Continue;
      if Matches(E) then LRes.Add(I);
    end;
    Result := LRes.ToArray;
  finally
    LRes.Free;
  end;

  // Tri sur le nom affiche, insensible a la casse et a l'accentuation faible
  // de CompareText - suffisant pour une liste qu'on parcourt a l'oeil.
  TArray.Sort<Integer>(Result, TComparer<Integer>.Construct(
    function(const A, B: Integer): Integer
    begin
      Result := CompareText(FEntries[A].Display, FEntries[B].Display);
    end));
end;

end.