r-zakarya
e85f46f501
The cross moves inside the search field, where it belonged. My first attempt failed with a TLabel, whose HitTest is false by default, and I concluded too quickly that no child of a TEdit can take a touch. A TRectangle takes it. Buttons drop the pill and take the fields' radius: a stadium beside a 14-radius field put two shape vocabularies on one line, and consistency is worth more here than fidelity to the reference. List entries get their own block, like the detail fields - on a gradient a bare line of text has no readable edge. And each row carries User and Pass buttons, so the commonest gesture no longer requires opening the entry. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1735 lines
62 KiB
ObjectPascal
1735 lines
62 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, FSearchClearMark: TLabel;
|
|
FSearchGlass: TCircle;
|
|
FSearchHandle: TLine;
|
|
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 OnRowCopyUser(Sender: TObject);
|
|
procedure OnRowCopyPwd(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);
|
|
// 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;
|
|
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: TLayout;
|
|
LBtnLock: TRectangle;
|
|
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;
|
|
|
|
// 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 := LTop;
|
|
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.
|
|
FSearchGlass := TCircle.Create(FSearch);
|
|
LGlass := FSearchGlass;
|
|
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;
|
|
|
|
FSearchHandle := TLine.Create(FSearch);
|
|
LHandle := FSearchHandle;
|
|
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 DANS le champ, et non plus a cote. Le premier essai avait echoue
|
|
// avec un TLabel, dont HitTest vaut faux par defaut ; j'en avais conclu trop
|
|
// vite qu'un enfant de TEdit ne recoit jamais les touches. Un TRectangle les
|
|
// prend. Sa place est occupee en permanence pour que la largeur du champ ne
|
|
// bouge pas ; seule la croix apparait.
|
|
FSearchClear := TRectangle.Create(FSearch);
|
|
FSearchClear.Parent := FSearch;
|
|
FSearchClear.Align := TAlignLayout.Right;
|
|
FSearchClear.Width := 46;
|
|
FSearchClear.Fill.Kind := TBrushKind.None; // invisible, mais cliquable
|
|
FSearchClear.Stroke.Kind := TBrushKind.None;
|
|
FSearchClear.OnClick := OnSearchClear;
|
|
|
|
FSearchClearMark := TLabel.Create(FSearchClear);
|
|
FSearchClearMark.Parent := FSearchClear;
|
|
FSearchClearMark.Align := TAlignLayout.Client;
|
|
FSearchClearMark.HitTest := False; // le clic va au rectangle
|
|
FSearchClearMark.Text := 'X';
|
|
FSearchClearMark.TextSettings.HorzAlign := TTextAlign.Center;
|
|
FSearchClearMark.TextSettings.VertAlign := TTextAlign.Center;
|
|
FSearchClearMark.Visible := False;
|
|
Tint(FSearchClearMark, 17, True);
|
|
|
|
// 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;
|
|
// Arrondi modere : ces boutons sont bas et larges, une pilule les rendait
|
|
// ovales. La forme pleinement arrondie reste aux actions principales.
|
|
SetCornerRadius(Result, 14);
|
|
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;
|
|
// 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;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
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;
|
|
|
|
/// Copie depuis la liste. Le Tag du bouton porte l'indice dans le coffre, pas
|
|
/// dans la liste affichee - la recherche renumerote les lignes, pas le coffre.
|
|
procedure TForm8.OnRowCopyUser(Sender: TObject);
|
|
begin
|
|
Touch;
|
|
if (Sender is TRectangle) and (TRectangle(Sender).Tag < FVault.Count) then
|
|
CopyToClipboard(FVault.Entry(TRectangle(Sender).Tag).Username, 'Username');
|
|
end;
|
|
|
|
procedure TForm8.OnRowCopyPwd(Sender: TObject);
|
|
begin
|
|
Touch;
|
|
if (Sender is TRectangle) and (TRectangle(Sender).Tag < FVault.Count) then
|
|
CopyToClipboard(FVault.Entry(TRectangle(Sender).Tag).Password, 'Password');
|
|
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, LActions: TLayout;
|
|
LCard, LBtnUser, LBtnPwd: TRectangle;
|
|
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;
|
|
// La loupe s'efface des qu'on tape : elle a servi a dire ce qu'est le
|
|
// champ, et une fois la saisie commencee elle n'apprend plus rien.
|
|
FSearchHint.Visible := FSearch.Text = '';
|
|
FSearchGlass.Visible := FSearch.Text = '';
|
|
FSearchHandle.Visible := FSearch.Text = '';
|
|
FSearchClearMark.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 := 76;
|
|
LItem.Tag := FFiltered[I]; // indice dans le coffre, pas dans la liste
|
|
|
|
// Chaque entree dans son bloc, comme les champs du detail : sur un fond
|
|
// en degrade, une simple ligne de texte flotte sans limite lisible.
|
|
LCard := Surface(LItem);
|
|
LCard.Align := TAlignLayout.Client;
|
|
LCard.Margins.Rect := RectF(4, 3, 4, 3);
|
|
|
|
// Copier sans ouvrir l'entree - le geste le plus frequent. Les deux
|
|
// boutons sont poses a la coordonnee dans leur propre conteneur : deux
|
|
// controles alignes a droite laisseraient leur ordre au hasard.
|
|
LActions := TLayout.Create(LCard);
|
|
LActions.Parent := LCard;
|
|
LActions.Align := TAlignLayout.Right;
|
|
LActions.Width := 150;
|
|
LActions.Margins.Rect := RectF(0, 8, 8, 8);
|
|
|
|
LBtnUser := FlatButton(LActions, 'User', OnRowCopyUser);
|
|
LBtnUser.Align := TAlignLayout.None;
|
|
LBtnUser.SetBounds(0, 0, 70, 54);
|
|
LBtnUser.Tag := FFiltered[I];
|
|
|
|
LBtnPwd := FlatButton(LActions, 'Pass', OnRowCopyPwd);
|
|
LBtnPwd.Align := TAlignLayout.None;
|
|
LBtnPwd.SetBounds(76, 0, 70, 54);
|
|
LBtnPwd.Tag := FFiltered[I];
|
|
// 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(LCard);
|
|
LImg.Parent := LCard;
|
|
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(LCard);
|
|
LBody.Parent := LCard;
|
|
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.
|