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,
  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;

// 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
  TForm8 = class(TForm)
  private
    FVault: TVault;
    FFiltered: TArray<Integer>;   // indices dans FVault, resultat de la recherche
    FCurrent: TVaultEntry;
    FPwdShown: Boolean;
    // 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;

    // --- 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;
    FList: TListBox;
    FCount: TLabel;

    // --- ecran 3 : detail
    FLayDetail: TLayout;
    FDetTitle: TLabel;
    FDetSite, FDetUser, FDetPwd, FDetMeta, FDetToast: TLabel;
    FBtnReveal: TButton;

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

    procedure BuildUnlock;
    procedure BuildList;
    procedure BuildDetail;

    procedure ShowUnlock;
    procedure ShowList;
    procedure ShowDetail(AVaultIndex: Integer);

    procedure DoOpenLocal(Sender: TObject);
    // 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);
    procedure FetchAndDecrypt(const AUrl, ATok, APwd: string);
    procedure AdoptVault(const APlainJson: string);
    procedure LockVault;

    procedure OnSearchChanged(Sender: TObject);
    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;

{$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';
  FVault := TVault.Create;

  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;

  // 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;
end;

destructor TForm8.Destroy;
begin
  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;
  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: 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;

  FSearch := TEdit.Create(Self);
  FSearch.Parent := FLayList;
  FSearch.Align := TAlignLayout.Top;
  FSearch.Margins.Rect := RectF(8, 8, 8, 8);
  FSearch.TextPrompt := 'Rechercher';
  FSearch.OnChangeTracking := OnSearchChanged;
end;

/// Une ligne du detail : intitule discret, valeur, bouton Copier.
/// ATag porte ce qu'il faut copier (1 site, 2 identifiant, 3 mot de passe).
function DetailRow(AParent: TFmxObject; const ACaption: string; ATag: Integer;
  AOnCopy: TNotifyEvent; out AValue: TLabel): TLayout;
var
  LCap: TLabel;
  LBtn: TButton;
begin
  Result := TLayout.Create(AParent);
  Result.Parent := AParent;
  Result.Align := TAlignLayout.Top;
  Result.Height := 62;
  Result.Margins.Rect := RectF(12, 10, 12, 0);

  // Pas de bouton sur une ligne purement informative (dossier, etiquettes) :
  // un "Copier" inerte se clique quand meme.
  if Assigned(AOnCopy) then
  begin
    LBtn := TButton.Create(Result);
    LBtn.Parent := Result;
    LBtn.Align := TAlignLayout.Right;
    LBtn.Width := 90;
    LBtn.Text := 'Copier';
    LBtn.Tag := ATag;
    LBtn.OnClick := AOnCopy;
  end;

  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;

procedure TForm8.BuildDetail;
var
  LRowPwd: TLayout;
  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;

  // Du bas vers le haut : dossier/tags, mot de passe, identifiant, site, titre.
  DetailRow(FLayDetail, 'Dossier / etiquettes', 0, nil, FDetMeta);

  LRowPwd := DetailRow(FLayDetail, 'Mot de passe', 3, OnCopyTap, FDetPwd);
  FBtnReveal := TButton.Create(LRowPwd);
  FBtnReveal.Parent := LRowPwd;
  FBtnReveal.Align := TAlignLayout.Right;
  FBtnReveal.Margins.Right := 6;
  FBtnReveal.Width := 90;
  FBtnReveal.Text := 'Afficher';
  FBtnReveal.OnClick := OnRevealTap;

  DetailRow(FLayDetail, 'Identifiant', 2, OnCopyTap, FDetUser);
  DetailRow(FLayDetail, 'Site', 1, OnCopyTap, FDetSite);

  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
  FLayUnlock.Visible := False;
  FLayDetail.Visible := False;
  FLayList.Visible := True;
  FSearch.Text := '';
  OnSearchChanged(nil);
end;

procedure TForm8.ShowDetail(AVaultIndex: Integer);
var
  LMeta: string;
begin
  FCurrent := FVault.Entry(AVaultIndex);
  FPwdShown := False;

  FDetTitle.Text := FCurrent.Display;
  FDetSite.Text  := FCurrent.Site;
  FDetUser.Text  := FCurrent.Username;
  FDetPwd.Text   := MASK;
  FDetToast.Text := '';
  FBtnReveal.Text := 'Afficher';

  LMeta := FCurrent.Folder;
  if FCurrent.Tags <> '' then
  begin
    if LMeta <> '' then LMeta := LMeta + '  -  ';
    LMeta := LMeta + FCurrent.Tags;
  end;
  FDetMeta.Text := LMeta;

  FLayList.Visible := False;
  FLayDetail.Visible := True;
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 := '';
  FVault.Clear;
  FList.Clear;
  FCurrent := Default(TVaultEntry);
  FDetPwd.Text := MASK;
  FPwdShown := False;
  ShowUnlock;
end;

procedure TForm8.AdoptVault(const APlainJson: string);
begin
  FVault.LoadFromJson(APlainJson);
  Log('  ' + FVault.LiveCount.ToString + ' entrees, ' +
      FVault.TrashCount.ToString + ' en corbeille');
  ShowList;
end;

procedure TForm8.OpenLocalNow;
var
  LPlain, LETag: string;
begin
  if LoadVault(LPlain, LETag) then
  begin
    FETag := LETag;
    try
      AdoptVault(LPlain);
    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
    Status('Coffre local illisible - retelechargement necessaire');
    ShowUnlock;
  end;
end;

procedure TForm8.DoOpenLocal(Sender: TObject);
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;

  Status('Authentification...');
  AuthenticateThen('Acceder au coffre',
    procedure(AOutcome: TBioOutcome)
    begin
      case AOutcome of
        boOK: OpenLocalNow;
        boCancelled: Status('Annule');
        boUnavailable:
          begin
            // La protection a ete retiree de l'appareil depuis l'ecriture du
            // cache : celui-ci est devenu illisible pour toujours.
            Log('Plus aucune protection sur l''appareil - cache efface');
            ClearVault;
            ShowUnlock;
          end;
      else
        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;
  LPwd := FPwd.Text;
  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);
begin
  SetBusy(True);
  Status('Telechargement...');
  TThread.CreateAnonymousThread(
    procedure
    var
      LClient: TSyncClient;
      LRes: TSyncResult;
      LPlain, LCached, LCachedETag: 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) 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
                  begin
                    Log('  304 : inchange, coffre deja ouvert');
                    ShowList;
                  end
                  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 := '';
                    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');
              TThread.Queue(nil, procedure
                begin Status('Rien a telecharger (404)'); end);
              Exit;
            end;
          ssRefused, ssHttpError, ssNetworkError:
            begin
              Log('  echec : ' + LRes.Error);
              TThread.Queue(nil, procedure
                begin Status('Echec reseau'); end);
              Exit;
            end;
        end;

        Log('  recu ' + Length(LRes.Container).ToString + ' octets');
        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
          // True : on DEMANDE la protection par authentification. PMA.Store
          // retombe tout seul sur une cle simple si l'appareil n'a ni
          // empreinte ni code, plutot que de renoncer au cache.
          SaveVault(LPlain, FETag, True);
          if VaultNeedsAuth then
            Log('  cache ecrit - protege par biometrie/code')
          else
            Log('  cache ecrit - AUCUNE protection sur cet appareil');
        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
            try
              AdoptVault(LPlain);
            except
              on E: Exception do 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.
          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
  ---------------------------------------------------------------------------- }

procedure TForm8.OnSearchChanged(Sender: TObject);
var
  I: Integer;
  LItem: TListBoxItem;
  E: TVaultEntry;
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.
  FFiltered := FVault.Search(FSearch.Text);

  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';
      LItem.Tag := FFiltered[I];   // indice dans le coffre, pas dans la liste
    end;
  finally
    FList.EndUpdate;
  end;

  if FSearch.Text.Trim = '' 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);
begin
  FPwdShown := not FPwdShown;
  if FPwdShown then
  begin
    FDetPwd.Text := FCurrent.Password;
    FBtnReveal.Text := 'Masquer';
  end
  else
  begin
    FDetPwd.Text := MASK;
    FBtnReveal.Text := 'Afficher';
  end;
end;

procedure TForm8.OnCopyTap(Sender: TObject);
begin
  if not (Sender is TButton) then Exit;
  case TButton(Sender).Tag of
    1: CopyToClipboard(FCurrent.Site, 'Site');
    2: CopyToClipboard(FCurrent.Username, 'Identifiant');
    3: CopyToClipboard(FCurrent.Password, 'Mot de passe');
  end;
end;

procedure TForm8.CopyToClipboard(const AText, ALabel: string);
var
  LClip: IFMXClipboardService;
begin
  if AText = '' then Exit;
  if not TPlatformServices.Current.SupportsPlatformService(
           IFMXClipboardService, LClip) then Exit;
  LClip.SetClipboard(AText);
  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);
var
  LClip: IFMXClipboardService;
begin
  FClipTimer.Enabled := False;
  if FCopied = '' then Exit;
  if TPlatformServices.Current.SupportsPlatformService(
       IFMXClipboardService, LClip) then
    // Seulement si c'est TOUJOURS notre texte : l'utilisateur a pu copier
    // autre chose entre-temps, et le lui effacer serait une surprise.
    if LClip.GetClipboard.ToString = FCopied then
      LClip.SetClipboard('');
  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.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.