Password-Manager/mainApk.pas

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

  DEUX MOITIES. Le deverrouillage est en FMX - il touche a la biometrie et au
  Keystore, et tient en trois boutons. La liste et le detail sont une page
  HTML rendue par le moteur du systeme (PMA.WebUI, android-client/web) : les
  gabarits FMX se sont montres trop incertains sur mobile, et le moteur met en
  forme l'arabe correctement sans qu'on ait rien a faire.

  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;

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

    // --- ecrans 2 et 3 : liste et detail, rendus 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;

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

    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;

    procedure OnToggleSettings(Sender: TObject);
    procedure OnToggleLog(Sender: TObject);

    // --- 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 OpenEntry(AVaultIndex: Integer);
    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, PMA.Theme, PMA.WebUI, System.JSON;

{$R *.fmx}

const
  // Pictogrammes des boutons, EN POINTS DE CODE : ce fichier n'a pas de marque
  // d'ordre d'octets, Delphi le lit en ANSI, et un caractere ecrit tel quel y
  // deviendrait deux ou trois glyphes. Tous choisis dans le plan de base et
  // parmi les plus courants - une police systeme qui n'en aurait pas
  // afficherait un rectangle vide, ce qui se verrait tout de suite.
  GLYPH_OPEN = #$279C;   // fleche pleine
  GLYPH_SYNC = #$21BB;   // fleche circulaire
  GLYPH_GEAR = #$2699;   // engrenage
  GLYPH_LOG  = #$2261;   // trois traits

{ ----------------------------------------------------------------------------
  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;
  BuildUnlock;   // cree en dernier a l'ecran = au-dessus de la page

  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
  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 = 52; APrimary: Boolean = False): TRectangle;
begin
  Result := FlatButton(AParent, AText, AOnClick, APrimary);
  Result.Align := TAlignLayout.Top;
  Result.Margins.Rect := RectF(16, 8, 16, 0);
  Result.Height := AHeight;
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;
var
  LUrl, LToken: string;
  LRow: TLayout;
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;
  // Masque par defaut : il ne sert qu'au diagnostic, et il occupait un tiers
  // de l'ecran a chaque lancement. Le bouton Journal le ramene.
  FLog.Visible := False;

  // --- du bas vers le haut (voir TopButton)
  FLaySettings := TLayout.Create(Self);
  FLaySettings.Parent := FLayUnlock;
  FLaySettings.Align := TAlignLayout.Top;
  FLaySettings.Height := 174;
  // Les trois vont ensemble : ce sont les coordonnees du serveur, dont le mot
  // de passe fait partie. Il occupait l'ecran d'accueil en permanence alors
  // qu'on n'y touche qu'une fois. TopEdit empile du bas vers le haut, d'ou
  // l'ordre inverse ici.
  FPwd   := TopEdit(FLaySettings, 'sync password', TEST_PWD, True);
  FToken := TopEdit(FLaySettings, 'bearer token', FIRSTRUN_TOKEN);
  FUrl   := TopEdit(FLaySettings, 'endpoint URL', FIRSTRUN_URL);
  FPwd.Margins.Rect := RectF(16, 8, 16, 0);
  FToken.Margins.Rect := RectF(16, 8, 16, 0);
  FUrl.Margins.Rect := RectF(16, 8, 16, 0);
  // Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
  if LoadDeviceSettings(LUrl, LToken) then
  begin
    FUrl.Text := LUrl;
    if LToken <> '' then FToken.Text := LToken;
  end;
  // Replier des champs vides revient a cacher la seule chose a faire.
  FLaySettings.Visible := (FUrl.Text.Trim = '') or (FToken.Text.Trim = '')
    or (FPwd.Text = '');

  // Deux commandes discretes cote a cote : elles ne servent qu'au reglage et
  // au diagnostic, et n'ont pas a peser autant que les actions principales.
  LRow := TLayout.Create(Self);
  LRow.Parent := FLayUnlock;
  LRow.Align := TAlignLayout.Top;
  LRow.Height := 48;
  LRow.Margins.Rect := RectF(16, 8, 16, 0);

  FBtnLog := FlatButton(LRow, GLYPH_LOG + '  Log', OnToggleLog);
  FBtnLog.Align := TAlignLayout.Right;
  FBtnLog.Width := 120;
  FBtnLog.Margins.Left := 8;

  FBtnSettings := FlatButton(LRow, GLYPH_GEAR + '  Server settings', OnToggleSettings);
  FBtnSettings.Align := TAlignLayout.Client;

  FBtnSync := TopButton(FLayUnlock, GLYPH_SYNC + '  Sync', DoSync);
  // Accentue : c'est l'action attendue quand aucun coffre n'est encore la.
  FBtnOpen := TopButton(FLayUnlock, GLYPH_OPEN + '  Open vault', DoOpenLocal, 52, True);

  FStatus := TLabel.Create(Self);
  FStatus.Parent := FLayUnlock;
  FStatus.Align := TAlignLayout.Top;
  FStatus.Margins.Rect := RectF(16, 24, 16, 4);
  FStatus.Height := 26;
  Tint(FStatus, 15, True);
end;

procedure TForm8.ShowUnlock;
begin
  // La vue du moteur est une vraie vue du systeme : elle se peint PAR-DESSUS
  // tout ce que FMX dessine. Masquer le conteneur ne suffit pas toujours -
  // masquer les deux, si.
  FWeb.Visible := False;
  FLayWeb.Visible := False;
  FLayUnlock.Visible := True;

  // 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.
  FBtnOpen.Visible := HasVault and not FVaultUnreadable;
  if HasVault and not FVaultUnreadable then
  begin
    if VaultNeedsAuth then
      Status('Vault on this device - protected')
    else
      Status('Vault on this device');
    SetButtonText(FBtnSync, GLYPH_SYNC + '  Sync');
  end
  else
  begin
    Status('No local vault - first download');
    SetButtonText(FBtnSync, GLYPH_SYNC + '  Download vault');
  end;
end;

procedure TForm8.ShowList;
begin
  FTotpTimer.Enabled := False;
  FLayUnlock.Visible := 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;

procedure TForm8.OnToggleSettings(Sender: TObject);
begin
  FLaySettings.Visible := not FLaySettings.Visible;
  // Sa place doit etre REPOSEE a chaque apparition : cree masque, FMX le
  // replace en tete de la pile quand il devient visible, et les deux champs
  // se retrouvaient au-dessus du titre. Index 0 le renvoie en bas, juste
  // au-dessus du journal, ou on attend des reglages.
  if FLaySettings.Visible then FLaySettings.Index := 0;
end;

procedure TForm8.OnToggleLog(Sender: TObject);
begin
  FLog.Visible := not FLog.Visible;
end;

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

procedure TForm8.BuildWeb;
begin
  FLayWeb := TLayout.Create(Self);
  FLayWeb.Parent := Self;
  FLayWeb.Align := TAlignLayout.Client;
  FLayWeb.Visible := False;

  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;

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

/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
/// l'encodage JSON : un 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;

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

    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);
  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.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('Local vault corrupt: ' + 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.
    FVaultUnreadable := True;
    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);
            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;
  // 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('Sync password required');
    Exit;
  end;
  FLog.Lines.Clear;

  // 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 FLayWeb.Visible then
      begin
        FWeb.Visible := False;
        FLayWeb.Visible := False;
        FLayUnlock.Visible := True;
      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.
          FLayUnlock.Visible := False;
          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 : 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('Locked after ' + AUTOLOCK_MINUTES.ToString + ' min idle');
    LockVault;
  end;
end;

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

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

end.