r-zakarya
09f108aa8d
The search field and the folder combo were the only things still wearing the style, and they clashed with everything painted around them. The edit stays native - a keyboard has to come from somewhere - but its background is ours now, with the styled one made transparent. The combo becomes a painted button opening a panel of choices, placed by explicit coordinates: FMX's stacking order proved unstable as soon as children are destroyed and rebuilt, so nothing here relies on it. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
1448 lines
50 KiB
ObjectPascal
1448 lines
50 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;
|
|
|
|
// 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;
|
|
// 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: TRectangle;
|
|
FLaySettings: TLayout;
|
|
FStatus: TLabel;
|
|
FLog: TMemo;
|
|
|
|
// --- ecran 2 : liste
|
|
FLayList: TLayout;
|
|
FSearch: TEdit;
|
|
FSearchHint: TLabel;
|
|
/// 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;
|
|
FBtnReveal: TRectangle;
|
|
FRows: TArray<TDetRow>;
|
|
FRowCtls: TArray<TLayout>;
|
|
FRowValues: TArray<TLabel>;
|
|
FRowShown: TArray<Boolean>;
|
|
|
|
// --- TOTP : une ligne vivante, rafraichie chaque seconde
|
|
FTotpTimer: TTimer;
|
|
FTotpValue: TLabel;
|
|
FTotpCode: string;
|
|
|
|
// --- presse-papiers
|
|
FClipTimer: TTimer;
|
|
FCopied: string;
|
|
|
|
// --- verrouillage sur inactivite
|
|
FIdleTimer: TTimer;
|
|
FLastActivity: TDateTime;
|
|
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 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 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 := 'Coffre';
|
|
// 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.
|
|
Fill.Kind := TBrushKind.Solid;
|
|
Fill.Color := 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;
|
|
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;
|
|
|
|
// --- du bas vers le haut (voir TopButton)
|
|
FLaySettings := TLayout.Create(Self);
|
|
FLaySettings.Parent := FLayUnlock;
|
|
FLaySettings.Align := TAlignLayout.Top;
|
|
FLaySettings.Height := 116;
|
|
FLaySettings.Visible := False;
|
|
FToken := TopEdit(FLaySettings, 'jeton Bearer', FIRSTRUN_TOKEN);
|
|
FUrl := TopEdit(FLaySettings, 'URL de l''endpoint', 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;
|
|
|
|
FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur',
|
|
OnToggleSettings, 40);
|
|
|
|
FBtnSync := TopButton(FLayUnlock, 'Synchroniser', DoSync);
|
|
// Accentue : c'est l'action attendue quand aucun coffre n'est encore la.
|
|
FBtnOpen := TopButton(FLayUnlock, 'Ouvrir le coffre', DoOpenLocal, 52, True);
|
|
|
|
// Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci.
|
|
FPwd := TopEdit(FLayUnlock, 'mot de passe de sync', 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, LSearchBox: TRectangle;
|
|
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, 'Verrouiller', 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, 'Tous les dossiers', OnFolderTap);
|
|
FBtnFolder.Align := TAlignLayout.Right;
|
|
FBtnFolder.Width := 170;
|
|
FBtnFolder.Margins.Left := 8;
|
|
|
|
// Le champ de saisie reste natif - il faut un clavier - mais son fond vient
|
|
// de nous : LSearchBox le porte, l'editeur par-dessus est transparent.
|
|
LSearchBox := Surface(LTop);
|
|
LSearchBox.Align := TAlignLayout.Client;
|
|
LSearchBox.Fill.Color := COL_SURFACE;
|
|
|
|
FSearch := TEdit.Create(Self);
|
|
FSearch.Parent := LSearchBox;
|
|
FSearch.Align := TAlignLayout.Client;
|
|
FSearch.Margins.Rect := RectF(6, 0, 6, 0);
|
|
FSearch.OnChangeTracking := OnSearchChanged;
|
|
// Gabarit transparent : present dans les styles livres. S'il manquait, on
|
|
// retomberait sur le fond du style, sans casse.
|
|
FSearch.StyleLookup := 'transparentedit';
|
|
|
|
// 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.
|
|
FSearchHint := TLabel.Create(FSearch);
|
|
FSearchHint.Parent := FSearch;
|
|
FSearchHint.Align := TAlignLayout.Client;
|
|
FSearchHint.Margins.Left := 10;
|
|
FSearchHint.HitTest := False;
|
|
FSearchHint.Opacity := 0.45;
|
|
FSearchHint.Text := 'Rechercher';
|
|
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;
|
|
begin
|
|
Result := TLayout.Create(nil); // detruite a la main, voir ClearDetailRows
|
|
Result.Parent := AParent;
|
|
Result.Index := AOrder;
|
|
Result.Align := TAlignLayout.Top;
|
|
Result.Height := 62;
|
|
Result.Margins.Rect := RectF(12, 10, 12, 0);
|
|
|
|
LCap := TLabel.Create(Result);
|
|
LCap.Parent := Result;
|
|
LCap.Align := TAlignLayout.Top;
|
|
LCap.Height := 20;
|
|
LCap.Text := ACaption;
|
|
LCap.Opacity := 0.6;
|
|
LCap.StyledSettings := LCap.StyledSettings - [TStyledSetting.Size];
|
|
LCap.TextSettings.Font.Size := 12;
|
|
|
|
AValue := TLabel.Create(Result);
|
|
AValue.Parent := Result;
|
|
AValue.Align := TAlignLayout.Client;
|
|
AValue.StyledSettings := AValue.StyledSettings - [TStyledSetting.Size];
|
|
AValue.TextSettings.Font.Size := 16;
|
|
end;
|
|
|
|
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, 'Retour', 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 ; sinon
|
|
// seul le telechargement peut en produire un.
|
|
FBtnOpen.Visible := HasVault;
|
|
if HasVault then
|
|
begin
|
|
if VaultNeedsAuth then
|
|
Status('Coffre present sur cet appareil - protege')
|
|
else
|
|
Status('Coffre present sur cet appareil');
|
|
SetButtonText(FBtnSync, 'Synchroniser');
|
|
end
|
|
else
|
|
begin
|
|
Status('Aucun coffre local - premier telechargement');
|
|
SetButtonText(FBtnSync, 'Telecharger le coffre');
|
|
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;
|
|
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.
|
|
for LRow in FRowCtls do 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 := 'Contenu' else LPwdCaption := 'Mot de passe';
|
|
|
|
Add('Site', FCurrent.Site, False);
|
|
Add('Identifiant', 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('Piece jointe - ' + HumanSize(FCurrent.Attachments[I].SizeBytes),
|
|
FCurrent.Attachments[I].FileName, False);
|
|
|
|
Add('Dossier / etiquettes', 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('Modifie le', 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, 'Code 2FA', LOrder, FTotpValue);
|
|
Inc(LOrder);
|
|
SetLength(FRowCtls, Length(FRowCtls) + 1);
|
|
FRowCtls[High(FRowCtls)] := LRow;
|
|
FTotpValue.TextSettings.Font.Size := 26;
|
|
AddRowButton(LRow, 'Copier', -1, OnCopyTap);
|
|
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, 'Afficher', I, OnRevealTap);
|
|
end
|
|
else
|
|
LValue.Text := FRows[I].Value;
|
|
AddRowButton(LRow, 'Copier', 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 then
|
|
FRowCtls[High(FRows)].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 := 'secret illisible';
|
|
FTotpTimer.Enabled := False;
|
|
Exit;
|
|
end;
|
|
// Coupe en deux, comme partout ailleurs : six chiffres d'affilee se
|
|
// recopient mal.
|
|
FTotpValue.Text := Copy(FTotpCode, 1, Length(FTotpCode) div 2) + ' ' +
|
|
Copy(FTotpCode, Length(FTotpCode) div 2 + 1, MaxInt) +
|
|
' ' + LLeft.ToString + ' s';
|
|
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;
|
|
if FLayDetail.Visible then
|
|
begin
|
|
ShowList;
|
|
Key := 0; // consomme : sinon Android ferme l'application
|
|
end
|
|
else if FLayList.Visible then
|
|
begin
|
|
LockVault;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.OnToggleSettings(Sender: TObject);
|
|
begin
|
|
FLaySettings.Visible := not FLaySettings.Visible;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Ouverture, synchronisation, verrouillage
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.LockVault;
|
|
begin
|
|
// Le clair dispararait de la memoire ET de l'ecran. Le fichier local reste :
|
|
// il est chiffre par le materiel, c'est tout l'interet du cache.
|
|
//
|
|
// L'ETAG PART AVEC LUI. Il decrit le clair detenu, pas un telechargement :
|
|
// le garder ferait repondre 304 au serveur alors qu'on n'a plus rien a
|
|
// afficher - et sur un poste sans cache local (hors Android), plus aucun
|
|
// moyen de rouvrir le coffre sans relancer l'application.
|
|
FETag := '';
|
|
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 + ' entrees, ' +
|
|
FVault.TrashCount.ToString + ' en corbeille');
|
|
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;
|
|
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('Coffre local corrompu : ' + 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.
|
|
ShowUnlock;
|
|
Log('Coffre local illisible : ' + LastStoreError);
|
|
Status('Coffre local illisible - voir le journal');
|
|
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('Authentification...');
|
|
AuthenticateThen('Acceder au coffre',
|
|
procedure(AOutcome: TBioOutcome)
|
|
begin
|
|
case AOutcome of
|
|
boOK: OpenLocalNow;
|
|
boCancelled: Status('Annule');
|
|
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('Authentification indisponible au lancement - cache conserve');
|
|
Log(' ' + LastBiometricError);
|
|
Status('Authentification indisponible - reessayer');
|
|
end
|
|
else
|
|
begin
|
|
Log('Plus aucune protection sur l''appareil - cache efface');
|
|
Log(' ' + LastBiometricError);
|
|
ClearVault;
|
|
ShowUnlock;
|
|
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('Echec de l''authentification : ' + LastBiometricError);
|
|
Status('Echec de l''authentification');
|
|
end;
|
|
end);
|
|
end;
|
|
|
|
procedure TForm8.DoSync(Sender: TObject);
|
|
var
|
|
LUrl, LTok, LPwd: string;
|
|
begin
|
|
if FBusy then Exit;
|
|
// Lus ICI, sur le thread principal : toucher un controle FMX depuis le
|
|
// thread de travail est un plantage differe, pas une erreur de compilation.
|
|
LUrl := FUrl.Text.Trim;
|
|
LTok := FToken.Text.Trim;
|
|
// 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('Mot de passe de sync requis');
|
|
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.
|
|
if VaultNeedsAuth and (FVault.Count = 0) then
|
|
begin
|
|
Status('Authentification...');
|
|
AuthenticateThen('Acceder au coffre',
|
|
procedure(AOutcome: TBioOutcome)
|
|
begin
|
|
if AOutcome = boOK then
|
|
FetchAndDecrypt(LUrl, LTok, LPwd)
|
|
else
|
|
begin
|
|
Log('Synchronisation refusee : ' + LastBiometricError);
|
|
Status('Authentification requise');
|
|
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('Telechargement...');
|
|
// 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 + ' en ' +
|
|
LSw.ElapsedMilliseconds.ToString + ' ms');
|
|
|
|
case LRes.Status of
|
|
ssNotModified:
|
|
begin
|
|
// C'est ICI que le cache paie : pas de telechargement, pas de
|
|
// derivation, le coffre vient du fichier local.
|
|
// Rien n'a change cote serveur : le clair est deja quelque part,
|
|
// soit en memoire, soit dans le cache lu en debut de procedure.
|
|
// Surtout PAS de relecture du fichier ici - elle peut echouer
|
|
// (authentification expiree) et laisserait l'utilisateur sans
|
|
// rien apres un appel pourtant reussi.
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
if FVault.Count > 0 then
|
|
// 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 : inchange, coffre deja ouvert')
|
|
else if LCached <> '' then
|
|
begin
|
|
Log(' 304 : inchange, coffre servi depuis le cache');
|
|
try
|
|
AdoptVault(LCached);
|
|
except
|
|
on E: Exception do Status('Cache illisible : ' + E.Message);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// Un ETag sans clair correspondant : l'invariant est rompu.
|
|
// On le jette pour que l'appel suivant retelecharge.
|
|
FETag := '';
|
|
if not ASilent then
|
|
Status('Cache absent - appuyer a nouveau pour telecharger');
|
|
end;
|
|
end);
|
|
Exit;
|
|
end;
|
|
ssNoSnapshot:
|
|
begin
|
|
// Le serveur repond pareil dans les deux cas, par conception.
|
|
Log(' 404 : pas d''instantane OU jeton invalide');
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure
|
|
begin Status('Rien a telecharger (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(' echec : ' + LRes.Error);
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure
|
|
begin Status('Echec reseau'); end);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Log(' recu ' + Length(LRes.Container).ToString + ' octets');
|
|
if not ASilent then
|
|
TThread.Queue(nil, procedure begin Status('Dechiffrement...'); end);
|
|
|
|
LSw := TStopwatch.StartNew;
|
|
// Volontairement AVANT de retenir l'ETag : un echec ici doit laisser
|
|
// FETag vide pour que le prochain essai retelecharge.
|
|
LPlain := DecryptContainer(LRes.Container, APwd);
|
|
LSw.Stop;
|
|
FETag := LRes.ETag;
|
|
Log(' dechiffre en ' + LSw.ElapsedMilliseconds.ToString + ' ms');
|
|
|
|
// Ecrit APRES un dechiffrement reussi seulement, et avec son ETag :
|
|
// les deux doivent rester coherents.
|
|
try
|
|
// 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 ecrit - protege par biometrie/code')
|
|
else if LCanAuth then
|
|
Log(' cache ecrit - cle simple (Keystore a refuse la contrainte)')
|
|
else
|
|
Log(' cache ecrit - AUCUNE protection : pas d''authentification ici');
|
|
except
|
|
// La classe compte autant que le message : "methode introuvable"
|
|
// designe une signature JNI fausse, pas un probleme de stockage.
|
|
on E: Exception do
|
|
Log(' cache non ecrit : ' + E.ClassName + ' - ' + E.Message);
|
|
end;
|
|
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
FSyncPwd := APwd; // il vient d'ouvrir un conteneur : il est bon
|
|
try
|
|
AdoptVault(LPlain);
|
|
except
|
|
on E: Exception do
|
|
if not ASilent then
|
|
Status('Instantane illisible : ' + E.Message);
|
|
end;
|
|
end);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Log('ERREUR ' + E.ClassName + ' : ' + E.Message);
|
|
// Le cas de loin le plus frequent, et le message par defaut ne le
|
|
// dit pas : GCM echoue a la verification quand la cle est fausse.
|
|
//
|
|
// 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('Echec - mot de passe de sync incorrect ?'); end);
|
|
end;
|
|
end;
|
|
finally
|
|
LClient.Free;
|
|
TThread.Queue(nil, procedure begin SetBusy(False); end);
|
|
end;
|
|
end).Start;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Liste et recherche
|
|
---------------------------------------------------------------------------- }
|
|
|
|
/// 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] := 'Tous les dossiers';
|
|
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.OnFolderTap(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
LRow: TRectangle;
|
|
LH: Single;
|
|
begin
|
|
Touch;
|
|
FreeAndNil(FFolderPanel);
|
|
if Length(FFolderNames) < 2 then Exit; // rien a choisir
|
|
|
|
LH := 54;
|
|
// PLACEMENT EXPLICITE, aucune convention d'alignement : l'ordre d'empilement
|
|
// de FMX s'est revele instable des qu'on detruit et recree des enfants.
|
|
FFolderPanel := Surface(FLayList);
|
|
FFolderPanel.Align := TAlignLayout.None;
|
|
FFolderPanel.SetBounds(16, 66, FLayList.Width - 32,
|
|
Length(FFolderNames) * LH + 12);
|
|
FFolderPanel.Fill.Color := COL_SURFACE;
|
|
|
|
for I := 0 to High(FFolderNames) do
|
|
begin
|
|
LRow := FlatButton(FFolderPanel, FFolderNames[I], OnFolderPick, I = FFolderSel);
|
|
LRow.Align := TAlignLayout.None;
|
|
LRow.SetBounds(6, 6 + I * LH, FFolderPanel.Width - 12, LH - 6);
|
|
LRow.Tag := I;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.OnFolderPick(Sender: TObject);
|
|
begin
|
|
if Sender is TRectangle 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 = '';
|
|
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 + ' entrees'
|
|
else
|
|
FCount.Text := Length(FFiltered).ToString + ' / ' +
|
|
FVault.LiveCount.ToString;
|
|
end;
|
|
|
|
procedure TForm8.OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem);
|
|
begin
|
|
if AItem <> nil then ShowDetail(AItem.Tag);
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Detail : reveler et copier
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.OnRevealTap(Sender: TObject);
|
|
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), 'Masquer');
|
|
end
|
|
else
|
|
begin
|
|
FRowValues[I].Text := MASK;
|
|
SetButtonText(TRectangle(Sender), 'Afficher');
|
|
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, 'Code 2FA')
|
|
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 + ' copie - presse-papiers efface dans ' +
|
|
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.
|
|
TApplicationEvent.WillBecomeInactive:
|
|
if FLayList.Visible or FLayDetail.Visible then
|
|
begin
|
|
FLayDetail.Visible := False;
|
|
FLayList.Visible := False;
|
|
FLayUnlock.Visible := True;
|
|
end;
|
|
// Et le clair est reellement jete quand l'application passe derriere.
|
|
TApplicationEvent.EnteredBackground:
|
|
if FVault.Count > 0 then LockVault;
|
|
end;
|
|
end;
|
|
|
|
{ ----------------------------------------------------------------------------
|
|
Journal
|
|
---------------------------------------------------------------------------- }
|
|
|
|
procedure TForm8.Log(const AMsg: string);
|
|
begin
|
|
// Appele depuis le thread de calcul : la mise a jour d'un controle FMX doit
|
|
// repasser par le thread principal.
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
FLog.Lines.Add(AMsg);
|
|
FLog.GoToTextEnd;
|
|
end);
|
|
end;
|
|
|
|
procedure TForm8.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('Verrouille apres ' + AUTOLOCK_MINUTES.ToString + ' min d''inactivite');
|
|
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.
|