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:
r-zakarya
2026-08-15 10:35:09 +01:00
parent 3232f6f163
commit 20ba2438df
6 changed files with 431 additions and 63 deletions
+152
View File
@@ -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.
+43
View File
@@ -16,9 +16,20 @@ uses
System.SysUtils, System.Classes, System.JSON, System.Generics.Collections;
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
Uuid, Title, Site, Username, Password, Folder, Tags, Kind, Totp: string;
Fields: TArray<TVaultField>;
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,
/// sinon le site, sinon l'identifiant. Une entree sans aucun des trois
/// existe (note vide) et ne doit pas apparaitre comme une ligne muette.
@@ -59,6 +70,11 @@ uses
{ TVaultEntry }
function TVaultEntry.IsNote: Boolean;
begin
Result := SameText(Kind, 'note');
end;
function TVaultEntry.Display: string;
begin
Result := Title.Trim;
@@ -98,6 +114,32 @@ begin
Result := AVal.Value;
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);
var
LRoot, LObj: TJSONObject;
@@ -131,6 +173,7 @@ begin
FEntries[N].Kind := LObj.GetValue<string>('kind', 'login');
FEntries[N].Totp := LObj.GetValue<string>('totp_secret', '');
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.
FEntries[N].Deleted := LObj.GetValue<Integer>('deleted', 0) = 1;
Inc(N);
+15
View File
@@ -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
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 :
- **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.Biometric.pas` | authentification via `FMX.BiometricAuth` |
| `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 |
| `make-testvector.js` | régénère le vecteur avec WebCrypto |
| `testvector.md` | valeurs attendues, étage par étage |
+35 -1
View File
@@ -22,7 +22,8 @@ program selftest;
uses
System.SysUtils, System.Hash, System.NetEncoding, System.Diagnostics,
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
GFailures: Integer = 0;
@@ -40,6 +41,19 @@ begin
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
LSalt, LKey: TBytes;
LPlain: string;
@@ -107,6 +121,26 @@ begin
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;
if GFailures = 0 then
Writeln('Tout est bon.')