r-zakarya
27a7a322d6
Not the desktop's slate any more: a blue gradient behind, blocks that are only translucent white laid over it, no borders at all, wide radii, white text. Depth comes from transparency, which is why the frames are gone - a hairline reads as a desktop application immediately. There is no coloured accent in the reference either: primary and secondary differ by how much white they carry, 30 against 18 per cent. The 2FA code goes white, carried by its size. Nothing is uppercase - the second plane is marked by colour and size alone. Three compiler traps on the way, all worth knowing: TBrush needs FMX.Graphics in the INTERFACE clause, a fresh TGradient already runs top to bottom, and TForm already owns a parameterless PaintBackground that shadowed the unit's. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1676 lines
59 KiB
ObjectPascal
1676 lines
59 KiB
ObjectPascal
unit mainApk;
|
|
{
|
|
Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
|
|
|
|
Trois ecrans dans une seule forme, montres a tour de role - une forme par
|
|
ecran couterait un fichier .fmx chacun pour trois dispositions triviales.
|
|
|
|
1. Deverrouillage : ouvre le coffre local (biometrie), ou telecharge le
|
|
conteneur et le dechiffre si l'appareil n'en a pas encore.
|
|
2. Liste : recherche + entrees.
|
|
3. Detail : les champs d'une entree, mot de passe masque.
|
|
|
|
DEUX REGLES DE SURETE tenues ici, pas ailleurs :
|
|
- le coffre en clair est EFFACE des que l'application passe en arriere-plan
|
|
(sinon il reste dans l'apercu des applications recentes) ;
|
|
- le presse-papiers est VIDE apres un delai, et seulement si son contenu
|
|
est toujours celui qu'on y a mis.
|
|
|
|
L'ecriture n'existe pas : le poste Windows reste la source. Modifier ici
|
|
demanderait le PUT cote serveur et une fusion cote client.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
|
System.Diagnostics, System.Rtti, System.NetEncoding, System.DateUtils,
|
|
System.Generics.Collections,
|
|
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform,
|
|
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
|
|
FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox, FMX.Objects,
|
|
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
|
|
/// Une ligne du detail, avant tout controle. Site, identifiant, mot de
|
|
/// passe et champs personnalises se ramenent tous a la meme chose : un
|
|
/// intitule, une valeur, et le fait qu'elle soit secrete ou non. Les traiter
|
|
/// separement dupliquerait revelation et copie quatre fois.
|
|
TDetRow = record
|
|
Caption, Value: string;
|
|
Secret: Boolean;
|
|
end;
|
|
|
|
TForm8 = class(TForm)
|
|
private
|
|
FVault: TVault;
|
|
FFiltered: TArray<Integer>; // indices dans FVault, resultat de la recherche
|
|
FCurrent: TVaultEntry;
|
|
// L'ETag n'est conserve QUE si le dechiffrement qui a suivi a reussi :
|
|
// envoyer If-None-Match sans detenir le clair correspondant fait
|
|
// economiser un telechargement pour se retrouver sans donnees.
|
|
FETag: string;
|
|
FBusy: Boolean;
|
|
/// 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;
|
|
|
|
// --- ecran 2 : liste
|
|
FLayList: TLayout;
|
|
FSearch: TEdit;
|
|
FSearchHint: TLabel;
|
|
FSearchClear: TRectangle;
|
|
/// Choix du dossier : un bouton peint, et un panneau de selection montre
|
|
/// a la demande. FFolders[0] est toujours « tous les dossiers ».
|
|
FBtnFolder: TRectangle;
|
|
FFolderPanel: TRectangle;
|
|
FFolderNames: TArray<string>;
|
|
FFolderSel: Integer;
|
|
FList: TListBox;
|
|
FCount: TLabel;
|
|
/// Icones decodees une fois par coffre, pas a chaque frappe : la liste est
|
|
/// reconstruite a chaque caractere tape, et decoder du PNG a ce rythme se
|
|
/// voit. Cle = indice dans le coffre.
|
|
FIcons: TObjectDictionary<Integer, TBitmap>;
|
|
|
|
// --- ecran 3 : detail
|
|
// Les lignes sont construites PAR ENTREE : leur nombre depend des champs
|
|
// personnalises. On garde de quoi les detruire et de quoi retrouver
|
|
// l'etiquette de valeur d'une ligne pour la reveler.
|
|
FLayDetail: TLayout;
|
|
FDetBody: TVertScrollBox;
|
|
FDetTitle, FDetToast: TLabel;
|
|
FRows: TArray<TDetRow>;
|
|
FRowCtls: TArray<TLayout>;
|
|
FRowValues: TArray<TLabel>;
|
|
FRowShown: TArray<Boolean>;
|
|
|
|
// --- TOTP : une ligne vivante, rafraichie chaque seconde
|
|
FTotpTimer: TTimer;
|
|
FTotpValue: TLabel;
|
|
FTotpBar: TRectangle;
|
|
FTotpCode: string;
|
|
|
|
// --- presse-papiers
|
|
FClipTimer: TTimer;
|
|
FCopied: string;
|
|
|
|
// --- verrouillage sur inactivite
|
|
FIdleTimer: TTimer;
|
|
FLastActivity: TDateTime;
|
|
/// Quand l'application est passee derriere, et quel ecran elle a quitte.
|
|
/// 0 = elle est au premier plan.
|
|
FBackgroundAt: TDateTime;
|
|
FHiddenOnDetail: Boolean;
|
|
procedure Touch;
|
|
procedure OnIdleTimer(Sender: TObject);
|
|
|
|
procedure BuildUnlock;
|
|
procedure BuildList;
|
|
procedure BuildDetail;
|
|
|
|
procedure ShowUnlock;
|
|
procedure ShowList;
|
|
procedure ShowDetail(AVaultIndex: Integer);
|
|
procedure ClearDetailRows;
|
|
procedure OnTotpTick(Sender: TObject);
|
|
|
|
procedure DoOpenLocal(Sender: TObject);
|
|
/// AAuto : declenche par l'ouverture automatique au lancement, pas par
|
|
/// l'utilisateur. Une action automatique ne detruit jamais le cache.
|
|
procedure OpenVault(AAuto: Boolean);
|
|
// Separee de DoOpenLocal : une methode anonyme ne peut pas appeler une
|
|
// procedure imbriquee (E2555), et le rappel de la biometrie en est une.
|
|
procedure OpenLocalNow;
|
|
procedure DoSync(Sender: TObject);
|
|
/// ASilent : rafraichissement de fond. Le coffre local est deja affiche,
|
|
/// donc un echec reseau ne doit rien reclamer a l'utilisateur - il garde
|
|
/// ce qu'il a. Seul un instantane NOUVEAU se voit.
|
|
procedure FetchAndDecrypt(const AUrl, ATok, APwd: string;
|
|
ASilent: Boolean = False);
|
|
procedure AdoptVault(const APlainJson: string);
|
|
procedure LockVault;
|
|
|
|
procedure OnSearchChanged(Sender: TObject);
|
|
procedure OnSearchClear(Sender: TObject);
|
|
procedure OnFolderTap(Sender: TObject);
|
|
procedure OnFolderPick(Sender: TObject);
|
|
procedure PopulateFolders;
|
|
procedure RebuildIcons;
|
|
procedure OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
|
|
procedure OnRevealTap(Sender: TObject);
|
|
procedure OnCopyTap(Sender: TObject);
|
|
procedure OnBackTap(Sender: TObject);
|
|
procedure OnToggleSettings(Sender: TObject);
|
|
procedure OnToggleLog(Sender: TObject);
|
|
procedure OnClipTimer(Sender: TObject);
|
|
procedure OnHardwareBack(Sender: TObject; var Key: Word;
|
|
var KeyChar: WideChar; Shift: TShiftState);
|
|
|
|
procedure CopyToClipboard(const AText, ALabel: string);
|
|
function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
|
|
procedure Log(const AMsg: string);
|
|
procedure Status(const AMsg: string);
|
|
procedure SetBusy(ABusy: Boolean);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
var
|
|
Form8: TForm8;
|
|
|
|
implementation
|
|
|
|
uses
|
|
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
|
|
PMA.ScreenGuard, PMA.Clipboard, PMA.Theme;
|
|
|
|
{$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 := '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);
|
|
SecureScreen; // avant tout affichage de contenu
|
|
FVault := TVault.Create;
|
|
FIcons := TObjectDictionary<Integer, TBitmap>.Create([doOwnsValues]);
|
|
|
|
BuildDetail; // cree en dernier a l'ecran = au-dessus des autres
|
|
BuildList;
|
|
BuildUnlock;
|
|
|
|
FClipTimer := TTimer.Create(Self);
|
|
FClipTimer.Enabled := False;
|
|
FClipTimer.Interval := CLIPBOARD_CLEAR_SECONDS * 1000;
|
|
FClipTimer.OnTimer := OnClipTimer;
|
|
|
|
FTotpTimer := TTimer.Create(Self);
|
|
FTotpTimer.Enabled := False;
|
|
FTotpTimer.Interval := 1000;
|
|
FTotpTimer.OnTimer := OnTotpTick;
|
|
|
|
// Tick grossier : on compare des horodatages, il ne sert qu'a echantillonner.
|
|
// Une seconde de precision n'apporterait rien et reveillerait l'appareil.
|
|
FIdleTimer := TTimer.Create(Self);
|
|
FIdleTimer.Enabled := False;
|
|
FIdleTimer.Interval := 15000;
|
|
FIdleTimer.OnTimer := OnIdleTimer;
|
|
|
|
// Le bouton retour materiel arrive comme une touche : sans ce gestionnaire
|
|
// il ferme l'application depuis le detail, au lieu de revenir a la liste.
|
|
OnKeyUp := OnHardwareBack;
|
|
|
|
if TPlatformServices.Current.SupportsPlatformService(
|
|
IFMXApplicationEventService, LEvents) then
|
|
LEvents.SetApplicationEventHandler(HandleAppEvent);
|
|
|
|
ShowUnlock;
|
|
|
|
// Ouverture automatique du coffre local. Differee apres la construction :
|
|
// l'invite biometrique s'afficherait sinon avant la premiere peinture de la
|
|
// fenetre, sur un fond vide.
|
|
if HasVault then
|
|
TThread.ForceQueue(nil, procedure begin OpenVault(True); end);
|
|
end;
|
|
|
|
destructor TForm8.Destroy;
|
|
begin
|
|
FIcons.Free;
|
|
FVault.Free;
|
|
inherited;
|
|
end;
|
|
|
|
/// Cree un bouton empile en haut. En FMX, des controles alignes en haut
|
|
/// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en
|
|
/// haut. Chaque Build* cree donc du bas vers le haut.
|
|
function TopButton(AParent: TFmxObject; const AText: string;
|
|
AOnClick: TNotifyEvent; AHeight: Single = 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 := 116;
|
|
FLaySettings.Visible := False;
|
|
FToken := TopEdit(FLaySettings, 'bearer token', FIRSTRUN_TOKEN);
|
|
FUrl := TopEdit(FLaySettings, 'endpoint URL', FIRSTRUN_URL);
|
|
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;
|
|
|
|
// 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, 'Log', OnToggleLog);
|
|
FBtnLog.Align := TAlignLayout.Right;
|
|
FBtnLog.Width := 120;
|
|
FBtnLog.Margins.Left := 8;
|
|
|
|
FBtnSettings := FlatButton(LRow, 'Server settings', OnToggleSettings);
|
|
FBtnSettings.Align := TAlignLayout.Client;
|
|
|
|
FBtnSync := TopButton(FLayUnlock, 'Sync', DoSync);
|
|
// Accentue : c'est l'action attendue quand aucun coffre n'est encore la.
|
|
FBtnOpen := TopButton(FLayUnlock, 'Open vault', DoOpenLocal, 52, True);
|
|
|
|
// Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci.
|
|
FPwd := TopEdit(FLayUnlock, 'sync password', TEST_PWD, True);
|
|
FPwd.Margins.Rect := RectF(16, 16, 16, 0);
|
|
|
|
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.BuildList;
|
|
var
|
|
LBar, LTop, LSearchWrap: TLayout;
|
|
LBtnLock: TRectangle;
|
|
LClearMark: TLabel;
|
|
LGlass: TCircle;
|
|
LHandle: TLine;
|
|
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 := FlatButton(LBar, 'Lock', OnBackTap);
|
|
LBtnLock.Align := TAlignLayout.Left;
|
|
LBtnLock.Margins.Rect := RectF(16, 4, 0, 8);
|
|
LBtnLock.Width := 140;
|
|
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, 16, 8);
|
|
FCount.TextSettings.HorzAlign := TTextAlign.Trailing;
|
|
FCount.TextSettings.VertAlign := TTextAlign.Center;
|
|
Tint(FCount, 13, True);
|
|
|
|
FList := TListBox.Create(Self);
|
|
FList.Parent := FLayList;
|
|
FList.Align := TAlignLayout.Client;
|
|
FList.Margins.Rect := RectF(8, 0, 8, 0);
|
|
FList.ItemHeight := 62;
|
|
FList.OnItemClick := OnItemTap;
|
|
// Sans cadre : la liste est posee sur le fond general, pas dans une boite.
|
|
// Le gabarit transparent existe dans les styles livres ; s'il manquait, on
|
|
// retomberait simplement sur l'apparence encadree.
|
|
FList.StyleLookup := 'transparentlistboxstyle';
|
|
|
|
LTop := TLayout.Create(Self);
|
|
LTop.Parent := FLayList;
|
|
LTop.Align := TAlignLayout.Top;
|
|
LTop.Height := 48;
|
|
LTop.Margins.Rect := RectF(8, 8, 8, 8);
|
|
|
|
// Pas de filtre d'etiquette : la recherche texte couvre deja les etiquettes,
|
|
// en taper le nom suffit. Les dossiers, eux, ne se devinent pas.
|
|
//
|
|
// Bouton peint et non TComboBox : le combo etait l'un des deux derniers
|
|
// controles a porter encore le style, et il jurait avec le reste.
|
|
FBtnFolder := FlatButton(LTop, 'All folders', OnFolderTap);
|
|
FBtnFolder.Align := TAlignLayout.Right;
|
|
FBtnFolder.Width := 170;
|
|
FBtnFolder.Margins.Left := 8;
|
|
|
|
// La croix vit A COTE du champ, pas dedans. Un enfant place dans un TEdit
|
|
// ne recoit pas les touches de facon fiable : le controle natif les capte
|
|
// sur toute sa surface. Un conteneur avec un Right et un Client leve en
|
|
// plus toute question d'ordre.
|
|
LSearchWrap := TLayout.Create(Self);
|
|
LSearchWrap.Parent := LTop;
|
|
LSearchWrap.Align := TAlignLayout.Client;
|
|
|
|
FSearchClear := TRectangle.Create(Self);
|
|
FSearchClear.Parent := LSearchWrap;
|
|
FSearchClear.Align := TAlignLayout.Right;
|
|
FSearchClear.Width := 46;
|
|
FSearchClear.Fill.Kind := TBrushKind.None; // invisible, mais cliquable
|
|
FSearchClear.Stroke.Kind := TBrushKind.None;
|
|
FSearchClear.Visible := False;
|
|
FSearchClear.OnClick := OnSearchClear;
|
|
|
|
LClearMark := TLabel.Create(FSearchClear);
|
|
LClearMark.Parent := FSearchClear;
|
|
LClearMark.Align := TAlignLayout.Client;
|
|
LClearMark.HitTest := False; // le clic va au rectangle
|
|
LClearMark.Text := 'X';
|
|
LClearMark.TextSettings.HorzAlign := TTextAlign.Center;
|
|
LClearMark.TextSettings.VertAlign := TTextAlign.Center;
|
|
Tint(LClearMark, 17, True);
|
|
|
|
// Le champ reste natif - il faut un clavier - et son fond vient desormais du
|
|
// style, recolore a la palette par make-style.ps1. PAS de rectangle derriere
|
|
// lui : il en resultait deux cadres arrondis emboites.
|
|
FSearch := TEdit.Create(Self);
|
|
FSearch.Parent := LSearchWrap;
|
|
FSearch.Align := TAlignLayout.Client;
|
|
// Le texte saisi commence apres la loupe.
|
|
FSearch.Padding.Left := 32;
|
|
FSearch.OnChangeTracking := OnSearchChanged;
|
|
|
|
// Invite dessinee par nous, pas par TextPrompt : Dark.style ne comporte pas
|
|
// l'objet que le style est cense fournir pour l'afficher, et le champ
|
|
// restait donc vide et muet. HitTest desactive pour que le clic traverse
|
|
// jusqu'au champ.
|
|
// Loupe DESSINEE dans le champ. Un enfant qui ne fait que se peindre y est
|
|
// accepte - c'est le cliquable qui ne l'est pas. Un cercle et un manche
|
|
// plutot qu'un glyphe : aucune police n'est garantie sur tous les appareils.
|
|
LGlass := TCircle.Create(FSearch);
|
|
LGlass.Parent := FSearch;
|
|
LGlass.Align := TAlignLayout.None;
|
|
LGlass.SetBounds(16, 15, 15, 15);
|
|
LGlass.Fill.Kind := TBrushKind.None;
|
|
LGlass.Stroke.Color := COL_MUTED;
|
|
LGlass.Stroke.Thickness := 2;
|
|
LGlass.HitTest := False;
|
|
|
|
LHandle := TLine.Create(FSearch);
|
|
LHandle.Parent := FSearch;
|
|
LHandle.Align := TAlignLayout.None;
|
|
LHandle.SetBounds(29, 28, 6, 6);
|
|
LHandle.LineType := TLineType.Diagonal;
|
|
LHandle.Stroke.Color := COL_MUTED;
|
|
LHandle.Stroke.Thickness := 2;
|
|
LHandle.HitTest := False;
|
|
|
|
FSearchHint := TLabel.Create(FSearch);
|
|
FSearchHint.Parent := FSearch;
|
|
FSearchHint.Align := TAlignLayout.Client;
|
|
FSearchHint.Margins.Left := 42; // degage la loupe
|
|
FSearchHint.HitTest := False;
|
|
FSearchHint.Opacity := 0.45;
|
|
FSearchHint.Text := 'Search';
|
|
|
|
// Croix d'effacement, montree seulement quand il y a quelque chose a
|
|
// effacer. Un TLabel et non un bouton : dans un champ, une croix se touche,
|
|
// elle ne se dessine pas comme une commande.
|
|
end;
|
|
|
|
/// Intitule discret au-dessus d'une valeur. Meme forme pour toutes les
|
|
/// lignes, y compris celle du TOTP.
|
|
/// AOrder fixe la place de la ligne dans la liste d'enfants du parent.
|
|
///
|
|
/// SANS LUI L'ORDRE N'EST PAS STABLE : observe sur appareil, le formulaire
|
|
/// s'affichait dans le bon ordre a la premiere ouverture puis a l'envers apres
|
|
/// un verrouillage. Les conventions d'empilement de FMX different deja entre
|
|
/// TLayout et TVertScrollBox ; apres destruction et recreation des lignes,
|
|
/// elles ne sont meme plus constantes. On ne s'y fie donc pas du tout.
|
|
function MakeRow(AParent: TFmxObject; const ACaption: string; AOrder: Integer;
|
|
out AValue: TLabel): TLayout;
|
|
var
|
|
LCap: TLabel;
|
|
LBox: TRectangle;
|
|
begin
|
|
// Chaque champ dans son cadre, comme sur le poste Windows : c'est le cadre
|
|
// qui separe les valeurs, pas l'espacement.
|
|
LBox := Surface(AParent);
|
|
LBox.Align := TAlignLayout.Top;
|
|
LBox.Index := AOrder;
|
|
LBox.Height := 76;
|
|
LBox.Margins.Rect := RectF(12, 8, 12, 0);
|
|
|
|
Result := TLayout.Create(nil); // detruite a la main, voir ClearDetailRows
|
|
Result.Parent := LBox;
|
|
Result.Align := TAlignLayout.Client;
|
|
Result.Margins.Rect := RectF(12, 8, 12, 8);
|
|
Result.TagObject := LBox; // le cadre meurt avec la ligne
|
|
|
|
LCap := TLabel.Create(Result);
|
|
LCap.Parent := Result;
|
|
LCap.Align := TAlignLayout.Top;
|
|
LCap.Height := 18;
|
|
LCap.Text := ACaption;
|
|
SectionLabel(LCap);
|
|
|
|
AValue := TLabel.Create(Result);
|
|
AValue.Parent := Result;
|
|
AValue.Align := TAlignLayout.Client;
|
|
Tint(AValue, 16);
|
|
end;
|
|
|
|
function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer;
|
|
AOnClick: TNotifyEvent): TRectangle;
|
|
begin
|
|
Result := FlatButton(ARow, AText, AOnClick);
|
|
Result.Align := TAlignLayout.Right;
|
|
Result.Margins.Rect := RectF(8, 6, 0, 6);
|
|
Result.Width := 96;
|
|
Result.Tag := ATag;
|
|
end;
|
|
|
|
procedure TForm8.BuildDetail;
|
|
var
|
|
LBtnBack: TRectangle;
|
|
begin
|
|
FLayDetail := TLayout.Create(Self);
|
|
FLayDetail.Parent := Self;
|
|
FLayDetail.Align := TAlignLayout.Client;
|
|
FLayDetail.Visible := False;
|
|
|
|
LBtnBack := FlatButton(FLayDetail, 'Back', OnBackTap);
|
|
LBtnBack.Align := TAlignLayout.Bottom;
|
|
LBtnBack.Height := 52;
|
|
LBtnBack.Margins.Rect := RectF(16, 8, 16, 8);
|
|
LBtnBack.Tag := 0;
|
|
|
|
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;
|
|
|
|
// Le corps defilant n'est PAS cree ici : il est recree a chaque ouverture
|
|
// d'entree, voir ShowDetail.
|
|
|
|
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 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, 'Sync');
|
|
end
|
|
else
|
|
begin
|
|
Status('No local vault - first download');
|
|
SetButtonText(FBtnSync, 'Download vault');
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.ShowList;
|
|
begin
|
|
// Quitter le detail rend ses valeurs en clair, et arrete le compte a rebours.
|
|
ClearDetailRows;
|
|
FLayUnlock.Visible := False;
|
|
FLayDetail.Visible := False;
|
|
FLayList.Visible := True;
|
|
FSearch.Text := '';
|
|
OnSearchChanged(nil);
|
|
end;
|
|
|
|
function HumanSize(ABytes: Int64): string;
|
|
begin
|
|
if ABytes >= 1024 * 1024 then
|
|
Result := Format('%.1f Mo', [ABytes / (1024 * 1024)])
|
|
else if ABytes >= 1024 then
|
|
Result := Format('%.0f Ko', [ABytes / 1024])
|
|
else
|
|
Result := Format('%d o', [ABytes]);
|
|
end;
|
|
|
|
procedure TForm8.ClearDetailRows;
|
|
var
|
|
LRow: TLayout;
|
|
begin
|
|
// Appelable avant la fin du constructeur (ShowList), d'ou la garde.
|
|
if FTotpTimer <> nil then FTotpTimer.Enabled := False;
|
|
FTotpValue := nil;
|
|
FTotpBar := nil;
|
|
FTotpCode := '';
|
|
// LE CONTENEUR ENTIER EST DETRUIT, pas seulement ses lignes.
|
|
//
|
|
// Reutiliser le TVertScrollBox donnait un ordre d'affichage qui ALTERNAIT :
|
|
// correct a la premiere ouverture, inverse a la suivante. Ni la convention
|
|
// d'empilement ni un Index explicite ne l'ont stabilise. Puisque la premiere
|
|
// population est fiable, on n'en fait jamais de seconde - un conteneur neuf
|
|
// par entree. Ca coute la creation d'un controle, ca supprime une classe
|
|
// entiere de bizarreries.
|
|
// On detruit le CADRE, pas la ligne : la ligne est son enfant et part avec.
|
|
for LRow in FRowCtls do
|
|
if LRow.TagObject is TRectangle then TRectangle(LRow.TagObject).Free
|
|
else LRow.Free;
|
|
SetLength(FRowCtls, 0);
|
|
FreeAndNil(FDetBody);
|
|
SetLength(FRowValues, 0);
|
|
SetLength(FRowShown, 0);
|
|
SetLength(FRows, 0);
|
|
end;
|
|
|
|
procedure TForm8.ShowDetail(AVaultIndex: Integer);
|
|
var
|
|
LMeta, LPwdCaption: string;
|
|
I, LOrder: Integer;
|
|
LRow: TLayout;
|
|
LValue: TLabel;
|
|
|
|
procedure Add(const ACaption, AValue: string; ASecret: Boolean);
|
|
begin
|
|
if AValue = '' then Exit; // une ligne vide n'apprend rien
|
|
SetLength(FRows, Length(FRows) + 1);
|
|
FRows[High(FRows)].Caption := ACaption;
|
|
FRows[High(FRows)].Value := AValue;
|
|
FRows[High(FRows)].Secret := ASecret;
|
|
end;
|
|
|
|
begin
|
|
Touch;
|
|
ClearDetailRows;
|
|
// Conteneur neuf. Align=Client, donc il ne dispute sa place ni au titre
|
|
// (Top) ni au pied (Bottom) : l'ordre de creation lui est indifferent.
|
|
FDetBody := TVertScrollBox.Create(Self);
|
|
FDetBody.Parent := FLayDetail;
|
|
FDetBody.Align := TAlignLayout.Client;
|
|
|
|
FCurrent := FVault.Entry(AVaultIndex);
|
|
FDetTitle.Text := FCurrent.Display;
|
|
FDetToast.Text := '';
|
|
|
|
// Le corps d'une note est stocke dans le champ mot de passe : meme donnee,
|
|
// autre intitule, et pas de raison de la masquer comme un secret.
|
|
if FCurrent.IsNote then LPwdCaption := 'Content' else LPwdCaption := 'Password';
|
|
|
|
Add('Site', FCurrent.Site, False);
|
|
Add('Username', FCurrent.Username, False);
|
|
Add(LPwdCaption, FCurrent.Password, not FCurrent.IsNote);
|
|
for I := 0 to High(FCurrent.Fields) do
|
|
Add(FCurrent.Fields[I].Caption, FCurrent.Fields[I].Value,
|
|
FCurrent.Fields[I].Secret);
|
|
|
|
LMeta := FCurrent.Folder;
|
|
if FCurrent.Tags <> '' then
|
|
begin
|
|
if LMeta <> '' then LMeta := LMeta + ' - ';
|
|
LMeta := LMeta + FCurrent.Tags;
|
|
end;
|
|
// Les pieces jointes ne sont pas encore enregistrables sur le telephone,
|
|
// mais taire leur existence serait pire : on saurait sur le poste qu'une
|
|
// entree porte un document, et pas ici.
|
|
// Taille dans l'INTITULE, pas collee au nom : un nom de fichier arabe suivi
|
|
// d'une taille latine melange deux sens de lecture dans la meme ligne, et le
|
|
// rendu bidirectionnel de FMX en fait n'importe quoi. Separes, chacun se
|
|
// lit dans son sens.
|
|
for I := 0 to High(FCurrent.Attachments) do
|
|
Add('Attachment - ' + HumanSize(FCurrent.Attachments[I].SizeBytes),
|
|
FCurrent.Attachments[I].FileName, False);
|
|
|
|
Add('Folder / tags', LMeta, False);
|
|
// Le sous-type n'existe que pour les modeles (carte, cle SSH, serveur...) ;
|
|
// Add ignore une valeur vide, donc rien a tester ici.
|
|
Add('Type', FCurrent.Template, False);
|
|
// Horodatage tel quel : c'est de l'ISO 8601 UTC, lisible, et le reformater
|
|
// demanderait de decider d'un fuseau alors qu'il n'y a rien a arbitrer.
|
|
Add('Updated', FCurrent.UpdatedAt, False);
|
|
|
|
SetLength(FRowValues, Length(FRows));
|
|
SetLength(FRowShown, Length(FRows));
|
|
SetLength(FRowCtls, Length(FRows));
|
|
|
|
// Le TOTP en tete d'ecran : c'est ce qu'on vient chercher sur un telephone.
|
|
// Seule ligne vivante, rafraichie chaque seconde.
|
|
LOrder := 0;
|
|
if FCurrent.Totp <> '' then
|
|
begin
|
|
LRow := MakeRow(FDetBody, '2FA code', LOrder, FTotpValue);
|
|
Inc(LOrder);
|
|
SetLength(FRowCtls, Length(FRowCtls) + 1);
|
|
FRowCtls[High(FRowCtls)] := LRow;
|
|
FTotpValue.TextSettings.Font.Size := 28;
|
|
FTotpValue.TextSettings.FontColor := COL_TEXT;
|
|
AddRowButton(LRow, 'Copy', -1, OnCopyTap);
|
|
|
|
// Barre de progression sous le code, comme sur le poste : elle dit d'un
|
|
// coup d'oeil s'il reste le temps de le recopier.
|
|
FTotpBar := TRectangle.Create(LRow);
|
|
FTotpBar.Parent := LRow;
|
|
FTotpBar.Align := TAlignLayout.None;
|
|
FTotpBar.Fill.Color := COL_TEXT;
|
|
FTotpBar.Stroke.Kind := TBrushKind.None;
|
|
FTotpBar.XRadius := 1;
|
|
FTotpBar.YRadius := 1;
|
|
FTotpBar.HitTest := False;
|
|
FTotpBar.SetBounds(0, 56, 0, 3); // largeur posee a chaque seconde
|
|
OnTotpTick(nil); // pas d'attente d'une seconde a l'ouverture
|
|
FTotpTimer.Enabled := True;
|
|
end;
|
|
|
|
for I := 0 to High(FRows) do
|
|
begin
|
|
LRow := MakeRow(FDetBody, FRows[I].Caption, LOrder, LValue);
|
|
Inc(LOrder);
|
|
FRowCtls[I] := LRow;
|
|
FRowValues[I] := LValue;
|
|
FRowShown[I] := False;
|
|
if FRows[I].Secret then
|
|
begin
|
|
LValue.Text := MASK;
|
|
AddRowButton(LRow, 'Show', I, OnRevealTap);
|
|
end
|
|
else
|
|
LValue.Text := FRows[I].Value;
|
|
AddRowButton(LRow, 'Copy', I, OnCopyTap);
|
|
end;
|
|
// La derniere ligne affichee touche sinon le bord du defilement, ce qui la
|
|
// fait passer pour tronquee alors qu'elle est juste collee.
|
|
// La derniere ligne affichee touche sinon le bord du defilement, ce qui la
|
|
// fait passer pour tronquee alors qu'elle est juste collee.
|
|
if (Length(FRows) > 0) and (FRowCtls[High(FRows)].TagObject is TRectangle) then
|
|
TRectangle(FRowCtls[High(FRows)].TagObject).Margins.Bottom := 12;
|
|
|
|
FLayList.Visible := False;
|
|
FLayDetail.Visible := True;
|
|
end;
|
|
|
|
procedure TForm8.OnTotpTick(Sender: TObject);
|
|
var
|
|
LLeft, LPeriod: Integer;
|
|
begin
|
|
if FTotpValue = nil then
|
|
begin
|
|
FTotpTimer.Enabled := False;
|
|
Exit;
|
|
end;
|
|
FTotpCode := TotpNow(FCurrent.Totp, LLeft, LPeriod);
|
|
if FTotpCode = '' then
|
|
begin
|
|
// Un secret illisible ne doit pas passer pour un code : le dire.
|
|
FTotpValue.Text := 'unreadable secret';
|
|
FTotpTimer.Enabled := False;
|
|
Exit;
|
|
end;
|
|
// Coupe en deux, comme partout ailleurs : six chiffres d'affilee se
|
|
// recopient mal. Le temps restant passe dans la barre, plus dans le texte.
|
|
FTotpValue.Text := Copy(FTotpCode, 1, Length(FTotpCode) div 2) + ' ' +
|
|
Copy(FTotpCode, Length(FTotpCode) div 2 + 1, MaxInt);
|
|
if (FTotpBar <> nil) and (LPeriod > 0) then
|
|
FTotpBar.Width := FTotpBar.ParentControl.Width * LLeft / LPeriod;
|
|
end;
|
|
|
|
procedure TForm8.OnBackTap(Sender: TObject);
|
|
begin
|
|
// Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail.
|
|
if (Sender is TRectangle) and (TRectangle(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;
|
|
// Le panneau des dossiers se ferme avant tout le reste : c'est ce que le
|
|
// bouton retour est cense faire d'abord quand quelque chose est ouvert.
|
|
if FFolderPanel <> nil then
|
|
begin
|
|
FreeAndNil(FFolderPanel);
|
|
Key := 0;
|
|
Exit;
|
|
end;
|
|
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;
|
|
|
|
procedure TForm8.OnToggleLog(Sender: TObject);
|
|
begin
|
|
FLog.Visible := not FLog.Visible;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Ouverture, synchronisation, verrouillage
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.LockVault;
|
|
begin
|
|
// Le clair dispararait de la memoire ET de l'ecran. Le fichier local reste :
|
|
// il est chiffre par le materiel, c'est tout l'interet du cache.
|
|
//
|
|
// L'ETAG PART AVEC LUI. Il decrit le clair detenu, pas un telechargement :
|
|
// le garder ferait repondre 304 au serveur alors qu'on n'a plus rien a
|
|
// afficher - et sur un poste sans cache local (hors Android), plus aucun
|
|
// moyen de rouvrir le coffre sans relancer l'application.
|
|
FETag := '';
|
|
FIdleTimer.Enabled := False;
|
|
FVault.Clear;
|
|
FList.Clear;
|
|
FIcons.Clear;
|
|
// Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
|
|
// fait partie du verrouillage, pas de l'affichage.
|
|
ClearDetailRows;
|
|
FCurrent := Default(TVaultEntry);
|
|
ShowUnlock;
|
|
end;
|
|
|
|
procedure TForm8.AdoptVault(const APlainJson: string);
|
|
begin
|
|
FVault.LoadFromJson(APlainJson);
|
|
Log(' ' + FVault.LiveCount.ToString + ' entries, ' +
|
|
FVault.TrashCount.ToString + ' in trash');
|
|
FVaultUnreadable := False;
|
|
RebuildIcons;
|
|
PopulateFolders;
|
|
Touch;
|
|
FIdleTimer.Enabled := True;
|
|
// Deja dans l'application : reconstruire la liste SANS y ramener
|
|
// l'utilisateur. Obligatoire meme s'il est dans le detail - les lignes de
|
|
// la liste portent des indices vers l'ancien coffre, et un appui ouvrirait
|
|
// la mauvaise entree.
|
|
if FLayList.Visible or FLayDetail.Visible then
|
|
OnSearchChanged(nil)
|
|
else
|
|
ShowList;
|
|
end;
|
|
|
|
procedure TForm8.OpenLocalNow;
|
|
var
|
|
LPlain, LETag, LPwd: string;
|
|
begin
|
|
if LoadVault(LPlain, LETag, LPwd) then
|
|
begin
|
|
FETag := LETag;
|
|
if LPwd <> '' then FSyncPwd := LPwd;
|
|
|
|
// 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.
|
|
function BitmapFromDataUri(const AUri: string): TBitmap;
|
|
var
|
|
LComma: Integer;
|
|
LStream: TBytesStream;
|
|
begin
|
|
Result := nil;
|
|
if not AUri.StartsWith('data:') then Exit;
|
|
LComma := Pos(',', AUri);
|
|
if LComma = 0 then Exit;
|
|
try
|
|
LStream := TBytesStream.Create(TNetEncoding.Base64.DecodeStringToBytes(
|
|
Copy(AUri, LComma + 1, MaxInt)));
|
|
try
|
|
Result := TBitmap.Create;
|
|
Result.LoadFromStream(LStream);
|
|
finally
|
|
LStream.Free;
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.RebuildIcons;
|
|
var
|
|
I: Integer;
|
|
LBmp: TBitmap;
|
|
begin
|
|
FIcons.Clear;
|
|
// ponytail: tout decode a l'adoption du coffre, sur le thread principal.
|
|
// Quelques centaines de vignettes de 16 px ne se sentent pas ; deporter
|
|
// dans un thread le jour ou l'ouverture marque un temps.
|
|
for I := 0 to FVault.Count - 1 do
|
|
begin
|
|
if FVault.Entry(I).IconB64 = '' then Continue;
|
|
LBmp := BitmapFromDataUri(FVault.Entry(I).IconB64);
|
|
if LBmp <> nil then FIcons.Add(I, LBmp);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.PopulateFolders;
|
|
var
|
|
LF, LPrev: string;
|
|
I: Integer;
|
|
begin
|
|
// Le choix courant survit a un rafraichissement de fond : le voir retomber
|
|
// sur "tous" tout seul, sans avoir rien touche, serait deroutant.
|
|
LPrev := '';
|
|
if (FFolderSel > 0) and (FFolderSel <= High(FFolderNames)) then
|
|
LPrev := FFolderNames[FFolderSel];
|
|
|
|
SetLength(FFolderNames, 1);
|
|
FFolderNames[0] := 'All folders';
|
|
for LF in FVault.Folders do
|
|
begin
|
|
SetLength(FFolderNames, Length(FFolderNames) + 1);
|
|
FFolderNames[High(FFolderNames)] := LF;
|
|
end;
|
|
|
|
FFolderSel := 0;
|
|
for I := 1 to High(FFolderNames) do
|
|
if FFolderNames[I] = LPrev then FFolderSel := I;
|
|
SetButtonText(FBtnFolder, FFolderNames[FFolderSel]);
|
|
end;
|
|
|
|
procedure TForm8.OnSearchClear(Sender: TObject);
|
|
begin
|
|
FSearch.Text := '';
|
|
// OnChangeTracking ne se declenche pas sur une affectation par code : la
|
|
// liste resterait filtree par une requete devenue vide.
|
|
OnSearchChanged(nil);
|
|
end;
|
|
|
|
procedure TForm8.OnFolderTap(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
LRow: TRectangle;
|
|
LCard: TRectangle;
|
|
LBody: TVertScrollBox;
|
|
LH, LWanted, LMax: Single;
|
|
begin
|
|
Touch;
|
|
FreeAndNil(FFolderPanel);
|
|
if Length(FFolderNames) < 2 then Exit; // rien a choisir
|
|
|
|
LH := 52;
|
|
|
|
// Voile plein ecran : il assombrit le fond ET recoit le clic exterieur.
|
|
// Sans lui le panneau restait ouvert tant qu'on n'avait pas choisi - il
|
|
// faut toujours pouvoir renoncer.
|
|
FFolderPanel := TRectangle.Create(FLayList);
|
|
FFolderPanel.Parent := FLayList;
|
|
FFolderPanel.Align := TAlignLayout.Contents;
|
|
FFolderPanel.Fill.Color := TAlphaColor($99000000);
|
|
FFolderPanel.Stroke.Kind := TBrushKind.None;
|
|
FFolderPanel.OnClick := OnFolderPick;
|
|
FFolderPanel.Tag := -1; // -1 : renoncer, garder le choix courant
|
|
|
|
LWanted := Length(FFolderNames) * LH + 12;
|
|
LMax := FLayList.Height - 140;
|
|
if LWanted > LMax then LWanted := LMax;
|
|
|
|
LCard := Surface(FFolderPanel);
|
|
LCard.Align := TAlignLayout.None;
|
|
LCard.SetBounds(16, 66, FLayList.Width - 32, LWanted);
|
|
|
|
// Defilant, car une longue liste de dossiers sortirait de l'ecran. Les
|
|
// lignes y sont POSEES A LA COORDONNEE, sans alignement : c'est ce qui rend
|
|
// l'ordre independant des conventions de FMX, instables des qu'on detruit
|
|
// et recree des enfants.
|
|
LBody := TVertScrollBox.Create(LCard);
|
|
LBody.Parent := LCard;
|
|
LBody.Align := TAlignLayout.Client;
|
|
LBody.Margins.Rect := RectF(6, 6, 6, 6);
|
|
LBody.ShowScrollBars := False;
|
|
|
|
for I := 0 to High(FFolderNames) do
|
|
begin
|
|
LRow := FlatButton(LBody, FFolderNames[I], OnFolderPick, I = FFolderSel);
|
|
LRow.Align := TAlignLayout.None;
|
|
LRow.SetBounds(0, I * LH, LCard.Width - 24, LH - 6);
|
|
LRow.Tag := I;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.OnFolderPick(Sender: TObject);
|
|
begin
|
|
// Tag -1 : le voile, donc un clic a cote. On ferme sans rien changer.
|
|
if (Sender is TRectangle) and (TRectangle(Sender).Tag >= 0) then
|
|
FFolderSel := TRectangle(Sender).Tag;
|
|
SetButtonText(FBtnFolder, FFolderNames[FFolderSel]);
|
|
FreeAndNil(FFolderPanel);
|
|
OnSearchChanged(nil);
|
|
end;
|
|
|
|
procedure TForm8.OnSearchChanged(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
LItem: TListBoxItem;
|
|
E: TVaultEntry;
|
|
LFolder: string;
|
|
LBmp: TBitmap;
|
|
LImg: TImage;
|
|
LBody: TLayout;
|
|
LTitle, LSub: TLabel;
|
|
begin
|
|
// ponytail: refonte complete de la liste a chaque frappe. Sur un coffre de
|
|
// quelques centaines d'entrees c'est imperceptible ; passer a un modele
|
|
// virtuel (TListView) le jour ou ca rame.
|
|
Touch;
|
|
FSearchHint.Visible := FSearch.Text = '';
|
|
FSearchClear.Visible := FSearch.Text <> '';
|
|
LFolder := '';
|
|
if (FFolderSel > 0) and (FFolderSel <= High(FFolderNames)) then
|
|
LFolder := FFolderNames[FFolderSel]; // 0 = tous les dossiers
|
|
FFiltered := FVault.Search(FSearch.Text, LFolder);
|
|
|
|
FList.BeginUpdate;
|
|
try
|
|
FList.Clear;
|
|
for I := 0 to High(FFiltered) do
|
|
begin
|
|
E := FVault.Entry(FFiltered[I]);
|
|
LItem := TListBoxItem.Create(FList);
|
|
LItem.Parent := FList;
|
|
LItem.Height := 56;
|
|
LItem.Tag := FFiltered[I]; // indice dans le coffre, pas dans la liste
|
|
// CONTENU CONSTRUIT A LA MAIN, sans passer par Text/Detail/Bitmap ni par
|
|
// un StyleLookup. Ces gabarits n'existent pas dans tous les styles :
|
|
// avec Dark.style, 'listboxitembottomdetail' disparait et emporte
|
|
// l'identifiant, l'icone et la hauteur de ligne. Deux enfants seulement,
|
|
// alignes Left et Client - il n'y a alors pas d'ordre a deviner.
|
|
if FIcons.TryGetValue(FFiltered[I], LBmp) then
|
|
begin
|
|
LImg := TImage.Create(LItem);
|
|
LImg.Parent := LItem;
|
|
LImg.Align := TAlignLayout.Left;
|
|
LImg.Width := 40;
|
|
LImg.Margins.Rect := RectF(4, 8, 8, 8);
|
|
LImg.HitTest := False; // le clic doit atteindre la ligne
|
|
LImg.Bitmap.Assign(LBmp);
|
|
end;
|
|
|
|
LBody := TLayout.Create(LItem);
|
|
LBody.Parent := LItem;
|
|
LBody.Align := TAlignLayout.Client;
|
|
LBody.Margins.Rect := RectF(8, 4, 8, 4);
|
|
LBody.HitTest := False;
|
|
|
|
LTitle := TLabel.Create(LBody);
|
|
LTitle.Parent := LBody;
|
|
LTitle.Align := TAlignLayout.Top;
|
|
LTitle.Height := 26;
|
|
LTitle.HitTest := False;
|
|
LTitle.StyledSettings := LTitle.StyledSettings - [TStyledSetting.Size];
|
|
LTitle.TextSettings.Font.Size := 16;
|
|
LTitle.Text := E.Display;
|
|
|
|
// Align=Client sur le second : avec un Top et un Client, la place de
|
|
// chacun est determinee, quel que soit l'ordre des enfants.
|
|
LSub := TLabel.Create(LBody);
|
|
LSub.Parent := LBody;
|
|
LSub.Align := TAlignLayout.Client;
|
|
LSub.HitTest := False;
|
|
LSub.Opacity := 0.6;
|
|
LSub.StyledSettings := LSub.StyledSettings - [TStyledSetting.Size];
|
|
LSub.TextSettings.Font.Size := 12;
|
|
LSub.Text := E.Username;
|
|
end;
|
|
finally
|
|
FList.EndUpdate;
|
|
end;
|
|
|
|
if (FSearch.Text.Trim = '') and (LFolder = '') then
|
|
FCount.Text := FVault.LiveCount.ToString + ' entries'
|
|
else
|
|
FCount.Text := Length(FFiltered).ToString + ' / ' +
|
|
FVault.LiveCount.ToString;
|
|
end;
|
|
|
|
procedure TForm8.OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
|
|
begin
|
|
if AItem <> nil then ShowDetail(AItem.Tag);
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Detail : reveler et copier
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.OnRevealTap(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Touch;
|
|
if not (Sender is TRectangle) then Exit;
|
|
I := TRectangle(Sender).Tag;
|
|
if (I < 0) or (I > High(FRows)) then Exit;
|
|
|
|
FRowShown[I] := not FRowShown[I];
|
|
if FRowShown[I] then
|
|
begin
|
|
FRowValues[I].Text := FRows[I].Value;
|
|
SetButtonText(TRectangle(Sender), 'Hide');
|
|
end
|
|
else
|
|
begin
|
|
FRowValues[I].Text := MASK;
|
|
SetButtonText(TRectangle(Sender), 'Show');
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.OnCopyTap(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Touch;
|
|
if not (Sender is TRectangle) then Exit;
|
|
I := TRectangle(Sender).Tag;
|
|
// -1 : la ligne du TOTP, qui n'est pas dans FRows - sa valeur change chaque
|
|
// periode et ne vit que dans FTotpCode. Copie sans l'espace d'affichage.
|
|
if I = -1 then
|
|
CopyToClipboard(FTotpCode, '2FA code')
|
|
else if (I >= 0) and (I <= High(FRows)) then
|
|
CopyToClipboard(FRows[I].Value, FRows[I].Caption);
|
|
end;
|
|
|
|
procedure TForm8.CopyToClipboard(const AText, ALabel: string);
|
|
begin
|
|
if AText = '' then Exit;
|
|
// Marque le contenu sensible : sans cela Android 13+ affiche un apercu de ce
|
|
// qui vient d'etre copie, mot de passe compris, en clair et hors de
|
|
// l'application.
|
|
if not CopySensitive(AText) then Exit;
|
|
FCopied := AText;
|
|
// Reprogramme depuis zero : deux copies successives donnent au second
|
|
// contenu son delai complet, pas le reste de celui du premier.
|
|
FClipTimer.Enabled := False;
|
|
FClipTimer.Enabled := True;
|
|
// ponytail: le message reste jusqu'a la prochaine navigation, pas de minuterie
|
|
// pour l'effacer. Un deuxieme TTimer pour deux secondes d'affichage serait
|
|
// plus de code que ce que ca apporte.
|
|
FDetToast.Text := ALabel + ' 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 FLayList.Visible or FLayDetail.Visible then
|
|
begin
|
|
FHiddenOnDetail := FLayDetail.Visible;
|
|
FLayDetail.Visible := False;
|
|
FLayList.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.
|
|
FLayUnlock.Visible := False;
|
|
FLayDetail.Visible := FHiddenOnDetail;
|
|
FLayList.Visible := not FHiddenOnDetail;
|
|
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.
|