Password-Manager/mainApk.pas

unit mainApk;
{
  Client Android en LECTURE SEULE : deverrouiller, chercher, copier.

  Trois ecrans dans une seule forme, montres a tour de role - une forme par
  ecran couterait un fichier .fmx chacun pour trois dispositions triviales.

    1. Deverrouillage : ouvre le coffre local (biometrie), ou telecharge le
       conteneur et le dechiffre si l'appareil n'en a pas encore.
    2. Liste          : recherche + entrees.
    3. Detail         : les champs d'une entree, mot de passe masque.

  DEUX REGLES DE SURETE tenues ici, pas ailleurs :
    - le coffre en clair est EFFACE des que l'application passe en arriere-plan
      (sinon il reste dans l'apercu des applications recentes) ;
    - le presse-papiers est VIDE apres un delai, et seulement si son contenu
      est toujours celui qu'on y a mis.

  L'ecriture n'existe pas : le poste Windows reste la source. Modifier ici
  demanderait le PUT cote serveur et une fusion cote client.
}

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Diagnostics, System.Rtti, System.NetEncoding, System.DateUtils,
  System.Generics.Collections,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
  FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox,
  PMA.Vault;

const
  // Parametres du banc d'essai, pre-remplis pour ne pas les retaper.
  //
  // Le port differe selon la plateforme : sur Windows on attaque Apache
  // directement (80), sur Android on passe par "adb reverse tcp:8080 tcp:80",
  // qui fait voir le PC comme 127.0.0.1 - ce qui satisfait au passage
  // l'exemption HTTPS de l'endpoint, reservee a la boucle locale.
{$IF DEFINED(ANDROID)}
  TEST_URL = 'http://127.0.0.1:8080/server-php/sync.php';
{$ELSE}
  TEST_URL = 'http://127.0.0.1/server-php/sync.php';
{$ENDIF}
  // Jeton d'un serveur de test local. Il n'authentifie qu'un appareil et ne
  // donne acces qu'a du chiffre - mais a remplacer avant toute mise en ligne.
  TEST_TOKEN = '8765e5bf426039e9888f44bfbab27d489d12b7dbaaa54c8c695ae6af8b2a820e';

  // Assez pour aller coller dans une autre application, trop court pour qu'un
  // mot de passe traine dans l'historique du presse-papiers.
  CLIPBOARD_CLEAR_SECONDS = 45;

  // Verrouillage sur inactivite au premier plan. Le passage en arriere-plan
  // verrouille deja ; ceci couvre le telephone pose sur une table, ecran
  // allume, application ouverte.
  AUTOLOCK_MINUTES = 3;

// TEST_PWD vient d'un fichier LOCAL, hors depot : il ouvre le coffre entier
// une fois le conteneur telecharge. Absent apres un clone -> recopier
// PMA.LocalConfig.template.inc.
{$I android-client\PMA.LocalConfig.inc}

type
  /// Une ligne du detail, avant tout controle. Site, identifiant, mot de
  /// passe et champs personnalises se ramenent tous a la meme chose : un
  /// intitule, une valeur, et le fait qu'elle soit secrete ou non. Les traiter
  /// separement dupliquerait revelation et copie quatre fois.
  TDetRow = record
    Caption, Value: string;
    Secret: Boolean;
  end;

  TForm8 = class(TForm)
  private
    FVault: TVault;
    FFiltered: TArray<Integer>;   // indices dans FVault, resultat de la recherche
    FCurrent: TVaultEntry;
    // L'ETag n'est conserve QUE si le dechiffrement qui a suivi a reussi :
    // envoyer If-None-Match sans detenir le clair correspondant fait
    // economiser un telechargement pour se retrouver sans donnees.
    FETag: string;
    FBusy: Boolean;
    // Mot de passe de sync tel qu'il a ete range avec le coffre. Il rend le
    // rafraichissement de fond silencieux : sans lui, chaque modification
    // faite sur le poste ferait apparaitre une invite au lancement.
    FSyncPwd: string;

    // --- ecran 1 : deverrouillage
    FLayUnlock: TLayout;
    FUrl, FToken, FPwd: TEdit;
    FBtnOpen, FBtnSync, FBtnSettings: TButton;
    FLaySettings: TLayout;
    FStatus: TLabel;
    FLog: TMemo;

    // --- ecran 2 : liste
    FLayList: TLayout;
    FSearch: TEdit;
    FFolderBox: TComboBox;
    FList: TListBox;
    FCount: TLabel;
    /// Icones decodees une fois par coffre, pas a chaque frappe : la liste est
    /// reconstruite a chaque caractere tape, et decoder du PNG a ce rythme se
    /// voit. Cle = indice dans le coffre.
    FIcons: TObjectDictionary<Integer, TBitmap>;

    // --- ecran 3 : detail
    // Les lignes sont construites PAR ENTREE : leur nombre depend des champs
    // personnalises. On garde de quoi les detruire et de quoi retrouver
    // l'etiquette de valeur d'une ligne pour la reveler.
    FLayDetail: TLayout;
    FDetBody: TVertScrollBox;
    FDetTitle, FDetToast: TLabel;
    FRows: TArray<TDetRow>;
    FRowCtls: TArray<TLayout>;
    FRowValues: TArray<TLabel>;
    FRowShown: TArray<Boolean>;

    // --- TOTP : une ligne vivante, rafraichie chaque seconde
    FTotpTimer: TTimer;
    FTotpValue: TLabel;
    FTotpCode: string;

    // --- presse-papiers
    FClipTimer: TTimer;
    FCopied: string;

    // --- verrouillage sur inactivite
    FIdleTimer: TTimer;
    FLastActivity: TDateTime;
    procedure Touch;
    procedure OnIdleTimer(Sender: TObject);

    procedure BuildUnlock;
    procedure BuildList;
    procedure BuildDetail;

    procedure ShowUnlock;
    procedure ShowList;
    procedure ShowDetail(AVaultIndex: Integer);
    procedure ClearDetailRows;
    procedure OnTotpTick(Sender: TObject);

    procedure DoOpenLocal(Sender: TObject);
    /// AAuto : declenche par l'ouverture automatique au lancement, pas par
    /// l'utilisateur. Une action automatique ne detruit jamais le cache.
    procedure OpenVault(AAuto: Boolean);
    // Separee de DoOpenLocal : une methode anonyme ne peut pas appeler une
    // procedure imbriquee (E2555), et le rappel de la biometrie en est une.
    procedure OpenLocalNow;
    procedure DoSync(Sender: TObject);
    /// ASilent : rafraichissement de fond. Le coffre local est deja affiche,
    /// donc un echec reseau ne doit rien reclamer a l'utilisateur - il garde
    /// ce qu'il a. Seul un instantane NOUVEAU se voit.
    procedure FetchAndDecrypt(const AUrl, ATok, APwd: string;
      ASilent: Boolean = False);
    procedure AdoptVault(const APlainJson: string);
    procedure LockVault;

    procedure OnSearchChanged(Sender: TObject);
    procedure PopulateFolders;
    procedure RebuildIcons;
    procedure OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
    procedure OnRevealTap(Sender: TObject);
    procedure OnCopyTap(Sender: TObject);
    procedure OnBackTap(Sender: TObject);
    procedure OnToggleSettings(Sender: TObject);
    procedure OnClipTimer(Sender: TObject);
    procedure OnHardwareBack(Sender: TObject; var Key: Word;
      var KeyChar: WideChar; Shift: TShiftState);

    procedure CopyToClipboard(const AText, ALabel: string);
    function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
    procedure Log(const AMsg: string);
    procedure Status(const AMsg: string);
    procedure SetBusy(ABusy: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  Form8: TForm8;

implementation

uses
  PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
  PMA.ScreenGuard, PMA.Clipboard;

{$R *.fmx}

const
  // Puces en points de code, PAS en caracteres litteraux : un .pas sans BOM
  // est lu comme de l'ANSI, et un bullet UTF-8 y devient trois glyphes.
  BULLET = #$2022;
  MASK = BULLET+BULLET+BULLET+BULLET+BULLET+BULLET+
         BULLET+BULLET+BULLET+BULLET+BULLET+BULLET;

{ ----------------------------------------------------------------------------
  Construction
  ---------------------------------------------------------------------------- }

constructor TForm8.Create(AOwner: TComponent);
var
  LEvents: IFMXApplicationEventService;
begin
  inherited;
  Caption := 'Coffre';
  SecureScreen;   // avant tout affichage de contenu
  FVault := TVault.Create;
  FIcons := TObjectDictionary<Integer, TBitmap>.Create([doOwnsValues]);

  BuildDetail;   // cree en dernier a l'ecran = au-dessus des autres
  BuildList;
  BuildUnlock;

  FClipTimer := TTimer.Create(Self);
  FClipTimer.Enabled := False;
  FClipTimer.Interval := CLIPBOARD_CLEAR_SECONDS * 1000;
  FClipTimer.OnTimer := OnClipTimer;

  FTotpTimer := TTimer.Create(Self);
  FTotpTimer.Enabled := False;
  FTotpTimer.Interval := 1000;
  FTotpTimer.OnTimer := OnTotpTick;

  // Tick grossier : on compare des horodatages, il ne sert qu'a echantillonner.
  // Une seconde de precision n'apporterait rien et reveillerait l'appareil.
  FIdleTimer := TTimer.Create(Self);
  FIdleTimer.Enabled := False;
  FIdleTimer.Interval := 15000;
  FIdleTimer.OnTimer := OnIdleTimer;

  // Le bouton retour materiel arrive comme une touche : sans ce gestionnaire
  // il ferme l'application depuis le detail, au lieu de revenir a la liste.
  OnKeyUp := OnHardwareBack;

  if TPlatformServices.Current.SupportsPlatformService(
       IFMXApplicationEventService, LEvents) then
    LEvents.SetApplicationEventHandler(HandleAppEvent);

  ShowUnlock;

  // Ouverture automatique du coffre local. Differee apres la construction :
  // l'invite biometrique s'afficherait sinon avant la premiere peinture de la
  // fenetre, sur un fond vide.
  if HasVault then
    TThread.ForceQueue(nil, procedure begin OpenVault(True); end);
end;

destructor TForm8.Destroy;
begin
  FIcons.Free;
  FVault.Free;
  inherited;
end;

/// Cree un bouton empile en haut. En FMX, des controles alignes en haut
/// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en
/// haut. Chaque Build* cree donc du bas vers le haut.
function TopButton(AParent: TFmxObject; const AText: string;
  AOnClick: TNotifyEvent; AHeight: Single = 48): TButton;
begin
  Result := TButton.Create(AParent);
  Result.Parent := AParent;
  Result.Align := TAlignLayout.Top;
  Result.Margins.Rect := RectF(8, 4, 8, 0);
  Result.Height := AHeight;
  Result.Text := AText;
  Result.OnClick := AOnClick;
end;

function TopEdit(AParent: TFmxObject; const APrompt, AText: string;
  APassword: Boolean = False): TEdit;
begin
  Result := TEdit.Create(AParent);
  Result.Parent := AParent;
  Result.Align := TAlignLayout.Top;
  Result.Margins.Rect := RectF(8, 4, 8, 0);
  Result.TextPrompt := APrompt;
  Result.Text := AText;
  Result.Password := APassword;
end;

procedure TForm8.BuildUnlock;
begin
  FLayUnlock := TLayout.Create(Self);
  FLayUnlock.Parent := Self;
  FLayUnlock.Align := TAlignLayout.Client;

  // Journal en bas : il ne sert plus qu'au diagnostic, mais un echec reseau ou
  // JNI sans trace se debugue a l'aveugle.
  FLog := TMemo.Create(Self);
  FLog.Parent := FLayUnlock;
  FLog.Align := TAlignLayout.Bottom;
  FLog.Height := 150;
  FLog.Margins.Rect := RectF(8, 8, 8, 8);
  FLog.ReadOnly := True;
  // Sans repli, un message d'exception est coupe net au bord du memo - et
  // c'est toujours la fin qui nomme la cause.
  FLog.WordWrap := True;
  FLog.TextSettings.Font.Family := 'monospace';
  FLog.TextSettings.Font.Size := 11;

  // --- du bas vers le haut (voir TopButton)
  FLaySettings := TLayout.Create(Self);
  FLaySettings.Parent := FLayUnlock;
  FLaySettings.Align := TAlignLayout.Top;
  FLaySettings.Height := 116;
  FLaySettings.Visible := False;
  FToken := TopEdit(FLaySettings, 'jeton Bearer', TEST_TOKEN);
  FUrl   := TopEdit(FLaySettings, 'URL de l''endpoint', TEST_URL);

  FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur',
                            OnToggleSettings, 36);
  FBtnSettings.TextSettings.Font.Size := 12;

  FBtnSync := TopButton(FLayUnlock, 'Synchroniser', DoSync);
  FBtnOpen := TopButton(FLayUnlock, 'Ouvrir le coffre', DoOpenLocal);

  // Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci.
  FPwd := TopEdit(FLayUnlock, 'mot de passe de sync', TEST_PWD, True);
  FPwd.Margins.Top := 12;

  FStatus := TLabel.Create(Self);
  FStatus.Parent := FLayUnlock;
  FStatus.Align := TAlignLayout.Top;
  FStatus.Margins.Rect := RectF(8, 16, 8, 0);
  FStatus.Height := 24;
  FStatus.StyledSettings := FStatus.StyledSettings - [TStyledSetting.Size];
  FStatus.TextSettings.Font.Size := 15;
end;

procedure TForm8.BuildList;
var
  LBar, LTop: TLayout;
  LBtnLock: TButton;
begin
  FLayList := TLayout.Create(Self);
  FLayList.Parent := Self;
  FLayList.Align := TAlignLayout.Client;
  FLayList.Visible := False;

  LBar := TLayout.Create(Self);
  LBar.Parent := FLayList;
  LBar.Align := TAlignLayout.Bottom;
  LBar.Height := 52;

  LBtnLock := TButton.Create(Self);
  LBtnLock.Parent := LBar;
  LBtnLock.Align := TAlignLayout.Left;
  LBtnLock.Margins.Rect := RectF(8, 4, 0, 8);
  LBtnLock.Width := 130;
  LBtnLock.Text := 'Verrouiller';
  LBtnLock.OnClick := OnBackTap;
  LBtnLock.Tag := 1;   // 1 = verrouiller, 0 = simple retour (voir OnBackTap)

  FCount := TLabel.Create(Self);
  FCount.Parent := LBar;
  FCount.Align := TAlignLayout.Client;
  FCount.Margins.Rect := RectF(12, 4, 8, 8);
  FCount.TextSettings.HorzAlign := TTextAlign.Trailing;
  FCount.TextSettings.VertAlign := TTextAlign.Center;

  FList := TListBox.Create(Self);
  FList.Parent := FLayList;
  FList.Align := TAlignLayout.Client;
  FList.Margins.Rect := RectF(4, 0, 4, 0);
  FList.ItemHeight := 56;
  FList.OnItemClick := OnItemTap;

  LTop := TLayout.Create(Self);
  LTop.Parent := FLayList;
  LTop.Align := TAlignLayout.Top;
  LTop.Height := 48;
  LTop.Margins.Rect := RectF(8, 8, 8, 8);

  // Pas de filtre d'etiquette : la recherche texte couvre deja les etiquettes,
  // en taper le nom suffit. Les dossiers, eux, ne se devinent pas.
  FFolderBox := TComboBox.Create(Self);
  FFolderBox.Parent := LTop;
  FFolderBox.Align := TAlignLayout.Right;
  FFolderBox.Width := 140;
  FFolderBox.Margins.Left := 8;
  FFolderBox.OnChange := OnSearchChanged;

  FSearch := TEdit.Create(Self);
  FSearch.Parent := LTop;
  FSearch.Align := TAlignLayout.Client;
  FSearch.TextPrompt := 'Rechercher';
  FSearch.OnChangeTracking := OnSearchChanged;
end;

/// Intitule discret au-dessus d'une valeur. Meme forme pour toutes les
/// lignes, y compris celle du TOTP.
function MakeRow(AParent: TFmxObject; const ACaption: string;
  out AValue: TLabel): TLayout;
var
  LCap: TLabel;
begin
  Result := TLayout.Create(nil);   // detruite a la main, voir ClearDetailRows
  Result.Parent := AParent;
  Result.Align := TAlignLayout.Top;
  Result.Height := 62;
  Result.Margins.Rect := RectF(12, 10, 12, 0);

  LCap := TLabel.Create(Result);
  LCap.Parent := Result;
  LCap.Align := TAlignLayout.Top;
  LCap.Height := 20;
  LCap.Text := ACaption;
  LCap.Opacity := 0.6;
  LCap.StyledSettings := LCap.StyledSettings - [TStyledSetting.Size];
  LCap.TextSettings.Font.Size := 12;

  AValue := TLabel.Create(Result);
  AValue.Parent := Result;
  AValue.Align := TAlignLayout.Client;
  AValue.StyledSettings := AValue.StyledSettings - [TStyledSetting.Size];
  AValue.TextSettings.Font.Size := 16;
end;

function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer;
  AOnClick: TNotifyEvent): TButton;
begin
  Result := TButton.Create(ARow);
  Result.Parent := ARow;
  Result.Align := TAlignLayout.Right;
  Result.Margins.Left := 6;
  Result.Width := 90;
  Result.Text := AText;
  Result.Tag := ATag;
  Result.OnClick := AOnClick;
end;

procedure TForm8.BuildDetail;
var
  LBtnBack: TButton;
begin
  FLayDetail := TLayout.Create(Self);
  FLayDetail.Parent := Self;
  FLayDetail.Align := TAlignLayout.Client;
  FLayDetail.Visible := False;

  LBtnBack := TButton.Create(Self);
  LBtnBack.Parent := FLayDetail;
  LBtnBack.Align := TAlignLayout.Bottom;
  LBtnBack.Height := 48;
  LBtnBack.Margins.Rect := RectF(8, 8, 8, 8);
  LBtnBack.Text := 'Retour';
  LBtnBack.Tag := 0;
  LBtnBack.OnClick := OnBackTap;

  FDetToast := TLabel.Create(Self);
  FDetToast.Parent := FLayDetail;
  FDetToast.Align := TAlignLayout.Bottom;
  FDetToast.Height := 22;
  FDetToast.Margins.Rect := RectF(12, 0, 12, 0);
  FDetToast.StyledSettings := FDetToast.StyledSettings - [TStyledSetting.Size];
  FDetToast.TextSettings.Font.Size := 12;
  FDetToast.Opacity := 0.7;

  // Defilant : une entree avec dix champs personnalises depasse l'ecran d'un
  // telephone, et les lignes ne sont connues qu'a l'ouverture.
  FDetBody := TVertScrollBox.Create(Self);
  FDetBody.Parent := FLayDetail;
  FDetBody.Align := TAlignLayout.Client;

  FDetTitle := TLabel.Create(Self);
  FDetTitle.Parent := FLayDetail;
  FDetTitle.Align := TAlignLayout.Top;
  FDetTitle.Height := 44;
  FDetTitle.Margins.Rect := RectF(12, 12, 12, 0);
  FDetTitle.StyledSettings := FDetTitle.StyledSettings - [TStyledSetting.Size];
  FDetTitle.TextSettings.Font.Size := 22;
end;

{ ----------------------------------------------------------------------------
  Navigation
  ---------------------------------------------------------------------------- }

procedure TForm8.ShowUnlock;
begin
  FLayDetail.Visible := False;
  FLayList.Visible := False;
  FLayUnlock.Visible := True;

  // Le bouton d'ouverture n'a de sens que si un coffre local existe ; sinon
  // seul le telechargement peut en produire un.
  FBtnOpen.Visible := HasVault;
  if HasVault then
  begin
    if VaultNeedsAuth then
      Status('Coffre present sur cet appareil - protege')
    else
      Status('Coffre present sur cet appareil');
    FBtnSync.Text := 'Synchroniser';
  end
  else
  begin
    Status('Aucun coffre local - premier telechargement');
    FBtnSync.Text := 'Telecharger le coffre';
  end;
end;

procedure TForm8.ShowList;
begin
  // Quitter le detail rend ses valeurs en clair, et arrete le compte a rebours.
  ClearDetailRows;
  FLayUnlock.Visible := False;
  FLayDetail.Visible := False;
  FLayList.Visible := True;
  FSearch.Text := '';
  OnSearchChanged(nil);
end;

function HumanSize(ABytes: Int64): string;
begin
  if ABytes >= 1024 * 1024 then
    Result := Format('%.1f Mo', [ABytes / (1024 * 1024)])
  else if ABytes >= 1024 then
    Result := Format('%.0f Ko', [ABytes / 1024])
  else
    Result := Format('%d o', [ABytes]);
end;

procedure TForm8.ClearDetailRows;
var
  LRow: TLayout;
begin
  // Appelable avant la fin du constructeur (ShowList), d'ou la garde.
  if FTotpTimer <> nil then FTotpTimer.Enabled := False;
  FTotpValue := nil;
  FTotpCode := '';
  // Detruites explicitement plutot que par DeleteChildren : le conteneur est
  // un TVertScrollBox, dont les enfants comprennent ses propres barres.
  for LRow in FRowCtls do LRow.Free;
  SetLength(FRowCtls, 0);
  SetLength(FRowValues, 0);
  SetLength(FRowShown, 0);
  SetLength(FRows, 0);
end;

procedure TForm8.ShowDetail(AVaultIndex: Integer);
var
  LMeta, LPwdCaption: string;
  I: Integer;
  LRow: TLayout;
  LValue: TLabel;

  procedure Add(const ACaption, AValue: string; ASecret: Boolean);
  begin
    if AValue = '' then Exit;   // une ligne vide n'apprend rien
    SetLength(FRows, Length(FRows) + 1);
    FRows[High(FRows)].Caption := ACaption;
    FRows[High(FRows)].Value   := AValue;
    FRows[High(FRows)].Secret  := ASecret;
  end;

begin
  Touch;
  ClearDetailRows;
  FCurrent := FVault.Entry(AVaultIndex);
  FDetTitle.Text := FCurrent.Display;
  FDetToast.Text := '';

  // Le corps d'une note est stocke dans le champ mot de passe : meme donnee,
  // autre intitule, et pas de raison de la masquer comme un secret.
  if FCurrent.IsNote then LPwdCaption := 'Contenu' else LPwdCaption := 'Mot de passe';

  Add('Site', FCurrent.Site, False);
  Add('Identifiant', FCurrent.Username, False);
  Add(LPwdCaption, FCurrent.Password, not FCurrent.IsNote);
  for I := 0 to High(FCurrent.Fields) do
    Add(FCurrent.Fields[I].Caption, FCurrent.Fields[I].Value,
        FCurrent.Fields[I].Secret);

  LMeta := FCurrent.Folder;
  if FCurrent.Tags <> '' then
  begin
    if LMeta <> '' then LMeta := LMeta + '  -  ';
    LMeta := LMeta + FCurrent.Tags;
  end;
  // Les pieces jointes ne sont pas encore enregistrables sur le telephone,
  // mais taire leur existence serait pire : on saurait sur le poste qu'une
  // entree porte un document, et pas ici.
  for I := 0 to High(FCurrent.Attachments) do
    Add('Piece jointe', FCurrent.Attachments[I].FileName + '   ' +
        HumanSize(FCurrent.Attachments[I].SizeBytes), False);

  Add('Dossier / etiquettes', LMeta, False);
  // Le sous-type n'existe que pour les modeles (carte, cle SSH, serveur...) ;
  // Add ignore une valeur vide, donc rien a tester ici.
  Add('Type', FCurrent.Template, False);
  // Horodatage tel quel : c'est de l'ISO 8601 UTC, lisible, et le reformater
  // demanderait de decider d'un fuseau alors qu'il n'y a rien a arbitrer.
  Add('Modifie le', FCurrent.UpdatedAt, False);

  SetLength(FRowValues, Length(FRows));
  SetLength(FRowShown, Length(FRows));
  SetLength(FRowCtls, Length(FRows));

  // Le TOTP EN PREMIER, donc en tete d'ecran : c'est ce qu'on vient chercher
  // sur un telephone. Seule ligne vivante, rafraichie chaque seconde.
  if FCurrent.Totp <> '' then
  begin
    LRow := MakeRow(FDetBody, 'Code 2FA', FTotpValue);
    SetLength(FRowCtls, Length(FRowCtls) + 1);
    FRowCtls[High(FRowCtls)] := LRow;
    FTotpValue.TextSettings.Font.Size := 26;
    AddRowButton(LRow, 'Copier', -1, OnCopyTap);
    OnTotpTick(nil);            // pas d'attente d'une seconde a l'ouverture
    FTotpTimer.Enabled := True;
  end;

  // DANS L'ORDRE, ici : au sein d'un TVertScrollBox les enfants alignes en
  // haut s'empilent dans l'ordre de creation - l'inverse d'un TLayout, ou le
  // dernier cree se retrouve en tete. Se tromper de convention renvoie le
  // formulaire a l'envers, sans rien casser d'autre.
  for I := 0 to High(FRows) do
  begin
    LRow := MakeRow(FDetBody, FRows[I].Caption, LValue);
    FRowCtls[I] := LRow;
    FRowValues[I] := LValue;
    FRowShown[I] := False;
    if FRows[I].Secret then
    begin
      LValue.Text := MASK;
      AddRowButton(LRow, 'Afficher', I, OnRevealTap);
    end
    else
      LValue.Text := FRows[I].Value;
    AddRowButton(LRow, 'Copier', I, OnCopyTap);
  end;
  // La derniere ligne affichee touche sinon le bord du defilement, ce qui la
  // fait passer pour tronquee alors qu'elle est juste collee.
  // La derniere ligne affichee touche sinon le bord du defilement, ce qui la
  // fait passer pour tronquee alors qu'elle est juste collee.
  if Length(FRows) > 0 then
    FRowCtls[High(FRows)].Margins.Bottom := 12;

  FLayList.Visible := False;
  FLayDetail.Visible := True;
end;

procedure TForm8.OnTotpTick(Sender: TObject);
var
  LLeft, LPeriod: Integer;
begin
  if FTotpValue = nil then
  begin
    FTotpTimer.Enabled := False;
    Exit;
  end;
  FTotpCode := TotpNow(FCurrent.Totp, LLeft, LPeriod);
  if FTotpCode = '' then
  begin
    // Un secret illisible ne doit pas passer pour un code : le dire.
    FTotpValue.Text := 'secret illisible';
    FTotpTimer.Enabled := False;
    Exit;
  end;
  // Coupe en deux, comme partout ailleurs : six chiffres d'affilee se
  // recopient mal.
  FTotpValue.Text := Copy(FTotpCode, 1, Length(FTotpCode) div 2) + ' ' +
                     Copy(FTotpCode, Length(FTotpCode) div 2 + 1, MaxInt) +
                     '   ' + LLeft.ToString + ' s';
end;

procedure TForm8.OnBackTap(Sender: TObject);
begin
  // Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail.
  if (Sender is TButton) and (TButton(Sender).Tag = 1) then
    LockVault
  else
    ShowList;
end;

procedure TForm8.OnHardwareBack(Sender: TObject; var Key: Word;
  var KeyChar: WideChar; Shift: TShiftState);
begin
  if Key <> vkHardwareBack then Exit;
  if FLayDetail.Visible then
  begin
    ShowList;
    Key := 0;   // consomme : sinon Android ferme l'application
  end
  else if FLayList.Visible then
  begin
    LockVault;
    Key := 0;
  end;
end;

procedure TForm8.OnToggleSettings(Sender: TObject);
begin
  FLaySettings.Visible := not FLaySettings.Visible;
end;

{ ----------------------------------------------------------------------------
  Ouverture, synchronisation, verrouillage
  ---------------------------------------------------------------------------- }

procedure TForm8.LockVault;
begin
  // Le clair dispararait de la memoire ET de l'ecran. Le fichier local reste :
  // il est chiffre par le materiel, c'est tout l'interet du cache.
  //
  // L'ETAG PART AVEC LUI. Il decrit le clair detenu, pas un telechargement :
  // le garder ferait repondre 304 au serveur alors qu'on n'a plus rien a
  // afficher - et sur un poste sans cache local (hors Android), plus aucun
  // moyen de rouvrir le coffre sans relancer l'application.
  FETag := '';
  FIdleTimer.Enabled := False;
  FVault.Clear;
  FList.Clear;
  FIcons.Clear;
  // Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
  // fait partie du verrouillage, pas de l'affichage.
  ClearDetailRows;
  FCurrent := Default(TVaultEntry);
  ShowUnlock;
end;

procedure TForm8.AdoptVault(const APlainJson: string);
begin
  FVault.LoadFromJson(APlainJson);
  Log('  ' + FVault.LiveCount.ToString + ' entrees, ' +
      FVault.TrashCount.ToString + ' en corbeille');
  RebuildIcons;
  PopulateFolders;
  Touch;
  FIdleTimer.Enabled := True;
  // Deja dans l'application : reconstruire la liste SANS y ramener
  // l'utilisateur. Obligatoire meme s'il est dans le detail - les lignes de
  // la liste portent des indices vers l'ancien coffre, et un appui ouvrirait
  // la mauvaise entree.
  if FLayList.Visible or FLayDetail.Visible then
    OnSearchChanged(nil)
  else
    ShowList;
end;

procedure TForm8.OpenLocalNow;
var
  LPlain, LETag, LPwd: string;
begin
  if LoadVault(LPlain, LETag, LPwd) then
  begin
    FETag := LETag;
    if LPwd <> '' then FSyncPwd := LPwd;
    try
      AdoptVault(LPlain);
      // Afficher d'abord, synchroniser ensuite : le coffre est a l'ecran, le
      // reseau se debrouille derriere. Sans mot de passe range, on ne peut
      // rien ouvrir de nouveau - inutile d'aller voir.
      if FSyncPwd <> '' then
        FetchAndDecrypt(FUrl.Text.Trim, FToken.Text.Trim, FSyncPwd, True);
    except
      on E: Exception do
      begin
        // Un coffre local illisible se remplace, il ne se repare pas.
        Log('Coffre local corrompu : ' + E.Message);
        ClearVault;
        ShowUnlock;
      end;
    end;
  end
  else
  begin
    // ShowUnlock AVANT le message : il repositionne le statut selon ce que
    // l'appareil detient, et ecraserait donc l'explication.
    ShowUnlock;
    Log('Coffre local illisible : ' + LastStoreError);
    Status('Coffre local illisible - voir le journal');
  end;
end;

procedure TForm8.DoOpenLocal(Sender: TObject);
begin
  OpenVault(False);   // geste explicite de l'utilisateur
end;

procedure TForm8.OpenVault(AAuto: Boolean);
begin
  if FBusy then Exit;
  // L'authentification affiche un dialogue systeme : elle doit rester sur le
  // thread principal, et PRECEDER toute lecture du coffre.
  if not VaultNeedsAuth then
  begin
    OpenLocalNow;
    Exit;
  end;

  if not AAuto then Status('Authentification...');
  AuthenticateThen('Acceder au coffre',
    procedure(AOutcome: TBioOutcome)
    begin
      case AOutcome of
        boOK: OpenLocalNow;
        boCancelled: Status('Annule');
        boUnavailable:
          // Reponse nette du systeme : plus rien pour authentifier sur cet
          // appareil, donc la cle est perdue et le cache avec elle.
          //
          // UNE ACTION AUTOMATIQUE N'EFFACE JAMAIS LE CACHE. Au lancement on
          // se contente de le dire : si le diagnostic est faux - service pas
          // encore pret, etat transitoire - effacer imposerait un
          // retelechargement et quatre secondes de derivation pour rien, et
          // masquerait la vraie cause. L'utilisateur tranche en reessayant.
          if AAuto then
          begin
            Log('Authentification indisponible au lancement - cache conserve');
            Log('  ' + LastBiometricError);
            Status('Authentification indisponible - reessayer');
          end
          else
          begin
            Log('Plus aucune protection sur l''appareil - cache efface');
            Log('  ' + LastBiometricError);
            ClearVault;
            ShowUnlock;
          end;
      else
        // boFailed : la couche Java a leve quelque chose. Cela ne dit rien de
        // l'appareil, donc on ne touche a rien - on rapporte.
        Log('Echec de l''authentification : ' + LastBiometricError);
        Status('Echec de l''authentification');
      end;
    end);
end;

procedure TForm8.DoSync(Sender: TObject);
var
  LUrl, LTok, LPwd: string;
begin
  if FBusy then Exit;
  // Lus ICI, sur le thread principal : toucher un controle FMX depuis le
  // thread de travail est un plantage differe, pas une erreur de compilation.
  LUrl := FUrl.Text.Trim;
  LTok := FToken.Text.Trim;
  // Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
  // range qui ne convient plus.
  LPwd := FPwd.Text;
  if LPwd = '' then LPwd := FSyncPwd;
  if LPwd = '' then
  begin
    Status('Mot de passe de sync requis');
    Exit;
  end;
  FLog.Lines.Clear;
  FetchAndDecrypt(LUrl, LTok, LPwd);
end;

procedure TForm8.FetchAndDecrypt(const AUrl, ATok, APwd: string;
  ASilent: Boolean);
var
  LCanAuth: Boolean;
begin
  SetBusy(True);
  if not ASilent then Status('Telechargement...');
  // NE JAMAIS FERMER LE CACHE DERRIERE UNE PORTE QU'ON NE SAIT PAS OUVRIR.
  // Demander une cle protegee par authentification alors que l'invite ne peut
  // pas s'afficher (permission absente, aucune protection configuree) produit
  // un fichier definitivement illisible. Evalue ici, sur le thread principal :
  // l'interrogation du service passe par la couche Java.
  LCanAuth := BiometricAvailable;
  TThread.CreateAnonymousThread(
    procedure
    var
      LClient: TSyncClient;
      LRes: TSyncResult;
      LPlain, LCached, LCachedETag, LCachedPwd: string;
      LSw: TStopwatch;
    begin
      // Le coffre local d'abord : s'il est la, on connait deja l'ETag et on
      // evite les 4 secondes de derivation quand rien n'a change.
      if (FETag = '') and LoadVault(LCached, LCachedETag, LCachedPwd) then
        FETag := LCachedETag;

      LClient := TSyncClient.Create(AUrl, ATok);
      // try/finally et NON un simple enchainement : les Exit des branches
      // d'erreur ci-dessous sautent la fin de la procedure, ce qui laissait
      // l'interface bloquee apres le premier echec.
      try
      try
        Log('GET ' + AUrl);
        if FETag <> '' then Log('  If-None-Match: ' + FETag);
        LSw := TStopwatch.StartNew;
        LRes := LClient.Fetch(FETag);
        LSw.Stop;
        Log('  HTTP ' + LRes.HttpCode.ToString + ' en ' +
            LSw.ElapsedMilliseconds.ToString + ' ms');

        case LRes.Status of
          ssNotModified:
            begin
              // C'est ICI que le cache paie : pas de telechargement, pas de
              // derivation, le coffre vient du fichier local.
              // Rien n'a change cote serveur : le clair est deja quelque part,
              // soit en memoire, soit dans le cache lu en debut de procedure.
              // Surtout PAS de relecture du fichier ici - elle peut echouer
              // (authentification expiree) et laisserait l'utilisateur sans
              // rien apres un appel pourtant reussi.
              TThread.Queue(nil,
                procedure
                begin
                  if FVault.Count > 0 then
                    // Rien a faire : ce qui est affiche est deja a jour. En
                    // rafraichissement de fond c'est le cas courant, et il
                    // doit passer inapercu - surtout pas de retour a la liste
                    // alors que l'utilisateur consulte une entree.
                    Log('  304 : inchange, coffre deja ouvert')
                  else if LCached <> '' then
                  begin
                    Log('  304 : inchange, coffre servi depuis le cache');
                    try
                      AdoptVault(LCached);
                    except
                      on E: Exception do Status('Cache illisible : ' + E.Message);
                    end;
                  end
                  else
                  begin
                    // Un ETag sans clair correspondant : l'invariant est rompu.
                    // On le jette pour que l'appel suivant retelecharge.
                    FETag := '';
                    if not ASilent then
                      Status('Cache absent - appuyer a nouveau pour telecharger');
                  end;
                end);
              Exit;
            end;
          ssNoSnapshot:
            begin
              // Le serveur repond pareil dans les deux cas, par conception.
              Log('  404 : pas d''instantane OU jeton invalide');
              if not ASilent then
                TThread.Queue(nil, procedure
                  begin Status('Rien a telecharger (404)'); end);
              Exit;
            end;
          ssRefused, ssHttpError, ssNetworkError:
            begin
              // En fond, un echec reseau ne se signale pas : le coffre local
              // est affiche, hors ligne est un etat normal, et une alerte ici
              // apprendrait a l'utilisateur a ignorer les alertes.
              Log('  echec : ' + LRes.Error);
              if not ASilent then
                TThread.Queue(nil, procedure
                  begin Status('Echec reseau'); end);
              Exit;
            end;
        end;

        Log('  recu ' + Length(LRes.Container).ToString + ' octets');
        if not ASilent then
          TThread.Queue(nil, procedure begin Status('Dechiffrement...'); end);

        LSw := TStopwatch.StartNew;
        // Volontairement AVANT de retenir l'ETag : un echec ici doit laisser
        // FETag vide pour que le prochain essai retelecharge.
        LPlain := DecryptContainer(LRes.Container, APwd);
        LSw.Stop;
        FETag := LRes.ETag;
        Log('  dechiffre en ' + LSw.ElapsedMilliseconds.ToString + ' ms');

        // Ecrit APRES un dechiffrement reussi seulement, et avec son ETag :
        // les deux doivent rester coherents.
        try
          // Le mot de passe part avec le coffre : c'est lui qui permettra au
          // prochain lancement de rafraichir sans rien demander.
          SaveVault(LPlain, FETag, APwd, LCanAuth);
          if VaultNeedsAuth then
            Log('  cache ecrit - protege par biometrie/code')
          else if LCanAuth then
            Log('  cache ecrit - cle simple (Keystore a refuse la contrainte)')
          else
            Log('  cache ecrit - AUCUNE protection : pas d''authentification ici');
        except
          // La classe compte autant que le message : "methode introuvable"
          // designe une signature JNI fausse, pas un probleme de stockage.
          on E: Exception do
            Log('  cache non ecrit : ' + E.ClassName + ' - ' + E.Message);
        end;

        TThread.Queue(nil,
          procedure
          begin
            FSyncPwd := APwd;   // il vient d'ouvrir un conteneur : il est bon
            try
              AdoptVault(LPlain);
            except
              on E: Exception do
                if not ASilent then
                  Status('Instantane illisible : ' + E.Message);
            end;
          end);
      except
        on E: Exception do
        begin
          Log('ERREUR ' + E.ClassName + ' : ' + E.Message);
          // Le cas de loin le plus frequent, et le message par defaut ne le
          // dit pas : GCM echoue a la verification quand la cle est fausse.
          //
          // En fond, cela veut dire que le mot de passe range ne convient
          // plus - le poste a change de mot de passe de sync. On ne le jette
          // PAS : il faudra le retaper, mais garder l'ancien laisse au moins
          // le champ prerempli, et le coffre local reste consultable.
          if not ASilent then
            TThread.Queue(nil, procedure
              begin Status('Echec - mot de passe de sync incorrect ?'); end);
        end;
      end;
      finally
        LClient.Free;
        TThread.Queue(nil, procedure begin SetBusy(False); end);
      end;
    end).Start;
end;

{ ----------------------------------------------------------------------------
  Liste et recherche
  ---------------------------------------------------------------------------- }

/// Data URI -> bitmap, ou nil. Les icones peuvent etre du SVG, que FMX ne
/// sait pas charger : l'echec est normal et se solde par les initiales.
function BitmapFromDataUri(const AUri: string): TBitmap;
var
  LComma: Integer;
  LStream: TBytesStream;
begin
  Result := nil;
  if not AUri.StartsWith('data:') then Exit;
  LComma := Pos(',', AUri);
  if LComma = 0 then Exit;
  try
    LStream := TBytesStream.Create(TNetEncoding.Base64.DecodeStringToBytes(
                 Copy(AUri, LComma + 1, MaxInt)));
    try
      Result := TBitmap.Create;
      Result.LoadFromStream(LStream);
    finally
      LStream.Free;
    end;
  except
    FreeAndNil(Result);
  end;
end;

procedure TForm8.RebuildIcons;
var
  I: Integer;
  LBmp: TBitmap;
begin
  FIcons.Clear;
  // ponytail: tout decode a l'adoption du coffre, sur le thread principal.
  // Quelques centaines de vignettes de 16 px ne se sentent pas ; deporter
  // dans un thread le jour ou l'ouverture marque un temps.
  for I := 0 to FVault.Count - 1 do
  begin
    if FVault.Entry(I).IconB64 = '' then Continue;
    LBmp := BitmapFromDataUri(FVault.Entry(I).IconB64);
    if LBmp <> nil then FIcons.Add(I, LBmp);
  end;
end;

procedure TForm8.PopulateFolders;
var
  LF, LPrev: string;
  I: Integer;
begin
  // Le choix courant survit a un rafraichissement de fond : le voir retomber
  // sur "tous" tout seul, sans avoir rien touche, serait deroutant.
  LPrev := '';
  if FFolderBox.ItemIndex > 0 then
    LPrev := FFolderBox.Items[FFolderBox.ItemIndex];

  FFolderBox.Items.BeginUpdate;
  try
    FFolderBox.Items.Clear;
    FFolderBox.Items.Add('Tous les dossiers');
    for LF in FVault.Folders do FFolderBox.Items.Add(LF);
  finally
    FFolderBox.Items.EndUpdate;
  end;

  I := FFolderBox.Items.IndexOf(LPrev);
  if I < 0 then I := 0;
  FFolderBox.ItemIndex := I;
end;

procedure TForm8.OnSearchChanged(Sender: TObject);
var
  I: Integer;
  LItem: TListBoxItem;
  E: TVaultEntry;
  LFolder: string;
  LBmp: TBitmap;
begin
  // ponytail: refonte complete de la liste a chaque frappe. Sur un coffre de
  // quelques centaines d'entrees c'est imperceptible ; passer a un modele
  // virtuel (TListView) le jour ou ca rame.
  Touch;
  LFolder := '';
  if FFolderBox.ItemIndex > 0 then   // 0 = tous les dossiers
    LFolder := FFolderBox.Items[FFolderBox.ItemIndex];
  FFiltered := FVault.Search(FSearch.Text, LFolder);

  FList.BeginUpdate;
  try
    FList.Clear;
    for I := 0 to High(FFiltered) do
    begin
      E := FVault.Entry(FFiltered[I]);
      LItem := TListBoxItem.Create(FList);
      LItem.Parent := FList;
      LItem.Text := E.Display;
      LItem.ItemData.Detail := E.Username;
      LItem.StyleLookup := 'listboxitembottomdetail';
      // Le setter copie le bitmap : le cache garde la propriete du sien.
      if FIcons.TryGetValue(FFiltered[I], LBmp) then
        LItem.ItemData.Bitmap := LBmp;
      LItem.Tag := FFiltered[I];   // indice dans le coffre, pas dans la liste
    end;
  finally
    FList.EndUpdate;
  end;

  if (FSearch.Text.Trim = '') and (LFolder = '') then
    FCount.Text := FVault.LiveCount.ToString + ' entrees'
  else
    FCount.Text := Length(FFiltered).ToString + ' / ' +
                   FVault.LiveCount.ToString;
end;

procedure TForm8.OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
begin
  if AItem <> nil then ShowDetail(AItem.Tag);
end;

{ ----------------------------------------------------------------------------
  Detail : reveler et copier
  ---------------------------------------------------------------------------- }

procedure TForm8.OnRevealTap(Sender: TObject);
var
  I: Integer;
begin
  Touch;
  if not (Sender is TButton) then Exit;
  I := TButton(Sender).Tag;
  if (I < 0) or (I > High(FRows)) then Exit;

  FRowShown[I] := not FRowShown[I];
  if FRowShown[I] then
  begin
    FRowValues[I].Text := FRows[I].Value;
    TButton(Sender).Text := 'Masquer';
  end
  else
  begin
    FRowValues[I].Text := MASK;
    TButton(Sender).Text := 'Afficher';
  end;
end;

procedure TForm8.OnCopyTap(Sender: TObject);
var
  I: Integer;
begin
  Touch;
  if not (Sender is TButton) then Exit;
  I := TButton(Sender).Tag;
  // -1 : la ligne du TOTP, qui n'est pas dans FRows - sa valeur change chaque
  // periode et ne vit que dans FTotpCode. Copie sans l'espace d'affichage.
  if I = -1 then
    CopyToClipboard(FTotpCode, 'Code 2FA')
  else if (I >= 0) and (I <= High(FRows)) then
    CopyToClipboard(FRows[I].Value, FRows[I].Caption);
end;

procedure TForm8.CopyToClipboard(const AText, ALabel: string);
begin
  if AText = '' then Exit;
  // Marque le contenu sensible : sans cela Android 13+ affiche un apercu de ce
  // qui vient d'etre copie, mot de passe compris, en clair et hors de
  // l'application.
  if not CopySensitive(AText) then Exit;
  FCopied := AText;
  // Reprogramme depuis zero : deux copies successives donnent au second
  // contenu son delai complet, pas le reste de celui du premier.
  FClipTimer.Enabled := False;
  FClipTimer.Enabled := True;
  // ponytail: le message reste jusqu'a la prochaine navigation, pas de minuterie
  // pour l'effacer. Un deuxieme TTimer pour deux secondes d'affichage serait
  // plus de code que ce que ca apporte.
  FDetToast.Text := ALabel + ' copie - presse-papiers efface dans ' +
                    CLIPBOARD_CLEAR_SECONDS.ToString + ' s';
end;

procedure TForm8.OnClipTimer(Sender: TObject);
begin
  FClipTimer.Enabled := False;
  if FCopied = '' then Exit;
  // Seulement si c'est TOUJOURS notre texte : l'utilisateur a pu copier autre
  // chose entre-temps, et le lui effacer serait une surprise.
  if CurrentClipboard = FCopied then ClearClipboard;
  FCopied := '';
end;

{ ----------------------------------------------------------------------------
  Cycle de vie
  ---------------------------------------------------------------------------- }

function TForm8.HandleAppEvent(AAppEvent: TApplicationEvent;
  AContext: TObject): Boolean;
begin
  Result := True;
  case AAppEvent of
    // WillBecomeInactive arrive AVANT la capture d'ecran des applications
    // recentes : masquer ici, c'est ne pas y laisser la liste des comptes.
    TApplicationEvent.WillBecomeInactive:
      if FLayList.Visible or FLayDetail.Visible then
      begin
        FLayDetail.Visible := False;
        FLayList.Visible := False;
        FLayUnlock.Visible := True;
      end;
    // Et le clair est reellement jete quand l'application passe derriere.
    TApplicationEvent.EnteredBackground:
      if FVault.Count > 0 then LockVault;
  end;
end;

{ ----------------------------------------------------------------------------
  Journal
  ---------------------------------------------------------------------------- }

procedure TForm8.Log(const AMsg: string);
begin
  // Appele depuis le thread de calcul : la mise a jour d'un controle FMX doit
  // repasser par le thread principal.
  TThread.Queue(nil,
    procedure
    begin
      FLog.Lines.Add(AMsg);
      FLog.GoToTextEnd;
    end);
end;

procedure TForm8.Touch;
begin
  FLastActivity := Now;
end;

procedure TForm8.OnIdleTimer(Sender: TObject);
begin
  // Rien d'ouvert : rien a verrouiller.
  if FVault.Count = 0 then
  begin
    FIdleTimer.Enabled := False;
    Exit;
  end;
  if MinutesBetween(Now, FLastActivity) >= AUTOLOCK_MINUTES then
  begin
    Log('Verrouille apres ' + AUTOLOCK_MINUTES.ToString + ' min d''inactivite');
    LockVault;
  end;
end;

procedure TForm8.Status(const AMsg: string);
begin
  FStatus.Text := AMsg;
end;

procedure TForm8.SetBusy(ABusy: Boolean);
begin
  FBusy := ABusy;
  FBtnSync.Enabled := not ABusy;
  FBtnOpen.Enabled := not ABusy;
end;

end.