feat(android): TOTP codes and custom fields in the detail screen
The detail screen showed site, username and password and silently dropped everything else - custom fields, notes, 2FA. It is now built per entry rather than from a fixed template: every row is a caption, a value, and whether it is secret, so reveal and copy exist once instead of once per kind of field. Two rows stay special on purpose. A note's body is stored in the password column, so it gets its own caption and no mask. The 2FA code is the only live row - refreshed every second, placed first, since it is what you pull a phone out for. PMA.Totp takes bare base32 or an otpauth:// URI; both travel in snapshots depending on how the entry was created. Checked against all six RFC 6238 vectors, including T=20000000000, which overflows 32 bits. The rows hold plaintext, so clearing them is part of locking, not of navigating away. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,152 @@
|
|||||||
|
unit PMA.Totp;
|
||||||
|
{
|
||||||
|
Codes TOTP (RFC 6238) - la raison principale de sortir son telephone.
|
||||||
|
|
||||||
|
Rien de specifique a Android : base32, HMAC-SHA1, troncature dynamique. Le
|
||||||
|
poste Windows a deja son implementation en JavaScript ; celle-ci est la
|
||||||
|
meme mecanique, verifiee contre les memes vecteurs de la RFC.
|
||||||
|
|
||||||
|
Le secret arrive soit en base32 nu, soit en URI otpauth:// - les deux
|
||||||
|
circulent dans les instantanes selon la facon dont l'entree a ete creee.
|
||||||
|
On accepte les deux, et l'URI fournit en prime sa periode et son nombre de
|
||||||
|
chiffres quand ils different des valeurs par defaut.
|
||||||
|
}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.SysUtils;
|
||||||
|
|
||||||
|
/// Code courant pour ASecret, et le temps restant avant renouvellement.
|
||||||
|
/// Retourne '' si le secret est vide ou illisible - jamais d'exception : un
|
||||||
|
/// mauvais secret ne doit pas empecher l'affichage du reste de l'entree.
|
||||||
|
function TotpNow(const ASecret: string; out ASecondsLeft, APeriod: Integer): string;
|
||||||
|
|
||||||
|
/// Meme chose a un instant donne. Existe pour que les vecteurs de la RFC
|
||||||
|
/// soient verifiables : ils sont tous exprimes a une date fixe.
|
||||||
|
function TotpAt(const ASecret: string; AUnix: Int64;
|
||||||
|
out ASecondsLeft, APeriod: Integer): string;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Classes, System.Hash, System.DateUtils, System.NetEncoding;
|
||||||
|
|
||||||
|
const
|
||||||
|
B32 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';
|
||||||
|
|
||||||
|
function Base32Decode(const S: string): TBytes;
|
||||||
|
var
|
||||||
|
I, LBits, LValue, LIdx, LPos: Integer;
|
||||||
|
LCh: Char;
|
||||||
|
begin
|
||||||
|
SetLength(Result, Length(S)); // majorant : 5 bits par caractere
|
||||||
|
LBits := 0; LValue := 0; LIdx := 0;
|
||||||
|
for I := 1 to Length(S) do
|
||||||
|
begin
|
||||||
|
LCh := UpCase(S[I]);
|
||||||
|
// Espaces, tirets et remplissage sont ignores : les secrets se
|
||||||
|
// recopient souvent par groupes de quatre.
|
||||||
|
LPos := Pos(LCh, B32);
|
||||||
|
if LPos = 0 then Continue;
|
||||||
|
LValue := (LValue shl 5) or (LPos - 1);
|
||||||
|
Inc(LBits, 5);
|
||||||
|
if LBits >= 8 then
|
||||||
|
begin
|
||||||
|
Result[LIdx] := (LValue shr (LBits - 8)) and $FF;
|
||||||
|
Inc(LIdx);
|
||||||
|
Dec(LBits, 8);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
SetLength(Result, LIdx);
|
||||||
|
end;
|
||||||
|
|
||||||
|
/// Valeur d'un parametre de requete dans une URI otpauth://, ou '' s'il
|
||||||
|
/// manque. Assez pour secret/period/digits, sans tirer un analyseur d'URI.
|
||||||
|
function UriParam(const AUri, AName: string): string;
|
||||||
|
var
|
||||||
|
LStart, LEnd: Integer;
|
||||||
|
LKey: string;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
LKey := '?' + AName + '=';
|
||||||
|
LStart := Pos(LKey, AUri);
|
||||||
|
if LStart = 0 then
|
||||||
|
begin
|
||||||
|
LKey := '&' + AName + '=';
|
||||||
|
LStart := Pos(LKey, AUri);
|
||||||
|
if LStart = 0 then Exit;
|
||||||
|
end;
|
||||||
|
Inc(LStart, Length(LKey));
|
||||||
|
LEnd := LStart;
|
||||||
|
while (LEnd <= Length(AUri)) and (AUri[LEnd] <> '&') do Inc(LEnd);
|
||||||
|
Result := Copy(AUri, LStart, LEnd - LStart);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TotpNow(const ASecret: string; out ASecondsLeft, APeriod: Integer): string;
|
||||||
|
begin
|
||||||
|
// Toujours en UTC : un decalage horaire ferait un code faux tout en
|
||||||
|
// paraissant parfaitement valide.
|
||||||
|
Result := TotpAt(ASecret,
|
||||||
|
DateTimeToUnix(TTimeZone.Local.ToUniversalTime(Now), True),
|
||||||
|
ASecondsLeft, APeriod);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TotpAt(const ASecret: string; AUnix: Int64;
|
||||||
|
out ASecondsLeft, APeriod: Integer): string;
|
||||||
|
var
|
||||||
|
LSecret: string;
|
||||||
|
LDigits, LOffset, LBinary, LMod, I: Integer;
|
||||||
|
LKey, LMsg, LHash: TBytes;
|
||||||
|
LCounter: Int64;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
ASecondsLeft := 0;
|
||||||
|
APeriod := 30;
|
||||||
|
LDigits := 6;
|
||||||
|
|
||||||
|
LSecret := ASecret.Trim;
|
||||||
|
if LSecret = '' then Exit;
|
||||||
|
|
||||||
|
if LSecret.ToLower.StartsWith('otpauth://') then
|
||||||
|
begin
|
||||||
|
if UriParam(LSecret, 'period') <> '' then
|
||||||
|
APeriod := StrToIntDef(UriParam(LSecret, 'period'), 30);
|
||||||
|
if UriParam(LSecret, 'digits') <> '' then
|
||||||
|
LDigits := StrToIntDef(UriParam(LSecret, 'digits'), 6);
|
||||||
|
LSecret := UriParam(LSecret, 'secret');
|
||||||
|
if LSecret = '' then Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (APeriod <= 0) or (LDigits < 6) or (LDigits > 8) then Exit;
|
||||||
|
|
||||||
|
LKey := Base32Decode(LSecret);
|
||||||
|
if Length(LKey) = 0 then Exit;
|
||||||
|
|
||||||
|
LCounter := AUnix div APeriod;
|
||||||
|
ASecondsLeft := APeriod - (AUnix mod APeriod);
|
||||||
|
|
||||||
|
// Compteur sur 8 octets, gros-boutiste.
|
||||||
|
SetLength(LMsg, 8);
|
||||||
|
for I := 7 downto 0 do
|
||||||
|
begin
|
||||||
|
LMsg[I] := Byte(LCounter and $FF);
|
||||||
|
LCounter := LCounter shr 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
LHash := THashSHA1.GetHMACAsBytes(LMsg, LKey);
|
||||||
|
if Length(LHash) < 20 then Exit;
|
||||||
|
|
||||||
|
// Troncature dynamique : les 4 derniers bits designent l'offset.
|
||||||
|
LOffset := LHash[19] and $0F;
|
||||||
|
LBinary := ((LHash[LOffset] and $7F) shl 24) or
|
||||||
|
((LHash[LOffset + 1] and $FF) shl 16) or
|
||||||
|
((LHash[LOffset + 2] and $FF) shl 8) or
|
||||||
|
(LHash[LOffset + 3] and $FF);
|
||||||
|
|
||||||
|
LMod := 1;
|
||||||
|
for I := 1 to LDigits do LMod := LMod * 10;
|
||||||
|
Result := Format('%.*d', [LDigits, LBinary mod LMod]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -16,9 +16,20 @@ uses
|
|||||||
System.SysUtils, System.Classes, System.JSON, System.Generics.Collections;
|
System.SysUtils, System.Classes, System.JSON, System.Generics.Collections;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
/// Un champ personnalise. Le poste Windows nomme la cle "is_secret" - c'est
|
||||||
|
/// lui qui decide si la valeur s'affiche masquee.
|
||||||
|
TVaultField = record
|
||||||
|
Caption, Value: string;
|
||||||
|
Secret: Boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
TVaultEntry = record
|
TVaultEntry = record
|
||||||
Uuid, Title, Site, Username, Password, Folder, Tags, Kind, Totp: string;
|
Uuid, Title, Site, Username, Password, Folder, Tags, Kind, Totp: string;
|
||||||
|
Fields: TArray<TVaultField>;
|
||||||
Deleted: Boolean;
|
Deleted: Boolean;
|
||||||
|
/// Le corps d'une note EST son mot de passe cote stockage : il n'y a pas
|
||||||
|
/// de colonne separee. L'affichage doit donc l'intituler autrement.
|
||||||
|
function IsNote: Boolean;
|
||||||
/// Ce qu'on affiche en tete de ligne : le nom donne par l'utilisateur,
|
/// Ce qu'on affiche en tete de ligne : le nom donne par l'utilisateur,
|
||||||
/// sinon le site, sinon l'identifiant. Une entree sans aucun des trois
|
/// sinon le site, sinon l'identifiant. Une entree sans aucun des trois
|
||||||
/// existe (note vide) et ne doit pas apparaitre comme une ligne muette.
|
/// existe (note vide) et ne doit pas apparaitre comme une ligne muette.
|
||||||
@@ -59,6 +70,11 @@ uses
|
|||||||
|
|
||||||
{ TVaultEntry }
|
{ TVaultEntry }
|
||||||
|
|
||||||
|
function TVaultEntry.IsNote: Boolean;
|
||||||
|
begin
|
||||||
|
Result := SameText(Kind, 'note');
|
||||||
|
end;
|
||||||
|
|
||||||
function TVaultEntry.Display: string;
|
function TVaultEntry.Display: string;
|
||||||
begin
|
begin
|
||||||
Result := Title.Trim;
|
Result := Title.Trim;
|
||||||
@@ -98,6 +114,32 @@ begin
|
|||||||
Result := AVal.Value;
|
Result := AVal.Value;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
/// Les champs personnalises : tableau d'objets {label, value, is_secret}.
|
||||||
|
/// Un champ sans intitule ET sans valeur ne vaut pas une ligne a l'ecran.
|
||||||
|
function ParseFields(const AVal: TJSONValue): TArray<TVaultField>;
|
||||||
|
var
|
||||||
|
LArr: TJSONArray;
|
||||||
|
LObj: TJSONObject;
|
||||||
|
I, N: Integer;
|
||||||
|
begin
|
||||||
|
Result := nil;
|
||||||
|
if not (AVal is TJSONArray) then Exit;
|
||||||
|
LArr := AVal as TJSONArray;
|
||||||
|
SetLength(Result, LArr.Count);
|
||||||
|
N := 0;
|
||||||
|
for I := 0 to LArr.Count - 1 do
|
||||||
|
begin
|
||||||
|
if not (LArr.Items[I] is TJSONObject) then Continue;
|
||||||
|
LObj := LArr.Items[I] as TJSONObject;
|
||||||
|
Result[N].Caption := LObj.GetValue<string>('label', '');
|
||||||
|
Result[N].Value := LObj.GetValue<string>('value', '');
|
||||||
|
Result[N].Secret := LObj.GetValue<Boolean>('is_secret', False);
|
||||||
|
if (Result[N].Caption = '') and (Result[N].Value = '') then Continue;
|
||||||
|
Inc(N);
|
||||||
|
end;
|
||||||
|
SetLength(Result, N);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TVault.LoadFromJson(const APlainJson: string);
|
procedure TVault.LoadFromJson(const APlainJson: string);
|
||||||
var
|
var
|
||||||
LRoot, LObj: TJSONObject;
|
LRoot, LObj: TJSONObject;
|
||||||
@@ -131,6 +173,7 @@ begin
|
|||||||
FEntries[N].Kind := LObj.GetValue<string>('kind', 'login');
|
FEntries[N].Kind := LObj.GetValue<string>('kind', 'login');
|
||||||
FEntries[N].Totp := LObj.GetValue<string>('totp_secret', '');
|
FEntries[N].Totp := LObj.GetValue<string>('totp_secret', '');
|
||||||
FEntries[N].Tags := TagsToString(LObj.GetValue('tags'));
|
FEntries[N].Tags := TagsToString(LObj.GetValue('tags'));
|
||||||
|
FEntries[N].Fields := ParseFields(LObj.GetValue('custom_fields'));
|
||||||
// deleted arrive en 0/1 depuis nos conteneurs ; absent = vivant.
|
// deleted arrive en 0/1 depuis nos conteneurs ; absent = vivant.
|
||||||
FEntries[N].Deleted := LObj.GetValue<Integer>('deleted', 0) = 1;
|
FEntries[N].Deleted := LObj.GetValue<Integer>('deleted', 0) = 1;
|
||||||
Inc(N);
|
Inc(N);
|
||||||
|
|||||||
@@ -65,6 +65,19 @@ téléchargement peut en produire un. La liste filtre à la frappe sur le nom, l
|
|||||||
site, l'identifiant et les étiquettes — **pas** sur le mot de passe : personne
|
site, l'identifiant et les étiquettes — **pas** sur le mot de passe : personne
|
||||||
ne cherche par mot de passe, et le comparer allongerait son séjour en mémoire.
|
ne cherche par mot de passe, et le comparer allongerait son séjour en mémoire.
|
||||||
|
|
||||||
|
Le détail est construit **par entrée**, pas d'après un gabarit fixe : site,
|
||||||
|
identifiant, mot de passe et champs personnalisés se ramènent tous à un
|
||||||
|
intitulé, une valeur, et le fait qu'elle soit secrète. Les traiter séparément
|
||||||
|
aurait dupliqué révélation et copie autant de fois qu'il y a de sortes de
|
||||||
|
champ. Deux exceptions assumées : le corps d'une **note**, qui est stocké dans
|
||||||
|
le champ mot de passe et s'affiche donc sous un autre intitulé, sans masque ;
|
||||||
|
et le **code 2FA**, seule ligne vivante, rafraîchie chaque seconde et placée en
|
||||||
|
tête — c'est ce qu'on vient chercher sur un téléphone.
|
||||||
|
|
||||||
|
Le TOTP ([PMA.Totp.pas](PMA.Totp.pas)) accepte le base32 nu comme l'URI
|
||||||
|
`otpauth://`, les deux circulant dans les instantanés selon la façon dont
|
||||||
|
l'entrée a été créée. Vérifié contre les six vecteurs de la RFC 6238.
|
||||||
|
|
||||||
Deux règles tenues dans l'interface, pas ailleurs :
|
Deux règles tenues dans l'interface, pas ailleurs :
|
||||||
|
|
||||||
- **Le clair est jeté quand l'application passe en arrière-plan.** L'écran est
|
- **Le clair est jeté quand l'application passe en arrière-plan.** L'écran est
|
||||||
@@ -127,6 +140,8 @@ Node ouvre le fichier et pas le client, le défaut est dans le client.
|
|||||||
| `PMA.Store.pas` | coffre local chiffré sous une clé du Keystore |
|
| `PMA.Store.pas` | coffre local chiffré sous une clé du Keystore |
|
||||||
| `PMA.Biometric.pas` | authentification via `FMX.BiometricAuth` |
|
| `PMA.Biometric.pas` | authentification via `FMX.BiometricAuth` |
|
||||||
| `PMA.Vault.pas` | l'instantané en mémoire : lecture et recherche |
|
| `PMA.Vault.pas` | l'instantané en mémoire : lecture et recherche |
|
||||||
|
| `PMA.Totp.pas` | codes TOTP (RFC 6238), base32 ou `otpauth://` |
|
||||||
|
| `selftest.dpr` | vérification console : conteneur + TOTP |
|
||||||
| `PMA.TestVector.pas` | le vecteur embarqué, plus référencé par l'interface |
|
| `PMA.TestVector.pas` | le vecteur embarqué, plus référencé par l'interface |
|
||||||
| `make-testvector.js` | régénère le vecteur avec WebCrypto |
|
| `make-testvector.js` | régénère le vecteur avec WebCrypto |
|
||||||
| `testvector.md` | valeurs attendues, étage par étage |
|
| `testvector.md` | valeurs attendues, étage par étage |
|
||||||
|
|||||||
@@ -22,7 +22,8 @@ program selftest;
|
|||||||
uses
|
uses
|
||||||
System.SysUtils, System.Hash, System.NetEncoding, System.Diagnostics,
|
System.SysUtils, System.Hash, System.NetEncoding, System.Diagnostics,
|
||||||
PMA.Crypto in 'PMA.Crypto.pas',
|
PMA.Crypto in 'PMA.Crypto.pas',
|
||||||
PMA.TestVector in 'PMA.TestVector.pas';
|
PMA.TestVector in 'PMA.TestVector.pas',
|
||||||
|
PMA.Totp in 'PMA.Totp.pas';
|
||||||
|
|
||||||
var
|
var
|
||||||
GFailures: Integer = 0;
|
GFailures: Integer = 0;
|
||||||
@@ -40,6 +41,19 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// URI plutot que base32 nu : elle porte les 8 chiffres de la RFC, et fait
|
||||||
|
// passer l'analyseur d'otpauth:// dans le meme mouvement.
|
||||||
|
const
|
||||||
|
RFC6238_URI = 'otpauth://totp/rfc?secret=' +
|
||||||
|
'GEZDGNBVGY3TQOJQGEZDGNBVGY3TQOJQ&digits=8';
|
||||||
|
|
||||||
|
procedure CheckTotp(AUnix: Int64; const AWant: string);
|
||||||
|
var
|
||||||
|
LLeft, LPeriod: Integer;
|
||||||
|
begin
|
||||||
|
Check('T=' + AUnix.ToString, TotpAt(RFC6238_URI, AUnix, LLeft, LPeriod), AWant);
|
||||||
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
LSalt, LKey: TBytes;
|
LSalt, LKey: TBytes;
|
||||||
LPlain: string;
|
LPlain: string;
|
||||||
@@ -107,6 +121,26 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// ---- TOTP, vecteurs de la RFC 6238 --------------------------------------
|
||||||
|
// Secret "12345678901234567890" en base32, 8 chiffres, aux instants publies
|
||||||
|
// par la RFC. C'est le seul moyen de verifier a la fois la base32, le HMAC
|
||||||
|
// et la troncature - un code plausible peut etre faux.
|
||||||
|
Writeln('TOTP (RFC 6238)...');
|
||||||
|
try
|
||||||
|
CheckTotp(59, '94287082');
|
||||||
|
CheckTotp(1111111109, '07081804');
|
||||||
|
CheckTotp(1111111111, '14050471');
|
||||||
|
CheckTotp(1234567890, '89005924');
|
||||||
|
CheckTotp(2000000000, '69279037');
|
||||||
|
CheckTotp(20000000000, '65353130');
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
Writeln(' ERREUR ', E.ClassName, ' : ', E.Message);
|
||||||
|
Inc(GFailures);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
Writeln;
|
Writeln;
|
||||||
if GFailures = 0 then
|
if GFailures = 0 then
|
||||||
Writeln('Tout est bon.')
|
Writeln('Tout est bon.')
|
||||||
|
|||||||
+184
-61
@@ -56,12 +56,20 @@ const
|
|||||||
{$I android-client\PMA.LocalConfig.inc}
|
{$I android-client\PMA.LocalConfig.inc}
|
||||||
|
|
||||||
type
|
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)
|
TForm8 = class(TForm)
|
||||||
private
|
private
|
||||||
FVault: TVault;
|
FVault: TVault;
|
||||||
FFiltered: TArray<Integer>; // indices dans FVault, resultat de la recherche
|
FFiltered: TArray<Integer>; // indices dans FVault, resultat de la recherche
|
||||||
FCurrent: TVaultEntry;
|
FCurrent: TVaultEntry;
|
||||||
FPwdShown: Boolean;
|
|
||||||
// L'ETag n'est conserve QUE si le dechiffrement qui a suivi a reussi :
|
// L'ETag n'est conserve QUE si le dechiffrement qui a suivi a reussi :
|
||||||
// envoyer If-None-Match sans detenir le clair correspondant fait
|
// envoyer If-None-Match sans detenir le clair correspondant fait
|
||||||
// economiser un telechargement pour se retrouver sans donnees.
|
// economiser un telechargement pour se retrouver sans donnees.
|
||||||
@@ -83,10 +91,21 @@ type
|
|||||||
FCount: TLabel;
|
FCount: TLabel;
|
||||||
|
|
||||||
// --- ecran 3 : detail
|
// --- 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;
|
FLayDetail: TLayout;
|
||||||
FDetTitle: TLabel;
|
FDetBody: TVertScrollBox;
|
||||||
FDetSite, FDetUser, FDetPwd, FDetMeta, FDetToast: TLabel;
|
FDetTitle, FDetToast: TLabel;
|
||||||
FBtnReveal: TButton;
|
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
|
// --- presse-papiers
|
||||||
FClipTimer: TTimer;
|
FClipTimer: TTimer;
|
||||||
@@ -99,6 +118,8 @@ type
|
|||||||
procedure ShowUnlock;
|
procedure ShowUnlock;
|
||||||
procedure ShowList;
|
procedure ShowList;
|
||||||
procedure ShowDetail(AVaultIndex: Integer);
|
procedure ShowDetail(AVaultIndex: Integer);
|
||||||
|
procedure ClearDetailRows;
|
||||||
|
procedure OnTotpTick(Sender: TObject);
|
||||||
|
|
||||||
procedure DoOpenLocal(Sender: TObject);
|
procedure DoOpenLocal(Sender: TObject);
|
||||||
// Separee de DoOpenLocal : une methode anonyme ne peut pas appeler une
|
// Separee de DoOpenLocal : une methode anonyme ne peut pas appeler une
|
||||||
@@ -135,7 +156,7 @@ var
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric;
|
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp;
|
||||||
|
|
||||||
{$R *.fmx}
|
{$R *.fmx}
|
||||||
|
|
||||||
@@ -167,6 +188,11 @@ begin
|
|||||||
FClipTimer.Interval := CLIPBOARD_CLEAR_SECONDS * 1000;
|
FClipTimer.Interval := CLIPBOARD_CLEAR_SECONDS * 1000;
|
||||||
FClipTimer.OnTimer := OnClipTimer;
|
FClipTimer.OnTimer := OnClipTimer;
|
||||||
|
|
||||||
|
FTotpTimer := TTimer.Create(Self);
|
||||||
|
FTotpTimer.Enabled := False;
|
||||||
|
FTotpTimer.Interval := 1000;
|
||||||
|
FTotpTimer.OnTimer := OnTotpTick;
|
||||||
|
|
||||||
// Le bouton retour materiel arrive comme une touche : sans ce gestionnaire
|
// 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.
|
// il ferme l'application depuis le detail, au lieu de revenir a la liste.
|
||||||
OnKeyUp := OnHardwareBack;
|
OnKeyUp := OnHardwareBack;
|
||||||
@@ -303,33 +329,19 @@ begin
|
|||||||
FSearch.OnChangeTracking := OnSearchChanged;
|
FSearch.OnChangeTracking := OnSearchChanged;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
/// Une ligne du detail : intitule discret, valeur, bouton Copier.
|
/// Intitule discret au-dessus d'une valeur. Meme forme pour toutes les
|
||||||
/// ATag porte ce qu'il faut copier (1 site, 2 identifiant, 3 mot de passe).
|
/// lignes, y compris celle du TOTP.
|
||||||
function DetailRow(AParent: TFmxObject; const ACaption: string; ATag: Integer;
|
function MakeRow(AParent: TFmxObject; const ACaption: string;
|
||||||
AOnCopy: TNotifyEvent; out AValue: TLabel): TLayout;
|
out AValue: TLabel): TLayout;
|
||||||
var
|
var
|
||||||
LCap: TLabel;
|
LCap: TLabel;
|
||||||
LBtn: TButton;
|
|
||||||
begin
|
begin
|
||||||
Result := TLayout.Create(AParent);
|
Result := TLayout.Create(nil); // detruite a la main, voir ClearDetailRows
|
||||||
Result.Parent := AParent;
|
Result.Parent := AParent;
|
||||||
Result.Align := TAlignLayout.Top;
|
Result.Align := TAlignLayout.Top;
|
||||||
Result.Height := 62;
|
Result.Height := 62;
|
||||||
Result.Margins.Rect := RectF(12, 10, 12, 0);
|
Result.Margins.Rect := RectF(12, 10, 12, 0);
|
||||||
|
|
||||||
// Pas de bouton sur une ligne purement informative (dossier, etiquettes) :
|
|
||||||
// un "Copier" inerte se clique quand meme.
|
|
||||||
if Assigned(AOnCopy) then
|
|
||||||
begin
|
|
||||||
LBtn := TButton.Create(Result);
|
|
||||||
LBtn.Parent := Result;
|
|
||||||
LBtn.Align := TAlignLayout.Right;
|
|
||||||
LBtn.Width := 90;
|
|
||||||
LBtn.Text := 'Copier';
|
|
||||||
LBtn.Tag := ATag;
|
|
||||||
LBtn.OnClick := AOnCopy;
|
|
||||||
end;
|
|
||||||
|
|
||||||
LCap := TLabel.Create(Result);
|
LCap := TLabel.Create(Result);
|
||||||
LCap.Parent := Result;
|
LCap.Parent := Result;
|
||||||
LCap.Align := TAlignLayout.Top;
|
LCap.Align := TAlignLayout.Top;
|
||||||
@@ -346,9 +358,21 @@ begin
|
|||||||
AValue.TextSettings.Font.Size := 16;
|
AValue.TextSettings.Font.Size := 16;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer;
|
||||||
|
AOnClick: TNotifyEvent): TButton;
|
||||||
|
begin
|
||||||
|
Result := TButton.Create(ARow);
|
||||||
|
Result.Parent := ARow;
|
||||||
|
Result.Align := TAlignLayout.Right;
|
||||||
|
Result.Margins.Left := 6;
|
||||||
|
Result.Width := 90;
|
||||||
|
Result.Text := AText;
|
||||||
|
Result.Tag := ATag;
|
||||||
|
Result.OnClick := AOnClick;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm8.BuildDetail;
|
procedure TForm8.BuildDetail;
|
||||||
var
|
var
|
||||||
LRowPwd: TLayout;
|
|
||||||
LBtnBack: TButton;
|
LBtnBack: TButton;
|
||||||
begin
|
begin
|
||||||
FLayDetail := TLayout.Create(Self);
|
FLayDetail := TLayout.Create(Self);
|
||||||
@@ -374,20 +398,11 @@ begin
|
|||||||
FDetToast.TextSettings.Font.Size := 12;
|
FDetToast.TextSettings.Font.Size := 12;
|
||||||
FDetToast.Opacity := 0.7;
|
FDetToast.Opacity := 0.7;
|
||||||
|
|
||||||
// Du bas vers le haut : dossier/tags, mot de passe, identifiant, site, titre.
|
// Defilant : une entree avec dix champs personnalises depasse l'ecran d'un
|
||||||
DetailRow(FLayDetail, 'Dossier / etiquettes', 0, nil, FDetMeta);
|
// telephone, et les lignes ne sont connues qu'a l'ouverture.
|
||||||
|
FDetBody := TVertScrollBox.Create(Self);
|
||||||
LRowPwd := DetailRow(FLayDetail, 'Mot de passe', 3, OnCopyTap, FDetPwd);
|
FDetBody.Parent := FLayDetail;
|
||||||
FBtnReveal := TButton.Create(LRowPwd);
|
FDetBody.Align := TAlignLayout.Client;
|
||||||
FBtnReveal.Parent := LRowPwd;
|
|
||||||
FBtnReveal.Align := TAlignLayout.Right;
|
|
||||||
FBtnReveal.Margins.Right := 6;
|
|
||||||
FBtnReveal.Width := 90;
|
|
||||||
FBtnReveal.Text := 'Afficher';
|
|
||||||
FBtnReveal.OnClick := OnRevealTap;
|
|
||||||
|
|
||||||
DetailRow(FLayDetail, 'Identifiant', 2, OnCopyTap, FDetUser);
|
|
||||||
DetailRow(FLayDetail, 'Site', 1, OnCopyTap, FDetSite);
|
|
||||||
|
|
||||||
FDetTitle := TLabel.Create(Self);
|
FDetTitle := TLabel.Create(Self);
|
||||||
FDetTitle.Parent := FLayDetail;
|
FDetTitle.Parent := FLayDetail;
|
||||||
@@ -428,6 +443,8 @@ end;
|
|||||||
|
|
||||||
procedure TForm8.ShowList;
|
procedure TForm8.ShowList;
|
||||||
begin
|
begin
|
||||||
|
// Quitter le detail rend ses valeurs en clair, et arrete le compte a rebours.
|
||||||
|
ClearDetailRows;
|
||||||
FLayUnlock.Visible := False;
|
FLayUnlock.Visible := False;
|
||||||
FLayDetail.Visible := False;
|
FLayDetail.Visible := False;
|
||||||
FLayList.Visible := True;
|
FLayList.Visible := True;
|
||||||
@@ -435,19 +452,55 @@ begin
|
|||||||
OnSearchChanged(nil);
|
OnSearchChanged(nil);
|
||||||
end;
|
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 := '';
|
||||||
|
// Detruites explicitement plutot que par DeleteChildren : le conteneur est
|
||||||
|
// un TVertScrollBox, dont les enfants comprennent ses propres barres.
|
||||||
|
for LRow in FRowCtls do LRow.Free;
|
||||||
|
SetLength(FRowCtls, 0);
|
||||||
|
SetLength(FRowValues, 0);
|
||||||
|
SetLength(FRowShown, 0);
|
||||||
|
SetLength(FRows, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm8.ShowDetail(AVaultIndex: Integer);
|
procedure TForm8.ShowDetail(AVaultIndex: Integer);
|
||||||
var
|
var
|
||||||
LMeta: string;
|
LMeta, LPwdCaption: string;
|
||||||
begin
|
I: Integer;
|
||||||
FCurrent := FVault.Entry(AVaultIndex);
|
LRow: TLayout;
|
||||||
FPwdShown := False;
|
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
|
||||||
|
ClearDetailRows;
|
||||||
|
FCurrent := FVault.Entry(AVaultIndex);
|
||||||
FDetTitle.Text := FCurrent.Display;
|
FDetTitle.Text := FCurrent.Display;
|
||||||
FDetSite.Text := FCurrent.Site;
|
|
||||||
FDetUser.Text := FCurrent.Username;
|
|
||||||
FDetPwd.Text := MASK;
|
|
||||||
FDetToast.Text := '';
|
FDetToast.Text := '';
|
||||||
FBtnReveal.Text := 'Afficher';
|
|
||||||
|
// 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;
|
LMeta := FCurrent.Folder;
|
||||||
if FCurrent.Tags <> '' then
|
if FCurrent.Tags <> '' then
|
||||||
@@ -455,12 +508,71 @@ begin
|
|||||||
if LMeta <> '' then LMeta := LMeta + ' - ';
|
if LMeta <> '' then LMeta := LMeta + ' - ';
|
||||||
LMeta := LMeta + FCurrent.Tags;
|
LMeta := LMeta + FCurrent.Tags;
|
||||||
end;
|
end;
|
||||||
FDetMeta.Text := LMeta;
|
Add('Dossier / etiquettes', LMeta, False);
|
||||||
|
|
||||||
|
SetLength(FRowValues, Length(FRows));
|
||||||
|
SetLength(FRowShown, Length(FRows));
|
||||||
|
SetLength(FRowCtls, Length(FRows));
|
||||||
|
|
||||||
|
// A REBOURS : des controles alignes en haut s'empilent dans l'ordre inverse
|
||||||
|
// de leur creation, donc la derniere ligne se cree en premier.
|
||||||
|
for I := High(FRows) downto 0 do
|
||||||
|
begin
|
||||||
|
LRow := MakeRow(FDetBody, FRows[I].Caption, LValue);
|
||||||
|
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;
|
||||||
|
|
||||||
|
// Le TOTP est la seule ligne vivante : creee en dernier, donc affichee en
|
||||||
|
// tete, parce que c'est ce qu'on vient chercher sur un telephone.
|
||||||
|
if FCurrent.Totp <> '' then
|
||||||
|
begin
|
||||||
|
LRow := MakeRow(FDetBody, 'Code 2FA', FTotpValue);
|
||||||
|
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;
|
||||||
|
|
||||||
FLayList.Visible := False;
|
FLayList.Visible := False;
|
||||||
FLayDetail.Visible := True;
|
FLayDetail.Visible := True;
|
||||||
end;
|
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);
|
procedure TForm8.OnBackTap(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
// Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail.
|
// Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail.
|
||||||
@@ -507,9 +619,10 @@ begin
|
|||||||
FETag := '';
|
FETag := '';
|
||||||
FVault.Clear;
|
FVault.Clear;
|
||||||
FList.Clear;
|
FList.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);
|
FCurrent := Default(TVaultEntry);
|
||||||
FDetPwd.Text := MASK;
|
|
||||||
FPwdShown := False;
|
|
||||||
ShowUnlock;
|
ShowUnlock;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -787,28 +900,38 @@ end;
|
|||||||
---------------------------------------------------------------------------- }
|
---------------------------------------------------------------------------- }
|
||||||
|
|
||||||
procedure TForm8.OnRevealTap(Sender: TObject);
|
procedure TForm8.OnRevealTap(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
begin
|
begin
|
||||||
FPwdShown := not FPwdShown;
|
if not (Sender is TButton) then Exit;
|
||||||
if FPwdShown then
|
I := TButton(Sender).Tag;
|
||||||
|
if (I < 0) or (I > High(FRows)) then Exit;
|
||||||
|
|
||||||
|
FRowShown[I] := not FRowShown[I];
|
||||||
|
if FRowShown[I] then
|
||||||
begin
|
begin
|
||||||
FDetPwd.Text := FCurrent.Password;
|
FRowValues[I].Text := FRows[I].Value;
|
||||||
FBtnReveal.Text := 'Masquer';
|
TButton(Sender).Text := 'Masquer';
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
FDetPwd.Text := MASK;
|
FRowValues[I].Text := MASK;
|
||||||
FBtnReveal.Text := 'Afficher';
|
TButton(Sender).Text := 'Afficher';
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm8.OnCopyTap(Sender: TObject);
|
procedure TForm8.OnCopyTap(Sender: TObject);
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
begin
|
begin
|
||||||
if not (Sender is TButton) then Exit;
|
if not (Sender is TButton) then Exit;
|
||||||
case TButton(Sender).Tag of
|
I := TButton(Sender).Tag;
|
||||||
1: CopyToClipboard(FCurrent.Site, 'Site');
|
// -1 : la ligne du TOTP, qui n'est pas dans FRows - sa valeur change chaque
|
||||||
2: CopyToClipboard(FCurrent.Username, 'Identifiant');
|
// periode et ne vit que dans FTotpCode. Copie sans l'espace d'affichage.
|
||||||
3: CopyToClipboard(FCurrent.Password, 'Mot de passe');
|
if I = -1 then
|
||||||
end;
|
CopyToClipboard(FTotpCode, 'Code 2FA')
|
||||||
|
else if (I >= 0) and (I <= High(FRows)) then
|
||||||
|
CopyToClipboard(FRows[I].Value, FRows[I].Caption);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm8.CopyToClipboard(const AText, ALabel: string);
|
procedure TForm8.CopyToClipboard(const AText, ALabel: string);
|
||||||
|
|||||||
+2
-1
@@ -9,7 +9,8 @@ uses
|
|||||||
PMA.SyncClient in 'android-client\PMA.SyncClient.pas',
|
PMA.SyncClient in 'android-client\PMA.SyncClient.pas',
|
||||||
PMA.Store in 'android-client\PMA.Store.pas',
|
PMA.Store in 'android-client\PMA.Store.pas',
|
||||||
PMA.Biometric in 'android-client\PMA.Biometric.pas',
|
PMA.Biometric in 'android-client\PMA.Biometric.pas',
|
||||||
PMA.Vault in 'android-client\PMA.Vault.pas';
|
PMA.Vault in 'android-client\PMA.Vault.pas',
|
||||||
|
PMA.Totp in 'android-client\PMA.Totp.pas';
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user