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

  PLUS AUCUN CONTROLE FMX. Les trois ecrans - deverrouillage, liste, detail -
  sont une page HTML rendue par le moteur du systeme (PMA.WebUI,
  android-client/web). Cette unite ne tient plus que ce que la page ne peut pas
  atteindre : Keystore, biometrie, presse-papiers sensible, FLAG_SECURE, reseau
  et dechiffrement.

  Le dernier a partir a ete l'ecran de deverrouillage : dans un TEdit Android, le
  curseur ne se place pas ou on le touche, ce qui rend un jeton long
  incorrigible. Un champ du moteur herite de la saisie du systeme - curseur,
  selection, poignees, collage - sans qu'on ecrive une ligne.

  Le pont tient en deux gestes : evaluateJavascript pour descendre les donnees,
  et une navigation cmd:// interceptee pour remonter les actions. Aucun serveur
  local, donc aucun port ouvert sur l'appareil.

  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, FMX.Objects,
  FMX.WebBrowser,
  PMA.Vault;

const
  // VALEURS DE PREMIER LANCEMENT UNIQUEMENT. Des que l'appareil a enregistre
  // ses reglages, elles ne servent plus a rien : LoadDeviceSettings les
  // remplace. Rien de secret ne doit vivre ici - le jeton et le mot de passe
  // viennent du fichier local hors depot, plus bas.
  //
  // 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)}
  FIRSTRUN_URL = 'http://127.0.0.1:8080/server-php/sync.php';
{$ELSE}
  FIRSTRUN_URL = 'http://127.0.0.1/server-php/sync.php';
{$ENDIF}

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

  // Sursis avant de jeter le clair quand l'application passe derriere. Assez
  // pour aller coller un mot de passe ailleurs et revenir ; trop court pour
  // qu'un telephone repose ouvert.
  BACKGROUND_GRACE_SECONDS = 30;

// FIRSTRUN_TOKEN et TEST_PWD viennent d'un fichier LOCAL, hors depot : le
// jeton authentifie l'appareil, le mot de passe ouvre le coffre entier. Ni
// l'un ni l'autre n'a sa place dans un depot, meme sans remote. Absents apres
// un clone -> recopier PMA.LocalConfig.template.inc.
{$I android-client\PMA.LocalConfig.inc}

type
  TForm8 = class(TForm)
  private
    FVault: TVault;
    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;
    /// Le cache local a refuse de s'ouvrir pendant cette session. Il existe
    /// toujours - on ne detruit rien - mais l'interface cesse de proposer une
    /// ouverture qui ne peut pas aboutir, et nomme le telechargement pour ce
    /// qu'il est : un remplacement.
    FVaultUnreadable: 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;

    /// Coordonnees du serveur. Delphi en est le detenteur ; la page ne fait
    /// que les editer et les lui renvoyer quand un champ est quitte.
    FUrl, FToken, FPwd: string;

    // --- l'interface entiere, rendue par le moteur du systeme
    FLayWeb: TLayout;
    FWeb: TWebBrowser;
    /// La page n'accepte rien avant sa fin de chargement. Ce qui arrive trop
    /// tot attend ici plutot que de se perdre : au demarrage a froid, le
    /// coffre local s'ouvre souvent avant que le moteur ait fini.
    FWebReady: Boolean;
    FWebPending: TArray<string>;
    /// Ce que la page affiche, telle qu'elle le declare. Le bouton retour
    /// materiel en depend, et Delphi ne peut pas le deviner.
    FWebView: string;

    // --- TOTP : la seule ligne vivante, rafraichie chaque seconde
    FTotpTimer: TTimer;
    FTotpCode: string;

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

    /// ECHEANCE SUR UNE OPERATION RESEAU. Sans elle, un appel qui ne rend
    /// jamais la main laisse l'interface morte et muette : les deux actions
    /// restent desactivees, aucun message n'apparait, et rien n'y ramene -
    /// c'est arrive avec le serveur local arrete. Les delais de THTTPClient
    /// sont censes couvrir ce cas ; celui-ci couvre le jour ou ils ne le font
    /// pas, quelle qu'en soit la raison.
    FDeadline: TTimer;

    // --- verrouillage sur inactivite
    FIdleTimer: TTimer;
    FLastActivity: TDateTime;
    /// Quand l'application est passee derriere. 0 = elle est au premier plan.
    FBackgroundAt: TDateTime;
    procedure Touch;
    procedure OnIdleTimer(Sender: TObject);

    procedure ShowUnlock;
    procedure ShowList;
    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;


    // --- page HTML
    procedure BuildWeb;
    procedure OnWebLoaded(ASender: TObject);
    /// Appelee a chaque navigation du moteur. Les nôtres portent le schema
    /// cmd:// ; tout le reste est ignore.
    procedure OnWebNavigate(ASender: TObject; const AUrl: string);
    procedure HandleWebCommand(const AUrl: string);
    /// Envoie un appel a la page, ou le met en attente si elle n'est pas prete.
    procedure WebCall(const AJavaScript: string);
    procedure PushVault;
    procedure PushConfig;
    procedure OpenEntry(AVaultIndex: Integer);
    procedure OnClipTimer(Sender: TObject);
    procedure OnDeadline(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, PMA.Theme, PMA.WebUI, System.JSON;

{$R *.fmx}

/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
/// l'encodage JSON : une apostrophe ou un retour a la ligne dans un nom de
/// compte casserait sinon l'appel entier.
function JsArg(const AValue: string): string;
var
  LStr: TJSONString;
begin
  LStr := TJSONString.Create(AValue);
  try
    Result := LStr.ToJSON;
  finally
    LStr.Free;
  end;
end;

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

constructor TForm8.Create(AOwner: TComponent);
var
  LEvents: IFMXApplicationEventService;
begin
  inherited;
  Caption := 'Vault';
  // Le fond de la forme, et non celui du style : tout le reste est peint
  // par-dessus, et un gris herite se verrait entre les blocs.
  // Qualifie : TForm a deja une methode PaintBackground, sans parametre, qui
  // masque celle de l'unite.
  PMA.Theme.PaintBackground(Fill);
  // Les barres systeme prennent les deux extremites du degrade, pour que
  // l'ecran soit d'un seul tenant.
  TintSystemBars(COL_BG_TOP, COL_BG);
  SecureScreen;   // avant tout affichage de contenu
  FVault := TVault.Create;

  BuildWeb;

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

  // Plus long que les delais de THTTPClient (15 s), pour que le message precis
  // du client reseau arrive le premier quand il fonctionne. Celui-ci n'est que
  // le filet.
  FDeadline := TTimer.Create(Self);
  FDeadline.Enabled := False;
  FDeadline.Interval := 25000;
  FDeadline.OnTimer := OnDeadline;

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

  PushConfig;
  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
  FVault.Free;
  inherited;
end;

procedure TForm8.ShowUnlock;
var
  LCanOpen: Boolean;
begin
  FLayWeb.Visible := True;
  FWeb.Visible := True;
  WebCall('PM.showUnlock()');
  FWebView := 'unlock';

  // Le bouton d'ouverture n'a de sens que si un coffre local existe ET qu'il
  // s'est deja laisse ouvrir ; sinon seul le telechargement peut en produire
  // un utilisable.
  LCanOpen := HasVault and not FVaultUnreadable;
  if LCanOpen then
  begin
    if VaultNeedsAuth then
      Status('Vault on this device - protected')
    else
      Status('Vault on this device');
    WebCall('PM.setActions(true, "Sync", false)');
  end
  else
  begin
    Status('No local vault - first download');
    WebCall('PM.setActions(false, "Download vault", false)');
  end;
end;

procedure TForm8.ShowList;
begin
  FTotpTimer.Enabled := False;
  FLayWeb.Visible := True;
  FWeb.Visible := True;
  FWebView := 'list';
  PushVault;
end;

procedure TForm8.OnTotpTick(Sender: TObject);
var
  LLeft, LPeriod: Integer;
begin
  FTotpCode := TotpNow(FCurrent.Totp, LLeft, LPeriod);
  if FTotpCode = '' then
  begin
    // Un secret illisible ne doit pas passer pour un code : le dire.
    WebCall('PM.setTotp("unreadable secret", 0, 30)');
    FTotpTimer.Enabled := False;
    Exit;
  end;
  WebCall(Format('PM.setTotp("%s", %d, %d)', [FTotpCode, LLeft, LPeriod]));
end;

procedure TForm8.OnHardwareBack(Sender: TObject; var Key: Word;
  var KeyChar: WideChar; Shift: TShiftState);
begin
  if Key <> vkHardwareBack then Exit;
  if not FLayWeb.Visible then Exit;
  // C'est la PAGE qui sait ce qu'elle affiche - Delphi ne le devine pas. Elle
  // le declare a chaque changement de vue (cmd://state).
  if FWebView = 'detail' then
  begin
    WebCall('PM.back()');
    FWebView := 'list';
    Key := 0;   // consomme : sinon Android ferme l'application
  end
  else
  begin
    LockVault;
    Key := 0;
  end;
end;

{ ----------------------------------------------------------------------------
  La page : liste et detail
  ---------------------------------------------------------------------------- }

procedure TForm8.BuildWeb;
begin
  FLayWeb := TLayout.Create(Self);
  FLayWeb.Parent := Self;
  FLayWeb.Align := TAlignLayout.Client;
  // VISIBLE DES LE DEPART : la page porte maintenant l'ecran de
  // deverrouillage, donc il n'y a plus rien d'autre a montrer. Elle n'est
  // masquee qu'au passage en arriere-plan, pour ne pas laisser la liste des
  // comptes dans l'apercu des applications recentes.
  FLayWeb.Visible := True;

  FWeb := TWebBrowser.Create(Self);
  FWeb.Parent := FLayWeb;
  FWeb.Align := TAlignLayout.Client;
  FWeb.OnDidFinishLoad := OnWebLoaded;
  FWeb.OnShouldStartLoadWithRequest := OnWebNavigate;
  FWeb.LoadFromStrings(PageHtml, '');
end;

procedure TForm8.OnWebLoaded(ASender: TObject);
var
  LCall: string;
begin
  FWebReady := True;
  for LCall in FWebPending do
    FWeb.EvaluateJavaScript(LCall);
  SetLength(FWebPending, 0);
end;

/// Descend les coordonnees du serveur dans les champs de la page.
procedure TForm8.PushConfig;
var
  LUrl, LToken: string;
begin
  FUrl := FIRSTRUN_URL;
  FToken := FIRSTRUN_TOKEN;
  FPwd := TEST_PWD;
  // Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
  if LoadDeviceSettings(LUrl, LToken) then
  begin
    FUrl := LUrl;
    if LToken <> '' then FToken := LToken;
  end;
  WebCall(Format('PM.setConfig(%s, %s, %s, %s)',
    [JsArg(FUrl), JsArg(FToken), JsArg(FPwd),
     // Replier des champs vides revient a cacher la seule chose a faire.
     LowerCase(BoolToStr((FUrl = '') or (FToken = '') or (FPwd = ''), True))]));
end;

procedure TForm8.WebCall(const AJavaScript: string);
begin
  if FWebReady then
    FWeb.EvaluateJavaScript(AJavaScript)
  else
    FWebPending := FWebPending + [AJavaScript];
end;

procedure TForm8.PushVault;
begin
  WebCall('PM.setVault(' + JsArg(VaultToJson(FVault)) + ')');
end;

procedure TForm8.OpenEntry(AVaultIndex: Integer);
begin
  Touch;
  if (AVaultIndex < 0) or (AVaultIndex >= FVault.Count) then Exit;
  FCurrent := FVault.Entry(AVaultIndex);
  WebCall('PM.setDetail(' + JsArg(DetailToJson(FCurrent)) + ')');
  FTotpTimer.Enabled := FCurrent.Totp <> '';
  if FTotpTimer.Enabled then OnTotpTick(nil);   // pas d'attente d'une seconde
end;

procedure TForm8.OnWebNavigate(ASender: TObject; const AUrl: string);
begin
  // Le moteur navigue aussi pour charger la page elle-meme.
  if AUrl.StartsWith('cmd://') then HandleWebCommand(AUrl.Substring(6));
end;

procedure TForm8.HandleWebCommand(const AUrl: string);
var
  LAction, LQuery, LCaption, LValue: string;
  LParams: TStringList;
  LIdx: Integer;
  E: TVaultEntry;

  function Param(const AName: string): string;
  begin
    Result := LParams.Values[AName];
  end;

begin
  Touch;
  LAction := AUrl;
  LQuery := '';
  if LAction.Contains('?') then
  begin
    LQuery := LAction.Substring(LAction.IndexOf('?') + 1);
    LAction := LAction.Substring(0, LAction.IndexOf('?'));
  end;
  // Le moteur ajoute parfois une barre finale a une adresse sans chemin.
  LAction := LAction.TrimRight(['/']);

  LParams := TStringList.Create;
  try
    LParams.StrictDelimiter := True;
    LParams.Delimiter := '&';
    LParams.DelimitedText := LQuery;

    if LAction = 'touch' then
      Exit                                 // Touch a deja eu lieu plus haut

    else if LAction = 'state' then
      FWebView := Param('view')

    else if LAction = 'open' then
      OpenEntry(StrToIntDef(Param('i'), -1))

    else if LAction = 'lock' then
      LockVault

    // Les coordonnees du serveur, renvoyees quand un champ est quitte. Delphi
    // en reste le detenteur : la page n'est qu'un editeur, et rien ne les lui
    // redemande.
    else if LAction = 'cfg' then
    begin
      FUrl := TNetEncoding.URL.Decode(Param('u')).Trim;
      FToken := TNetEncoding.URL.Decode(Param('t')).Trim;
      FPwd := TNetEncoding.URL.Decode(Param('p'));
    end

    else if LAction = 'openvault' then
      DoOpenLocal(nil)

    else if LAction = 'sync' then
      DoSync(nil)

    else if LAction = 'copy' then
    begin
      // LES SECRETS NE TRANSITENT PAS PAR LE PONT. La page envoie un rang,
      // jamais une valeur : depuis la liste, un indice de coffre ; depuis le
      // detail, un rang de ligne. Delphi relit le clair chez lui.
      if Param('f') = 'totp' then
        CopyToClipboard(FTotpCode, '2FA code')
      else if Param('f') = 'row' then
      begin
        if DetailRowAt(FCurrent, StrToIntDef(Param('k'), -1), LCaption, LValue) then
          CopyToClipboard(LValue, LCaption);
      end
      else
      begin
        LIdx := StrToIntDef(Param('i'), -1);
        if (LIdx >= 0) and (LIdx < FVault.Count) then
        begin
          E := FVault.Entry(LIdx);
          if Param('f') = 'user' then CopyToClipboard(E.Username, 'Username')
          else if E.IsNote then CopyToClipboard(E.Password, 'Content')
          else CopyToClipboard(E.Password, 'Password');
        end;
      end;
    end;
  finally
    LParams.Free;
  end;
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;
  FTotpTimer.Enabled := False;
  FVault.Clear;
  // Le tas de la page detient des noms de comptes et, si une entree est
  // ouverte, ses valeurs. Masquer la vue ne les efface pas.
  WebCall('PM.wipe()');
  // Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
  // fait partie du verrouillage, pas de l'affichage.
  FCurrent := Default(TVaultEntry);
  PushConfig;
  ShowUnlock;
end;

procedure TForm8.AdoptVault(const APlainJson: string);
begin
  FVault.LoadFromJson(APlainJson);
  Log('  ' + FVault.LiveCount.ToString + ' entries, ' +
      FVault.TrashCount.ToString + ' in trash');
  FVaultUnreadable := False;
  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 FLayWeb.Visible then
    PushVault
  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;

    // LA PROTECTION RATTRAPE LE CACHE. Elle se decidait a l'ecriture seule,
    // et une ecriture n'arrive qu'avec un instantane nouveau : un cache pose
    // pendant que l'appareil n'avait pas de verrouillage restait en clair
    // indefiniment, meme apres en avoir remis un. On le rescelle ici, ou l'on
    // tient justement le clair.
    // Journalise le verdict MEME quand rien n'est fait : sans cette ligne, un
    // rescellement qui n'a pas lieu ne laisse aucune trace, et on ne sait pas
    // s'il a echoue ou s'il n'a jamais ete tente.
    if not VaultNeedsAuth then
      Log('Plain cache; device authentication available: ' +
          BoolToStr(BiometricAvailable, True) + ' ' + LastBiometricError);

    if (not VaultNeedsAuth) and BiometricAvailable then
    begin
      try
        // Cle NEUVE, obligatoirement : le changement qui vient de ramener la
        // protection a tres probablement invalide l'ancienne, et le
        // chiffrement ne saurait pas le voir - on scellerait un fichier
        // impossible a rouvrir.
        SaveVault(LPlain, LETag, LPwd, True, True);
        if VaultNeedsAuth then
          Log('Cache re-sealed under authentication')
        else
          Log('Re-seal refused: ' + LastStoreError);
      except
        on E: Exception do Log('Re-seal failed: ' + E.Message);
      end;
    end;

    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, FToken, FSyncPwd, True);
    except
      on E: Exception do
      begin
        // Un coffre local illisible se remplace, il ne se repare pas.
        Log('Local vault corrupt: ' + E.Message);
        ClearVault;
        PushConfig;
  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.
    FVaultUnreadable := True;
    PushConfig;
  ShowUnlock;
    Log('Local vault unreadable: ' + LastStoreError);
    Status('Local vault unreadable - see log');
  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('Authenticating...');
  AuthenticateThen('Unlock the vault',
    procedure(AOutcome: TBioOutcome)
    begin
      case AOutcome of
        boOK: OpenLocalNow;
        boCancelled: Status('Cancelled');
        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('Authentication unavailable at launch - cache kept');
            Log('  ' + LastBiometricError);
            Status('Authentication unavailable - try again');
          end
          else
          begin
            // ON N'EFFACE PLUS, MEME ICI. C'etait le dernier endroit ou
            // l'application detruisait le cache, sur la foi d'un verdict qui
            // s'est deja revele fragile aujourd'hui. Le garder ne coute que
            // quelques centaines de kilo-octets, et un telechargement le
            // remplace de toute facon. Desormais RIEN ne detruit le cache :
            // seule une ecriture reussie le remplace.
            FVaultUnreadable := True;
            Log('No usable protection on this device - vault kept but unreadable');
            Log('  ' + LastBiometricError);
            PushConfig;
  ShowUnlock;
            Status('Screen lock missing - download again to replace the cache');
          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('Authentication failed: ' + LastBiometricError);
        Status('Authentication failed');
      end;
    end);
end;

procedure TForm8.DoSync(Sender: TObject);
var
  LUrl, LTok, LPwd: string;
begin
  if FBusy then Exit;
  LUrl := FUrl;
  LTok := FToken;
  // Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
  // range qui ne convient plus.
  LPwd := FPwd;
  if LPwd = '' then LPwd := FSyncPwd;
  if LPwd = '' then
  begin
    Status('Sync password required');
    Exit;
  end;
  WebCall('PM.clearLog()');

  // MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait
  // qu'a un bouton pres : synchroniser reconstruit le coffre depuis le serveur
  // et l'affiche, ce qui revient exactement au meme resultat sans passer par
  // l'authentification. La condition est la presence d'un cache protege sur
  // cet appareil - c'est lui qui exprime le choix de l'utilisateur.
  //
  // MAIS SEULEMENT S'IL Y A UNE PORTE. Exiger une authentification que
  // l'appareil ne sait plus rendre enfermait l'utilisateur dehors : le cache
  // marque protege refusait de s'ouvrir, et le telechargement qui l'aurait
  // remplace etait bloque par la meme condition. Quand plus rien ne peut
  // authentifier, ce verrou ne protege personne - le contenu viendra du
  // serveur, et c'est le mot de passe de sync qui le garde.
  if VaultNeedsAuth and (FVault.Count = 0) and BiometricAvailable then
  begin
    Status('Authenticating...');
    AuthenticateThen('Unlock the vault',
      procedure(AOutcome: TBioOutcome)
      begin
        if AOutcome = boOK then
          FetchAndDecrypt(LUrl, LTok, LPwd)
        else
        begin
          Log('Sync refused: ' + LastBiometricError);
          Status('Authentication required');
        end;
      end);
    Exit;
  end;

  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('Downloading...');
  // 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 + ' in ' +
            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: unchanged, vault already open')
                  else if LCached <> '' then
                  begin
                    Log('  304: unchanged, vault served from cache');
                    try
                      AdoptVault(LCached);
                    except
                      on E: Exception do Status('Cache unreadable: ' + 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('No cache - tap again to download');
                  end;
                end);
              Exit;
            end;
          ssNoSnapshot:
            begin
              // Le serveur repond pareil dans les deux cas, par conception.
              Log('  404: no snapshot OR invalid token');
              if not ASilent then
                TThread.Queue(nil, procedure
                  begin Status('Nothing to download (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('  failed: ' + LRes.Error);
              if not ASilent then
                TThread.Queue(nil, procedure
                  begin Status('Network failure'); end);
              Exit;
            end;
        end;

        Log('  received ' + Length(LRes.Container).ToString + ' bytes');
        if not ASilent then
          TThread.Queue(nil, procedure begin Status('Decrypting...'); 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('  decrypted in ' + 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);
          // Ce qui vient de fonctionner merite d'etre retenu : on n'enregistre
          // pas des reglages saisis, on enregistre des reglages EPROUVES.
          SaveDeviceSettings(AUrl, ATok);
          if VaultNeedsAuth then
            Log('  cache written - protected by biometrics/PIN')
          else if LCanAuth then
            Log('  cache written - plain key (Keystore refused the constraint)')
          else
            Log('  cache written - NO protection: no authentication here');
        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 not written: ' + 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('Snapshot unreadable: ' + E.Message);
            end;
          end);
      except
        on E: Exception do
        begin
          Log('ERROR ' + 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('Failed - wrong sync password?'); 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.
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;
  WebCall('PM.toast(' + JsArg(ALabel + ' copied - clipboard cleared in ' +
    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.
    // Le masquage est IMMEDIAT et sans condition - c'est lui qui protege.
    TApplicationEvent.WillBecomeInactive:
      if FWebView <> 'unlock' then
      begin
        FWeb.Visible := False;
        FLayWeb.Visible := False;
      end;

    // Le clair, lui, survit a un bref passage en arriere-plan.
    //
    // Verrouiller instantanement rendait le geste le plus courant penible :
    // copier un mot de passe, basculer pour le coller, revenir - et devoir se
    // reauthentifier, avec le code 2FA de nouveau derriere une invite. L'ecran
    // etant deja masque, garder le clair quelques secondes de plus n'expose
    // rien de visible ; c'est le temps d'un aller-retour, pas d'un oubli.
    TApplicationEvent.EnteredBackground:
      FBackgroundAt := Now;

    TApplicationEvent.BecameActive:
      if FVault.Count > 0 then
      begin
        if (FBackgroundAt > 0) and
           (SecondsBetween(Now, FBackgroundAt) >= BACKGROUND_GRACE_SECONDS) then
          LockVault
        else
        begin
          // Retour a temps : on rend l'ecran quitte, pas un autre. La page a
          // garde son etat, elle n'a ete que masquee.
          FLayWeb.Visible := True;
          FWeb.Visible := True;
          Touch;
        end;
        FBackgroundAt := 0;
      end;
  end;
end;

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

procedure TForm8.Log(const AMsg: string);
begin
  // Appele depuis le thread de calcul : le moteur ne se pilote que depuis le
  // thread principal.
  TThread.Queue(nil,
    procedure
    begin
      WebCall('PM.log(' + JsArg(AMsg) + ')');
    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('Locked after ' + AUTOLOCK_MINUTES.ToString + ' min idle');
    LockVault;
  end;
end;

procedure TForm8.Status(const AMsg: string);
begin
  WebCall('PM.setStatus(' + JsArg(AMsg) + ')');
end;

procedure TForm8.SetBusy(ABusy: Boolean);
var
  LCanOpen: Boolean;
  LLabel: string;
begin
  FBusy := ABusy;
  FDeadline.Enabled := False;   // reposee a zero, pas prolongee
  FDeadline.Enabled := ABusy;
  LCanOpen := HasVault and not FVaultUnreadable;
  // L'intitule suit l'etat du cache et non un mot fixe : sans coffre local,
  // l'action n'est pas une synchronisation mais un premier telechargement, et
  // le reprendre en dur ici effacait cette distinction a chaque passage.
  if LCanOpen then LLabel := 'Sync' else LLabel := 'Download vault';
  WebCall(Format('PM.setActions(%s, %s, %s)',
    [LowerCase(BoolToStr(LCanOpen, True)), JsArg(LLabel),
     LowerCase(BoolToStr(ABusy, True))]));
end;

/// L'operation reseau n'a pas rendu la main dans le delai. On rend l'interface
/// a l'utilisateur et on le dit. Le thread, lui, est ABANDONNE : il mourra
/// quand sa socket finira par echouer, et s'il aboutit malgre tout, son
/// resultat s'affichera - il n'y a rien a annuler.
procedure TForm8.OnDeadline(Sender: TObject);
begin
  FDeadline.Enabled := False;
  if not FBusy then Exit;
  Log('  no reply after ' + (FDeadline.Interval div 1000).ToString +
      ' s - request abandoned');
  Status('No reply from the server');
  SetBusy(False);
end;

end.