Zaki/Password-Manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(android): the unlock screen moves to HTML, Skia and the style go

Browse Source 
The caret in an Android TEdit does not land where you touch, which makes a long bearer token impossible to correct - the reason the last FMX screen had to go. A field in the engine inherits the system's text handling (caret, selection, handles, paste) for free.

With no FMX control left, two things became dead weight and are gone: the vendored Dark.style, which had nothing left to style, and Skia - 25 MB carried solely so FMX labels would shape Arabic. The engine does its own shaping; checked on the device, an Arabic filename still reads correctly. The APK drops from 22.0 to 12.7 MB.

Delphi stays the owner of the server settings; the page only edits them and hands them back when a field loses focus, one navigation per changed field rather than one per keystroke.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
r-zakarya
2026-08-17 10:40:06 +01:00
parent d1d5d29879
commit 77809b09c8
8 changed files with 244 additions and 5914 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mainApk.pas
+101 -193
View File
@@ -2,11 +2,16 @@ unit mainApk;
{
Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
DEUX MOITIES. Le deverrouillage est en FMX - il touche a la biometrie et au
Keystore, et tient en trois boutons. La liste et le detail sont une page
HTML rendue par le moteur du systeme (PMA.WebUI, android-client/web) : les
gabarits FMX se sont montres trop incertains sur mobile, et le moteur met en
forme l'arabe correctement sans qu'on ait rien a faire.
PLUS AUCUN CONTROLE FMX. Les trois ecrans - deverrouillage, liste, detail -
sont une page HTML rendue par le moteur du systeme (PMA.WebUI,
android-client/web). Cette unite ne tient plus que ce que la page ne peut pas
atteindre : Keystore, biometrie, presse-papiers sensible, FLAG_SECURE, reseau
et dechiffrement.
Le dernier a partir a ete l'ecran de deverrouillage : dans un TEdit Android, le
curseur ne se place pas ou on le touche, ce qui rend un jeton long
incorrigible. Un champ du moteur herite de la saisie du systeme - curseur,
selection, poignees, collage - sans qu'on ecrive une ligne.
Le pont tient en deux gestes : evaluateJavascript pour descendre les donnees,
et une navigation cmd:// interceptee pour remonter les actions. Aucun serveur
@@ -90,15 +95,11 @@ type
// 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;
/// Coordonnees du serveur. Delphi en est le detenteur ; la page ne fait
/// que les editer et les lui renvoyer quand un champ est quitte.
FUrl, FToken, FPwd: string;
// --- ecrans 2 et 3 : liste et detail, rendus par le moteur du systeme
// --- l'interface entiere, rendue par le moteur du systeme
FLayWeb: TLayout;
FWeb: TWebBrowser;
/// La page n'accepte rien avant sa fin de chargement. Ce qui arrive trop
@@ -126,8 +127,6 @@ type
procedure Touch;
procedure OnIdleTimer(Sender: TObject);
procedure BuildUnlock;
procedure ShowUnlock;
procedure ShowList;
procedure OnTotpTick(Sender: TObject);
@@ -148,8 +147,6 @@ type
procedure AdoptVault(const APlainJson: string);
procedure LockVault;
procedure OnToggleSettings(Sender: TObject);
procedure OnToggleLog(Sender: TObject);
// --- page HTML
procedure BuildWeb;
@@ -161,6 +158,7 @@ type
/// Envoie un appel a la page, ou le met en attente si elle n'est pas prete.
procedure WebCall(const AJavaScript: string);
procedure PushVault;
procedure PushConfig;
procedure OpenEntry(AVaultIndex: Integer);
procedure OnClipTimer(Sender: TObject);
procedure OnHardwareBack(Sender: TObject; var Key: Word;
@@ -187,16 +185,20 @@ uses
{$R *.fmx}
const
// Pictogrammes des boutons, EN POINTS DE CODE : ce fichier n'a pas de marque
// d'ordre d'octets, Delphi le lit en ANSI, et un caractere ecrit tel quel y
// deviendrait deux ou trois glyphes. Tous choisis dans le plan de base et
// parmi les plus courants - une police systeme qui n'en aurait pas
// afficherait un rectangle vide, ce qui se verrait tout de suite.
GLYPH_OPEN = #$279C; // fleche pleine
GLYPH_SYNC = #$21BB; // fleche circulaire
GLYPH_GEAR = #$2699; // engrenage
GLYPH_LOG = #$2261; // trois traits
/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
/// l'encodage JSON : une apostrophe ou un retour a la ligne dans un nom de
/// compte casserait sinon l'appel entier.
function JsArg(const AValue: string): string;
var
LStr: TJSONString;
begin
LStr := TJSONString.Create(AValue);
try
Result := LStr.ToJSON;
finally
LStr.Free;
end;
end;
{ ----------------------------------------------------------------------------
Construction
@@ -220,7 +222,6 @@ begin
FVault := TVault.Create;
BuildWeb;
BuildUnlock; // cree en dernier a l'ecran = au-dessus de la page
FClipTimer := TTimer.Create(Self);
FClipTimer.Enabled := False;
@@ -247,6 +248,7 @@ begin
IFMXApplicationEventService, LEvents) then
LEvents.SetApplicationEventHandler(HandleAppEvent);
PushConfig;
ShowUnlock;
// Ouverture automatique du coffre local. Differee apres la construction :
@@ -262,141 +264,37 @@ begin
inherited;
end;
/// Cree un bouton empile en haut. En FMX, des controles alignes en haut
/// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en
/// haut. Chaque Build* cree donc du bas vers le haut.
function TopButton(AParent: TFmxObject; const AText: string;
AOnClick: TNotifyEvent; AHeight: Single = 52; APrimary: Boolean = False): TRectangle;
begin
Result := FlatButton(AParent, AText, AOnClick, APrimary);
Result.Align := TAlignLayout.Top;
Result.Margins.Rect := RectF(16, 8, 16, 0);
Result.Height := AHeight;
end;
function TopEdit(AParent: TFmxObject; const APrompt, AText: string;
APassword: Boolean = False): TEdit;
begin
Result := TEdit.Create(AParent);
Result.Parent := AParent;
Result.Align := TAlignLayout.Top;
Result.Margins.Rect := RectF(8, 4, 8, 0);
Result.TextPrompt := APrompt;
Result.Text := AText;
Result.Password := APassword;
end;
procedure TForm8.BuildUnlock;
var
LUrl, LToken: string;
LRow: TLayout;
begin
FLayUnlock := TLayout.Create(Self);
FLayUnlock.Parent := Self;
FLayUnlock.Align := TAlignLayout.Client;
// Journal en bas : il ne sert plus qu'au diagnostic, mais un echec reseau ou
// JNI sans trace se debugue a l'aveugle.
FLog := TMemo.Create(Self);
FLog.Parent := FLayUnlock;
FLog.Align := TAlignLayout.Bottom;
FLog.Height := 150;
FLog.Margins.Rect := RectF(8, 8, 8, 8);
FLog.ReadOnly := True;
// Sans repli, un message d'exception est coupe net au bord du memo - et
// c'est toujours la fin qui nomme la cause.
FLog.WordWrap := True;
FLog.TextSettings.Font.Family := 'monospace';
FLog.TextSettings.Font.Size := 11;
// Masque par defaut : il ne sert qu'au diagnostic, et il occupait un tiers
// de l'ecran a chaque lancement. Le bouton Journal le ramene.
FLog.Visible := False;
// --- du bas vers le haut (voir TopButton)
FLaySettings := TLayout.Create(Self);
FLaySettings.Parent := FLayUnlock;
FLaySettings.Align := TAlignLayout.Top;
FLaySettings.Height := 174;
// Les trois vont ensemble : ce sont les coordonnees du serveur, dont le mot
// de passe fait partie. Il occupait l'ecran d'accueil en permanence alors
// qu'on n'y touche qu'une fois. TopEdit empile du bas vers le haut, d'ou
// l'ordre inverse ici.
FPwd := TopEdit(FLaySettings, 'sync password', TEST_PWD, True);
FToken := TopEdit(FLaySettings, 'bearer token', FIRSTRUN_TOKEN);
FUrl := TopEdit(FLaySettings, 'endpoint URL', FIRSTRUN_URL);
FPwd.Margins.Rect := RectF(16, 8, 16, 0);
FToken.Margins.Rect := RectF(16, 8, 16, 0);
FUrl.Margins.Rect := RectF(16, 8, 16, 0);
// Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
if LoadDeviceSettings(LUrl, LToken) then
begin
FUrl.Text := LUrl;
if LToken <> '' then FToken.Text := LToken;
end;
// Replier des champs vides revient a cacher la seule chose a faire.
FLaySettings.Visible := (FUrl.Text.Trim = '') or (FToken.Text.Trim = '')
or (FPwd.Text = '');
// Deux commandes discretes cote a cote : elles ne servent qu'au reglage et
// au diagnostic, et n'ont pas a peser autant que les actions principales.
LRow := TLayout.Create(Self);
LRow.Parent := FLayUnlock;
LRow.Align := TAlignLayout.Top;
LRow.Height := 48;
LRow.Margins.Rect := RectF(16, 8, 16, 0);
FBtnLog := FlatButton(LRow, GLYPH_LOG + ' Log', OnToggleLog);
FBtnLog.Align := TAlignLayout.Right;
FBtnLog.Width := 120;
FBtnLog.Margins.Left := 8;
FBtnSettings := FlatButton(LRow, GLYPH_GEAR + ' Server settings', OnToggleSettings);
FBtnSettings.Align := TAlignLayout.Client;
FBtnSync := TopButton(FLayUnlock, GLYPH_SYNC + ' Sync', DoSync);
// Accentue : c'est l'action attendue quand aucun coffre n'est encore la.
FBtnOpen := TopButton(FLayUnlock, GLYPH_OPEN + ' Open vault', DoOpenLocal, 52, True);
FStatus := TLabel.Create(Self);
FStatus.Parent := FLayUnlock;
FStatus.Align := TAlignLayout.Top;
FStatus.Margins.Rect := RectF(16, 24, 16, 4);
FStatus.Height := 26;
Tint(FStatus, 15, True);
end;
procedure TForm8.ShowUnlock;
var
LCanOpen: Boolean;
begin
// La vue du moteur est une vraie vue du systeme : elle se peint PAR-DESSUS
// tout ce que FMX dessine. Masquer le conteneur ne suffit pas toujours -
// masquer les deux, si.
FWeb.Visible := False;
FLayWeb.Visible := False;
FLayUnlock.Visible := True;
FLayWeb.Visible := True;
FWeb.Visible := True;
WebCall('PM.showUnlock()');
FWebView := 'unlock';
// Le bouton d'ouverture n'a de sens que si un coffre local existe ET qu'il
// s'est deja laisse ouvrir ; sinon seul le telechargement peut en produire
// un utilisable.
FBtnOpen.Visible := HasVault and not FVaultUnreadable;
if HasVault and not FVaultUnreadable then
LCanOpen := HasVault and not FVaultUnreadable;
if LCanOpen then
begin
if VaultNeedsAuth then
Status('Vault on this device - protected')
else
Status('Vault on this device');
SetButtonText(FBtnSync, GLYPH_SYNC + ' Sync');
WebCall('PM.setActions(true, "Sync", false)');
end
else
begin
Status('No local vault - first download');
SetButtonText(FBtnSync, GLYPH_SYNC + ' Download vault');
WebCall('PM.setActions(false, "Download vault", false)');
end;
end;
procedure TForm8.ShowList;
begin
FTotpTimer.Enabled := False;
FLayUnlock.Visible := False;
FLayWeb.Visible := True;
FWeb.Visible := True;
FWebView := 'list';
@@ -438,21 +336,6 @@ begin
end;
end;
procedure TForm8.OnToggleSettings(Sender: TObject);
begin
FLaySettings.Visible := not FLaySettings.Visible;
// Sa place doit etre REPOSEE a chaque apparition : cree masque, FMX le
// replace en tete de la pile quand il devient visible, et les deux champs
// se retrouvaient au-dessus du titre. Index 0 le renvoie en bas, juste
// au-dessus du journal, ou on attend des reglages.
if FLaySettings.Visible then FLaySettings.Index := 0;
end;
procedure TForm8.OnToggleLog(Sender: TObject);
begin
FLog.Visible := not FLog.Visible;
end;
{ ----------------------------------------------------------------------------
La page : liste et detail
---------------------------------------------------------------------------- }
@@ -462,7 +345,11 @@ begin
FLayWeb := TLayout.Create(Self);
FLayWeb.Parent := Self;
FLayWeb.Align := TAlignLayout.Client;
FLayWeb.Visible := False;
// VISIBLE DES LE DEPART : la page porte maintenant l'ecran de
// deverrouillage, donc il n'y a plus rien d'autre a montrer. Elle n'est
// masquee qu'au passage en arriere-plan, pour ne pas laisser la liste des
// comptes dans l'apercu des applications recentes.
FLayWeb.Visible := True;
FWeb := TWebBrowser.Create(Self);
FWeb.Parent := FLayWeb;
@@ -482,6 +369,26 @@ begin
SetLength(FWebPending, 0);
end;
/// Descend les coordonnees du serveur dans les champs de la page.
procedure TForm8.PushConfig;
var
LUrl, LToken: string;
begin
FUrl := FIRSTRUN_URL;
FToken := FIRSTRUN_TOKEN;
FPwd := TEST_PWD;
// Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
if LoadDeviceSettings(LUrl, LToken) then
begin
FUrl := LUrl;
if LToken <> '' then FToken := LToken;
end;
WebCall(Format('PM.setConfig(%s, %s, %s, %s)',
[JsArg(FUrl), JsArg(FToken), JsArg(FPwd),
// Replier des champs vides revient a cacher la seule chose a faire.
LowerCase(BoolToStr((FUrl = '') or (FToken = '') or (FPwd = ''), True))]));
end;
procedure TForm8.WebCall(const AJavaScript: string);
begin
if FWebReady then
@@ -490,21 +397,6 @@ begin
FWebPending := FWebPending + [AJavaScript];
end;
/// Passe une chaine a la page. Elle voyage en litteral JavaScript, d'ou
/// l'encodage JSON : un apostrophe ou un retour a la ligne dans un nom de
/// compte casserait sinon l'appel entier.
function JsArg(const AValue: string): string;
var
LStr: TJSONString;
begin
LStr := TJSONString.Create(AValue);
try
Result := LStr.ToJSON;
finally
LStr.Free;
end;
end;
procedure TForm8.PushVault;
begin
WebCall('PM.setVault(' + JsArg(VaultToJson(FVault)) + ')');
@@ -568,6 +460,22 @@ begin
else if LAction = 'lock' then
LockVault
// Les coordonnees du serveur, renvoyees quand un champ est quitte. Delphi
// en reste le detenteur : la page n'est qu'un editeur, et rien ne les lui
// redemande.
else if LAction = 'cfg' then
begin
FUrl := TNetEncoding.URL.Decode(Param('u')).Trim;
FToken := TNetEncoding.URL.Decode(Param('t')).Trim;
FPwd := TNetEncoding.URL.Decode(Param('p'));
end
else if LAction = 'openvault' then
DoOpenLocal(nil)
else if LAction = 'sync' then
DoSync(nil)
else if LAction = 'copy' then
begin
// LES SECRETS NE TRANSITENT PAS PAR LE PONT. La page envoie un rang,
@@ -621,6 +529,7 @@ begin
// Les lignes du detail portent des valeurs EN CLAIR (FRows) : les detruire
// fait partie du verrouillage, pas de l'affichage.
FCurrent := Default(TVaultEntry);
PushConfig;
ShowUnlock;
end;
@@ -686,14 +595,15 @@ begin
// 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);
FetchAndDecrypt(FUrl, FToken, FSyncPwd, True);
except
on E: Exception do
begin
// Un coffre local illisible se remplace, il ne se repare pas.
Log('Local vault corrupt: ' + E.Message);
ClearVault;
ShowUnlock;
PushConfig;
ShowUnlock;
end;
end;
end
@@ -702,7 +612,8 @@ begin
// ShowUnlock AVANT le message : il repositionne le statut selon ce que
// l'appareil detient, et ecraserait donc l'explication.
FVaultUnreadable := True;
ShowUnlock;
PushConfig;
ShowUnlock;
Log('Local vault unreadable: ' + LastStoreError);
Status('Local vault unreadable - see log');
end;
@@ -757,7 +668,8 @@ begin
FVaultUnreadable := True;
Log('No usable protection on this device - vault kept but unreadable');
Log(' ' + LastBiometricError);
ShowUnlock;
PushConfig;
ShowUnlock;
Status('Screen lock missing - download again to replace the cache');
end;
else
@@ -774,20 +686,18 @@ 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;
LUrl := FUrl;
LTok := FToken;
// Ce qui est tape l'emporte : c'est ainsi qu'on corrige un mot de passe
// range qui ne convient plus.
LPwd := FPwd.Text;
LPwd := FPwd;
if LPwd = '' then LPwd := FSyncPwd;
if LPwd = '' then
begin
Status('Sync password required');
Exit;
end;
FLog.Lines.Clear;
WebCall('PM.clearLog()');
// MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait
// qu'a un bouton pres : synchroniser reconstruit le coffre depuis le serveur
@@ -1036,11 +946,10 @@ begin
// recentes : masquer ici, c'est ne pas y laisser la liste des comptes.
// Le masquage est IMMEDIAT et sans condition - c'est lui qui protege.
TApplicationEvent.WillBecomeInactive:
if FLayWeb.Visible then
if FWebView <> 'unlock' then
begin
FWeb.Visible := False;
FLayWeb.Visible := False;
FLayUnlock.Visible := True;
end;
// Le clair, lui, survit a un bref passage en arriere-plan.
@@ -1063,7 +972,6 @@ begin
begin
// Retour a temps : on rend l'ecran quitte, pas un autre. La page a
// garde son etat, elle n'a ete que masquee.
FLayUnlock.Visible := False;
FLayWeb.Visible := True;
FWeb.Visible := True;
Touch;
@@ -1079,13 +987,12 @@ end;
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.
// Appele depuis le thread de calcul : le moteur ne se pilote que depuis le
// thread principal.
TThread.Queue(nil,
procedure
begin
FLog.Lines.Add(AMsg);
FLog.GoToTextEnd;
WebCall('PM.log(' + JsArg(AMsg) + ')');
end);
end;
@@ -1111,14 +1018,15 @@ end;
procedure TForm8.Status(const AMsg: string);
begin
FStatus.Text := AMsg;
WebCall('PM.setStatus(' + JsArg(AMsg) + ')');
end;
procedure TForm8.SetBusy(ABusy: Boolean);
begin
FBusy := ABusy;
SetButtonEnabled(FBtnSync, not ABusy);
SetButtonEnabled(FBtnOpen, not ABusy);
WebCall(Format('PM.setActions(%s, "Sync", %s)',
[LowerCase(BoolToStr(HasVault and not FVaultUnreadable, True)),
LowerCase(BoolToStr(ABusy, True))]));
end;
end.