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

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
+14 -210
View File
@@ -1,157 +1,36 @@
unit PMA.Theme;
{
Palette et controles peints a la main.
La palette, et le fond de la forme.
POURQUOI PAS UN STYLE : aucun des styles livres avec Delphi n'est pense pour
un mobile - degrades gris, angles vifs, cadres epais, tous datent de
l'epoque bureau. Et la journee a montre que tout ce qui passe par un gabarit
de style peut ne pas exister dans le style charge : le gabarit de ligne de
liste, l'invite de recherche, la ligne de detail ont disparu tour a tour.
CE QU'IL RESTE D'UN THEME. Cette unite habillait autrefois des boutons, des
surfaces et des libelles peints a la main, et chargeait un style pour les
controles natifs qu'on ne reecrivait pas. L'interface est passee au moteur du
systeme (android-client/web) : il n'y a plus un seul controle FMX a habiller,
donc tout cela est parti - avec le style vendu, qui n'avait plus rien a styler.
Un style RESTE charge malgre tout, comme socle : les champs de saisie, la
liste et le memo sont des controles natifs qu'on ne va pas reecrire, et sans
style ils s'afficheraient en clair. Tout le reste - boutons, surfaces,
couleurs - est peint ici, ou rien ne peut disparaitre.
Le style vient de Dark.style, livre avec Delphi, recopie dans le depot pour
que la compilation ne depende pas d'un chemin d'installation.
Ce qui subsiste sert au CADRE, que la page ne peut pas atteindre : le fond de
la forme, visible un instant avant le premier rendu du moteur, et les deux
couleurs que prennent les barres systeme. Elles doivent suivre celles de
app.html, sinon la jonction se voit.
}
interface
uses
// FMX.Graphics pour TBrush, que PaintBackground prend en parametre.
System.UITypes, System.Classes, FMX.Types, FMX.Graphics, FMX.Objects,
FMX.StdCtrls;
System.UITypes, FMX.Types, FMX.Graphics;
const
// Releve sur la recherche globale du telephone, qui est la reference pour
// tout ce qui se touche - l'application doit ressembler a l'endroit ou elle
// tourne, pas seulement au service qu'elle prolonge.
//
// CE QUI FAIT CE STYLE, et qu'il faut tenir : un DEGRADE bleu en fond, des
// blocs qui ne sont que du BLANC TRANSLUCIDE pose dessus, AUCUNE bordure, de
// grands arrondis, du texte blanc. La profondeur vient de la transparence,
// pas des filets - c'est pour ca que les cadres ont disparu.
// Releve sur la recherche globale du telephone : un degrade bleu, des blocs
// qui ne sont que du blanc translucide pose dessus, aucune bordure.
COL_BG_TOP = TAlphaColor($FF3E6394); // haut du degrade
COL_BG = TAlphaColor($FF1B3563); // bas du degrade, et repli uni
COL_SURFACE = TAlphaColor($1FFFFFFF); // bloc : 12 % de blanc
COL_RAISED = TAlphaColor($2EFFFFFF); // bouton au repos : 18 %
COL_ACCENT = TAlphaColor($4DFFFFFF); // action principale : 30 %
COL_LINE = TAlphaColor($00000000); // plus de filet : garde pour l'API
COL_TEXT = TAlphaColor($FFFFFFFF);
COL_MUTED = TAlphaColor($B3E8F0FA);
COL_ON_ACC = TAlphaColor($FFFFFFFF); // le blanc reste lisible sur 30 %
/// Un seul arrondi pour tout ce qui se touche - champs comme boutons. Il
/// doit suivre celui de make-style.ps1, qui l'applique aux champs natifs.
RADIUS = 14;
/// A appeler une fois, avant la creation de la forme.
procedure ApplyDarkTheme;
/// Bouton plat. APrimary le remplit de cyan ; sinon il reste sobre.
/// Renvoie un TRectangle et non un TButton : c'est justement pour ne plus
/// dependre du gabarit qu'un TButton irait chercher dans le style.
function FlatButton(AParent: TFmxObject; const AText: string;
AOnClick: TNotifyEvent; APrimary: Boolean = False): TRectangle;
/// Fixe un arrondi choisi, au lieu de la pilule automatique. Pour les petits
/// boutons de ligne, qu'une pilule rendrait presque ovales.
procedure SetCornerRadius(AButton: TRectangle; AValue: Single);
/// Le libelle est un enfant du bouton, retenu par TagObject.
procedure SetButtonText(AButton: TRectangle; const AText: string);
procedure SetButtonEnabled(AButton: TRectangle; AEnabled: Boolean);
/// Bloc de fond, coins arrondis, filet discret.
function Surface(AParent: TFmxObject): TRectangle;
/// Intitule au-dessus d'une valeur : petit et discret, sans majuscules.
procedure SectionLabel(ALabel: TLabel);
COL_BG = TAlphaColor($FF1B3563); // bas du degrade
/// Applique le degrade bleu du fond. A poser sur le Fill de la forme.
procedure PaintBackground(AFill: TBrush);
/// Met un libelle a la palette. AMuted pour les intitules discrets.
procedure Tint(ALabel: TLabel; ASize: Single; AMuted: Boolean = False);
implementation
uses
System.SysUtils, System.Types, FMX.Styles, FMX.Controls;
{$R 'theme\theme.res' 'theme\theme.rc'}
procedure ApplyDarkTheme;
var
LStyle: TFmxObject;
begin
try
// La lecture appartient a TStyleStreaming, l'application a TStyleManager.
LStyle := TStyleStreaming.LoadFromResource(HInstance, 'PMDARKSTYLE', RT_RCDATA);
if LStyle <> nil then
TStyleManager.SetStyle(LStyle);
except
// Rien : l'apparence par defaut reste utilisable.
end;
end;
type
/// Retient l'etat au repos pour le restaurer apres l'appui. Un TRectangle
/// n'a pas d'etat « enfonce » : sans retour visuel, on ne sait pas si le
/// doigt a porte.
TPressFeedback = class(TComponent)
public
Rest: TAlphaColor;
procedure Down(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
X, Y: Single);
procedure Up(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
X, Y: Single);
procedure Leave(Sender: TObject);
end;
procedure TPressFeedback.Down(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
if Sender is TRectangle then TRectangle(Sender).Opacity := 0.62;
end;
procedure TPressFeedback.Up(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
begin
if Sender is TRectangle then TRectangle(Sender).Opacity := 1;
end;
procedure TPressFeedback.Leave(Sender: TObject);
begin
if Sender is TRectangle then TRectangle(Sender).Opacity := 1;
end;
function Surface(AParent: TFmxObject): TRectangle;
begin
Result := TRectangle.Create(AParent);
Result.Parent := AParent;
Result.Fill.Color := COL_SURFACE;
// AUCUNE bordure, et un grand arrondi : c'est la translucidite qui detache
// le bloc du fond. Un filet rendrait tout de suite l'air « application de
// bureau ».
Result.Stroke.Kind := TBrushKind.None;
Result.XRadius := 20;
Result.YRadius := 20;
end;
/// Intitule au-dessus d'une valeur. Ni majuscules ni petites capitales : rien
/// n'est en majuscules dans la reference, le second plan s'y marque par la
/// couleur et la taille seules.
procedure SectionLabel(ALabel: TLabel);
begin
ALabel.StyledSettings := [];
ALabel.TextSettings.Font.Size := 12;
ALabel.TextSettings.FontColor := COL_MUTED;
end;
/// Peint le degrade de fond sur une forme.
procedure PaintBackground(AFill: TBrush);
begin
AFill.Kind := TBrushKind.Gradient;
@@ -160,79 +39,4 @@ begin
// Rien de plus : un TGradient neuf descend deja du haut vers le bas.
end;
function FlatButton(AParent: TFmxObject; const AText: string;
AOnClick: TNotifyEvent; APrimary: Boolean): TRectangle;
var
LCaption: TLabel;
LFeedback: TPressFeedback;
begin
Result := TRectangle.Create(AParent);
Result.Parent := AParent;
// MEME ARRONDI QUE LES CHAMPS. Un bouton en pilule a cote d'un champ a 14
// donnait deux vocabulaires de forme sur la meme ligne ; la coherence vaut
// mieux que la fidelite a la reference sur ce point.
Result.XRadius := RADIUS;
Result.YRadius := RADIUS;
Result.Cursor := crHandPoint;
Result.Stroke.Kind := TBrushKind.None;
// La difference entre principal et secondaire tient a l'opacite du blanc,
// pas a une couleur : la reference n'a aucun accent colore.
if APrimary then Result.Fill.Color := COL_ACCENT
else Result.Fill.Color := COL_RAISED;
Result.OnClick := AOnClick;
LCaption := TLabel.Create(Result);
LCaption.Parent := Result;
LCaption.Align := TAlignLayout.Client;
LCaption.HitTest := False; // le clic doit atteindre le rectangle
LCaption.Text := AText;
LCaption.TextSettings.HorzAlign := TTextAlign.Center;
LCaption.TextSettings.VertAlign := TTextAlign.Center;
LCaption.StyledSettings := []; // on gouverne police ET couleur
LCaption.TextSettings.Font.Size := 15;
if APrimary then LCaption.TextSettings.FontColor := COL_ON_ACC
else LCaption.TextSettings.FontColor := COL_TEXT;
Result.TagObject := LCaption;
// Le retour d'appui appartient au bouton : il vit et meurt avec lui.
LFeedback := TPressFeedback.Create(Result);
LFeedback.Rest := Result.Fill.Color;
Result.OnMouseDown := LFeedback.Down;
Result.OnMouseUp := LFeedback.Up;
Result.OnMouseLeave := LFeedback.Leave;
end;
procedure SetCornerRadius(AButton: TRectangle; AValue: Single);
begin
if AButton = nil then Exit;
// Detache le recalcul automatique, sinon la prochaine mise en page le
// ramenerait a la pilule.
AButton.OnResize := nil;
AButton.XRadius := AValue;
AButton.YRadius := AValue;
end;
procedure SetButtonText(AButton: TRectangle; const AText: string);
begin
if (AButton <> nil) and (AButton.TagObject is TLabel) then
TLabel(AButton.TagObject).Text := AText;
end;
procedure SetButtonEnabled(AButton: TRectangle; AEnabled: Boolean);
begin
if AButton = nil then Exit;
AButton.Enabled := AEnabled;
// Enabled seul ne se voit pas sur une forme peinte : sans ce grise, un
// bouton inactif invite a insister.
if AEnabled then AButton.Opacity := 1 else AButton.Opacity := 0.4;
end;
procedure Tint(ALabel: TLabel; ASize: Single; AMuted: Boolean);
begin
ALabel.StyledSettings := [];
ALabel.TextSettings.Font.Size := ASize;
if AMuted then ALabel.TextSettings.FontColor := COL_MUTED
else ALabel.TextSettings.FontColor := COL_TEXT;
end;
end.
+4 -8
View File
@@ -3,10 +3,9 @@
#
# POURQUOI : la cible Deploy de MSBuild reconstruit library\lib avant d'appeler
# aapt, ce qui efface toute bibliotheque native ajoutee a la main. Or ce projet
# n'a pas d'entrees de deploiement fonctionnelles (voir README), donc libsk4d.so
# - le moteur Skia, indispensable au rendu de l'arabe - ne peut y arriver
# autrement. On laisse donc Deploy faire son travail, puis on remet la
# bibliotheque et on refait aapt / zipalign / signature.
# n'a pas d'entrees de deploiement fonctionnelles (voir README), donc nos icones
# ne peuvent y arriver autrement. On laisse Deploy faire son travail, puis on
# remet ce qu'il a efface et on refait aapt / zipalign / signature.
#
# A lancer depuis la racine du depot, apres un Deploy reussi.
@@ -18,10 +17,7 @@ $jdk = 'C:\Program Files\Eclipse Adoptium\jdk-11.0.15.10-hotspot'
$pac = "$bds\bin\paclient.exe"
$p = '.\Android64\Debug\pmserverApk'
# 1. Remettre Skia, que Deploy vient d'effacer.
Copy-Item "$bds\binandroid64\libsk4d.so" "$p\library\lib\arm64-v8a\libsk4d.so" -Force
# 1 bis. Nos icones par-dessus celles de Delphi. Meme raison que pour Skia :
# 1. Nos icones par-dessus celles de Delphi :
# les proprietes Android_LauncherIcon* et Android_AdaptiveIcon* du .dproj
# devraient suffire, mais rien ne les deploie ici.
Copy-Item "$PSScriptRoot\android-res\*" "$p\res\" -Recurse -Force
-63
View File
@@ -1,63 +0,0 @@
# Fabrique pm-dark.style depuis le Dark.style livre avec Delphi, en recolorant
# les deux controles dont le fond reste visible.
#
# POURQUOI PATCHER PLUTOT QUE RENDRE TRANSPARENT : Dark.style ne contient aucun
# gabarit 'transparentedit' ni 'transparentmemostyle' - un StyleLookup vers eux
# retombe silencieusement sur le gabarit normal, avec son fond gris. Le champ
# de recherche et le journal juraient donc avec le reste de l'interface, qui
# est peint.
#
# Tout le reste de l'application ne depend plus d'aucun gabarit : ce style ne
# sert qu'aux controles natifs qu'on ne reecrit pas.
#
# A relancer si la palette de PMA.Theme change, puis recompiler la ressource :
# brcc32 theme.rc -fotheme.res
$ErrorActionPreference = 'Stop'
$src = 'C:\Program Files (x86)\Embarcadero\Studio\23.0\Redist\styles\Fmx\Dark.style'
$dst = Join-Path $PSScriptRoot 'pm-dark.style'
# Doivent suivre les constantes de PMA.Theme.
# Un champ est CREUX : moins de blanc qu'un bouton (18 %) et bien moins que
# l'action principale (30 %). Sans cet ecart, une saisie ressemble a une
# commande - le mot de passe avait l'air d'un bouton.
$surface = 'x1AFFFFFF'
$border = 'x00000000' # plus de filet : la reference n'en a aucun
$text = 'xFFFFFFFF' # COL_TEXT
$lines = Get-Content $src
$patched = 0
foreach ($style in 'editstyle', 'memostyle') {
$at = ($lines | Select-String -Pattern "StyleName = '$style'" | Select-Object -First 1).LineNumber
if (-not $at) { Write-Warning "$style introuvable"; continue }
# Un champ de saisie prend la forme d'une pilule, comme la barre de
# recherche d'Android ; un memo garde ses coins sobres.
# 14, comme les boutons de ligne : une pilule faisait ressembler un champ
# de saisie a une commande, et l'arrondi restait excessif meme une fois le
# remplissage creuse.
$radius = '14.000000000000000000'
# La fenetre couvre le bloc 'background' qui suit immediatement le nom.
for ($i = $at; $i -lt [Math]::Min($at + 24, $lines.Count); $i++) {
switch -Regex ($lines[$i]) {
'Fill\.Color = x' { $lines[$i] = $lines[$i] -replace 'x[0-9A-Fa-f]{8}', $surface; $patched++ }
'Stroke\.Color = x' { $lines[$i] = $lines[$i] -replace 'x[0-9A-Fa-f]{8}', $border; $patched++ }
'XRadius = ' { $lines[$i] = $lines[$i] -replace '[\d.]+$', $radius }
'YRadius = ' { $lines[$i] = $lines[$i] -replace '[\d.]+$', $radius }
}
}
# Couleur du texte saisi : 'foreground' vient juste apres le fond.
for ($i = $at; $i -lt [Math]::Min($at + 34, $lines.Count); $i++) {
if ($lines[$i] -match "StyleName = 'foreground'") {
$lines[$i+1] = $lines[$i+1] -replace 'x[0-9A-Fa-f]{8}', $text
break
}
}
}
Set-Content $dst $lines -Encoding UTF8
"pm-dark.style ecrit, $patched couleurs remplacees"
File diff suppressed because it is too large Load Diff
-1
View File
@@ -1 +0,0 @@
PMDARKSTYLE RCDATA "pm-dark.style"
+119 -4
View File
@@ -58,7 +58,12 @@
detail - dont les blocs sont eux-memes du blanc translucide. */
background: linear-gradient(var(--bg-top), var(--bg-bot));
}
#detail { transform: translateX(100%); }
/* Trois vues sur un rail. Le deverrouillage est a gauche, la liste au
milieu, le detail a droite ; deux classes sur le corps disent ou on est. */
#list, #detail { transform: translateX(100%); }
body.on-list #unlock { transform: translateX(-100%); }
body.on-list #list { transform: translateX(0); }
body.on-detail #unlock { transform: translateX(-100%); }
body.on-detail #list { transform: translateX(-22%); }
body.on-detail #detail { transform: translateX(0); }
@@ -163,6 +168,26 @@
.bar i { display: block; height: 100%; background: var(--text);
transition: width 1s linear; }
/* --- deverrouillage ----------------------------------------------------- */
.status { color: var(--muted); margin: 22px 4px 14px; min-height: 20px; }
.stack { display: flex; flex-direction: column; gap: 8px; }
.pair { display: flex; gap: 8px; }
.pair .btn { flex: 1; }
.field-in {
width: 100%; height: 46px; padding: 0 14px; margin-top: 8px;
border: 0; border-radius: var(--radius-s);
background: rgba(255,255,255,.10); color: var(--text);
font: inherit; outline: none;
}
.field-in::placeholder { color: var(--muted); }
#log {
margin: 10px 0 0; padding: 10px 12px; max-height: 34vh; overflow: auto;
background: rgba(0,0,0,.20); border-radius: var(--radius-s);
font: 11px/1.45 monospace; white-space: pre-wrap; word-break: break-all;
-webkit-user-select: text; user-select: text;
}
[hidden] { display: none !important; }
.toast {
position: fixed; left: 12px; right: 12px; bottom: 14px;
background: rgba(10,20,40,.92); color: var(--text);
@@ -173,6 +198,31 @@
.toast.on { opacity: 1; }
</style>
<div class="screen" id="unlock">
<div class="scroll">
<div class="status" id="status"></div>
<div class="stack">
<button class="btn wide main" id="btnOpen">&#10140;&nbsp; Open vault</button>
<button class="btn wide" id="btnSync">&#8635;&nbsp; Sync</button>
<div class="pair">
<button class="btn" id="btnCfg">&#9881;&nbsp; Server settings</button>
<button class="btn" id="btnLog">&#8801;&nbsp; Log</button>
</div>
</div>
<div id="cfg" hidden>
<input class="field-in" id="url" placeholder="endpoint URL"
autocomplete="off" autocorrect="off" autocapitalize="none"
spellcheck="false" inputmode="url">
<input class="field-in" id="tok" placeholder="bearer token"
autocomplete="off" autocorrect="off" autocapitalize="none"
spellcheck="false">
<input class="field-in" id="pwd" placeholder="sync password"
type="password" autocomplete="off">
</div>
<pre id="log" hidden></pre>
</div>
</div>
<div class="screen" id="list">
<div class="top">
<div class="search">
@@ -240,7 +290,41 @@ function drain() {
}, 60);
}
var entries = [], folders = [], folder = '', query = '', view = 'list';
var entries = [], folders = [], folder = '', query = '', view = 'unlock';
// --- deverrouillage --------------------------------------------------------
var elUrl = document.getElementById('url'),
elTok = document.getElementById('tok'),
elPwd = document.getElementById('pwd');
// Les trois valeurs remontent A LA PERTE DU FOCUS, pas a chaque touche : c'est
// une navigation par champ modifie au lieu d'une par caractere. Delphi les
// garde, la page n'est qu'un editeur.
function pushConfig() {
send('cfg?u=' + encodeURIComponent(elUrl.value.trim())
+ '&t=' + encodeURIComponent(elTok.value.trim())
+ '&p=' + encodeURIComponent(elPwd.value));
}
[elUrl, elTok, elPwd].forEach(function (el) {
el.addEventListener('change', pushConfig);
el.addEventListener('blur', pushConfig);
});
document.getElementById('btnOpen').addEventListener('click', function () {
send('openvault');
});
document.getElementById('btnSync').addEventListener('click', function () {
pushConfig(); // ce qui est tape mais pas encore quitte compte aussi
send('sync');
});
document.getElementById('btnCfg').addEventListener('click', function () {
var c = document.getElementById('cfg');
c.hidden = !c.hidden;
});
document.getElementById('btnLog').addEventListener('click', function () {
var l = document.getElementById('log');
l.hidden = !l.hidden;
});
function esc(s) {
return String(s == null ? '' : s).replace(/[&<>"]/g, function (c) {
@@ -376,6 +460,7 @@ document.getElementById('fields').addEventListener('click', function (ev) {
function goList() {
document.body.classList.remove('on-detail');
document.body.classList.add('on-list');
view = 'list';
// Les valeurs en clair partent avec la vue, pas seulement de l'ecran.
detailRows = [];
@@ -393,10 +478,40 @@ var PM = {
folder = '';
q.value = ''; query = '';
document.body.classList.remove('searching', 'on-detail');
document.body.classList.add('on-list');
view = 'list';
renderFolders();
renderRows();
},
showUnlock: function () {
document.body.classList.remove('on-list', 'on-detail', 'searching');
view = 'unlock';
},
setStatus: function (text) {
document.getElementById('status').textContent = text;
},
/// Etat des deux actions : ouvrir n'a de sens qu'avec un coffre local
/// lisible, et synchroniser s'appelle autrement quand il n'y en a pas.
setActions: function (canOpen, syncLabel, busy) {
var o = document.getElementById('btnOpen'), s = document.getElementById('btnSync');
o.hidden = !canOpen;
s.innerHTML = '&#8635;&nbsp; ' + syncLabel;
o.disabled = busy; s.disabled = busy;
o.style.opacity = busy ? .4 : 1;
s.style.opacity = busy ? .4 : 1;
},
setConfig: function (url, tok, pwd, show) {
elUrl.value = url; elTok.value = tok; elPwd.value = pwd;
// Replier des champs vides revient a cacher la seule chose a faire.
document.getElementById('cfg').hidden = !show;
},
log: function (line) {
var l = document.getElementById('log');
l.textContent += line + '\n';
l.scrollTop = l.scrollHeight;
},
clearLog: function () { document.getElementById('log').textContent = ''; },
setDetail: function (json) { renderDetail(JSON.parse(json)); },
setTotp: function (code, left, period) {
var v = document.getElementById('totpv');
@@ -424,8 +539,8 @@ var PM = {
document.getElementById('fields').innerHTML = '';
document.getElementById('folders').innerHTML = '';
q.value = '';
document.body.classList.remove('on-detail', 'searching');
view = 'list';
document.body.classList.remove('on-list', 'on-detail', 'searching');
view = 'unlock';
}
};
window.PM = PM;
+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.
+6 -16
View File
@@ -3,16 +3,6 @@ program pmserverApk;
uses
System.StartUpCopy,
FMX.Forms,
// Skia remplace le moteur de rendu de FMX. Ce n'est pas un choix esthetique :
// celui d'origine ne met pas en forme les ecritures complexes - pas de
// reordonnancement bidirectionnel, pas de liaison des lettres arabes - et un
// nom de piece jointe en arabe s'affichait donc en desordre. Skia embarque
// HarfBuzz et fait ce travail correctement.
//
// Le prix est libsk4d.so, 25 Mo, a poser dans lib/arm64-v8a de l'APK. Le
// deploiement automatique s'en chargerait ; ici il ne deploie rien, donc la
// bibliotheque est mise en place a la main comme le manifeste et les .dex.
FMX.Skia,
mainApk in 'mainApk.pas' {Form8},
PMA.Crypto in 'android-client\PMA.Crypto.pas',
PMA.TestVector in 'android-client\PMA.TestVector.pas',
@@ -29,13 +19,13 @@ uses
{$R *.res}
begin
// AVANT Application.Initialize : le canevas est choisi a l'initialisation,
// et le basculer ensuite ne rattrape pas ce qui est deja construit.
GlobalUseSkia := True;
// NI SKIA NI STYLE. Les deux servaient les controles FMX : Skia pour mettre
// en forme l'arabe dans les libelles - le moteur d'origine ne lie pas les
// lettres et ne reordonne pas le bidirectionnel - et le style pour que les
// champs et les listes ne s'affichent pas en clair. L'interface est passee au
// moteur du systeme, qui fait les deux lui-meme ; il ne reste plus un seul
// controle FMX a habiller. Au passage, libsk4d.so ne pese plus dans l'APK.
Application.Initialize;
// Le style se pose apres l'initialisation mais avant la forme : l'appliquer
// plus tard laisserait les controles deja construits avec l'ancien.
ApplyDarkTheme;
Application.CreateForm(TForm8, Form8);
Application.Run;
end.