r-zakarya
9649dac7b2
The Keystore key now requires authentication, valid for 30 s afterwards - short enough that an unattended phone is not exploitable, long enough to decrypt and display. Time-bound rather than a per-use CryptoObject: BiometricPrompt's callback would need a Java class compiled into a jar, while FMX already bridges it. Two aliases, because the auth constraint is fixed when the key is created and cannot be added later. The file header records which key wrote it, so a read knows whether to authenticate first. A device with neither fingerprint nor lock screen cannot hold such a key, so SaveVault falls back to the plain key rather than giving up the cache. And a failed authentication no longer wipes the cache: the vault is intact, it is the user who cancelled - erasing it would cost a download and 4 s of derivation for a dismissed prompt.
402 lines
14 KiB
ObjectPascal
402 lines
14 KiB
ObjectPascal
unit mainApk;
|
|
{
|
|
Banc d'essai de la crypto du conteneur, avant toute interface reelle.
|
|
|
|
Deux etages testes SEPAREMENT, parce qu'un echec global ne dit pas ou :
|
|
|
|
1. PBKDF2 -> compare la cle derivee a TESTVECTOR_KEY_HEX.
|
|
Tourne AUSSI sur Windows : compile en Win64 pour valider
|
|
cet etage en quelques secondes, sans deployer sur telephone.
|
|
2. AES-GCM -> dechiffre et compare le SHA-256 du clair.
|
|
Android uniquement (javax.crypto via JNI).
|
|
|
|
Le calcul tourne dans un thread : 600 000 iterations HMAC gelent l'interface
|
|
sinon, et sur Android le systeme tuerait l'application pour non-reponse.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
|
|
System.Hash, System.Diagnostics, System.NetEncoding,
|
|
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
|
|
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
|
|
FMX.ScrollBox, FMX.Layouts, FMX.Edit;
|
|
|
|
const
|
|
// Parametres du banc d'essai, pre-remplis pour ne pas les retaper.
|
|
//
|
|
// Le port differe selon la plateforme : sur Windows on attaque Apache
|
|
// directement (80), sur Android on passe par "adb reverse tcp:8080 tcp:80",
|
|
// qui fait voir le PC comme 127.0.0.1 - ce qui satisfait au passage
|
|
// l'exemption HTTPS de l'endpoint, reservee a la boucle locale.
|
|
{$IF DEFINED(ANDROID)}
|
|
TEST_URL = 'http://127.0.0.1:8080/server-php/sync.php';
|
|
{$ELSE}
|
|
TEST_URL = 'http://127.0.0.1/server-php/sync.php';
|
|
{$ENDIF}
|
|
// Jeton d'un serveur de test local. Il n'authentifie qu'un appareil et ne
|
|
// donne acces qu'a du chiffre - mais a remplacer avant toute mise en ligne.
|
|
TEST_TOKEN = '8765e5bf426039e9888f44bfbab27d489d12b7dbaaa54c8c695ae6af8b2a820e';
|
|
|
|
type
|
|
TForm8 = class(TForm)
|
|
private
|
|
FLog: TMemo;
|
|
FBtn: TButton;
|
|
FBtnFetch: TButton;
|
|
FUrl, FToken, FPwd: TEdit;
|
|
// L'ETag n'est conserve QUE si le dechiffrement qui a suivi a reussi :
|
|
// envoyer If-None-Match sans detenir le clair correspondant fait
|
|
// economiser un telechargement pour se retrouver sans donnees. Le vrai
|
|
// client aura la meme regle, l'ETag etant lie au coffre en cache.
|
|
FETag: string;
|
|
procedure RunSelfTest(Sender: TObject);
|
|
procedure RunFetch(Sender: TObject);
|
|
procedure DoFetch(const LUrl, LTok, LPwd: string);
|
|
procedure CountEntries(const APlainJson: string);
|
|
procedure Log(const AMsg: string);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
var
|
|
Form8: TForm8;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.JSON, PMA.Crypto, PMA.TestVector, PMA.SyncClient, PMA.Store, PMA.Biometric;
|
|
|
|
{$R *.fmx}
|
|
|
|
constructor TForm8.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
Caption := 'PM - crypto self-test';
|
|
|
|
// ORDRE DE CREATION INVERSE : en FMX, des controles alignes en haut
|
|
// s'empilent a rebours de leur creation - le dernier cree se retrouve tout
|
|
// en haut. On cree donc du bas vers le haut pour obtenir URL, jeton, mot de
|
|
// passe, puis les deux boutons.
|
|
//
|
|
// Rien n'est persiste : c'est un banc d'essai, et le mot de passe de sync
|
|
// ouvre le coffre entier - il n'a pas a trainer sur le disque tant que le
|
|
// stockage Keystore n'est pas ecrit.
|
|
FBtn := TButton.Create(Self);
|
|
FBtn.Parent := Self;
|
|
FBtn.Align := TAlignLayout.Top;
|
|
FBtn.Margins.Rect := RectF(8, 4, 8, 8);
|
|
FBtn.Height := 48;
|
|
FBtn.Text := 'Test crypto (vecteur)';
|
|
FBtn.OnClick := RunSelfTest;
|
|
|
|
FBtnFetch := TButton.Create(Self);
|
|
FBtnFetch.Parent := Self; FBtnFetch.Align := TAlignLayout.Top;
|
|
FBtnFetch.Margins.Rect := RectF(8, 4, 8, 0);
|
|
FBtnFetch.Height := 48;
|
|
FBtnFetch.Text := 'Telecharger et dechiffrer';
|
|
FBtnFetch.OnClick := RunFetch;
|
|
|
|
FPwd := TEdit.Create(Self);
|
|
FPwd.Parent := Self; FPwd.Align := TAlignLayout.Top;
|
|
FPwd.Margins.Rect := RectF(8, 4, 8, 0);
|
|
FPwd.TextPrompt := 'mot de passe de sync';
|
|
FPwd.Password := True;
|
|
// Jamais pre-rempli, meme pour un essai : il ouvre le coffre entier, et ce
|
|
// fichier est versionne.
|
|
FPwd.Text := '';
|
|
|
|
FToken := TEdit.Create(Self);
|
|
FToken.Parent := Self; FToken.Align := TAlignLayout.Top;
|
|
FToken.Margins.Rect := RectF(8, 4, 8, 0);
|
|
FToken.TextPrompt := 'jeton Bearer';
|
|
FToken.Text := TEST_TOKEN;
|
|
|
|
FUrl := TEdit.Create(Self);
|
|
FUrl.Parent := Self; FUrl.Align := TAlignLayout.Top;
|
|
FUrl.Margins.Rect := RectF(8, 8, 8, 0);
|
|
FUrl.TextPrompt := 'URL de l''endpoint';
|
|
FUrl.Text := TEST_URL;
|
|
|
|
FLog := TMemo.Create(Self);
|
|
FLog.Parent := Self;
|
|
FLog.Align := TAlignLayout.Client;
|
|
FLog.Margins.Rect := RectF(8, 0, 8, 8);
|
|
FLog.ReadOnly := True;
|
|
FLog.TextSettings.Font.Family := 'monospace';
|
|
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.
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
FLog.Lines.Add(AMsg);
|
|
FLog.GoToTextEnd;
|
|
end);
|
|
end;
|
|
|
|
procedure TForm8.CountEntries(const APlainJson: string);
|
|
var
|
|
LJson: TJSONObject;
|
|
LArr: TJSONArray;
|
|
LLive, LTrash, I: Integer;
|
|
begin
|
|
LJson := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
|
|
if LJson = nil then Exit;
|
|
try
|
|
if not LJson.TryGetValue<TJSONArray>('entries', LArr) then Exit;
|
|
LLive := 0; LTrash := 0;
|
|
for I := 0 to LArr.Count - 1 do
|
|
if (LArr.Items[I] as TJSONObject).GetValue<Integer>('deleted', 0) = 1
|
|
then Inc(LTrash) else Inc(LLive);
|
|
Log(' ' + LLive.ToString + ' entrees, ' + LTrash.ToString + ' en corbeille');
|
|
finally
|
|
LJson.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm8.RunFetch(Sender: TObject);
|
|
var
|
|
LUrl, LTok, LPwd: string;
|
|
begin
|
|
FLog.Lines.Clear;
|
|
FBtnFetch.Enabled := False;
|
|
// 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;
|
|
LPwd := FPwd.Text;
|
|
|
|
// L'authentification affiche un dialogue systeme : elle doit rester sur le
|
|
// thread principal, et PRECEDER toute lecture du coffre. La declencher
|
|
// depuis le thread de travail ne montrerait rien.
|
|
if VaultNeedsAuth then
|
|
begin
|
|
Log('Coffre local protege - authentification requise');
|
|
AuthenticateThen('Acceder au coffre',
|
|
procedure(AOutcome: TBioOutcome)
|
|
begin
|
|
case AOutcome of
|
|
boOK: begin Log(' authentifie'); DoFetch(LUrl, LTok, LPwd); end;
|
|
boCancelled: begin Log(' annule'); FBtnFetch.Enabled := True; end;
|
|
boUnavailable:
|
|
begin
|
|
// La protection a ete retiree du telephone depuis l'ecriture du
|
|
// cache : il est devenu illisible pour toujours.
|
|
Log(' plus aucune protection sur l''appareil - cache efface');
|
|
ClearVault;
|
|
DoFetch(LUrl, LTok, LPwd);
|
|
end;
|
|
else
|
|
Log(' echec de l''authentification');
|
|
FBtnFetch.Enabled := True;
|
|
end;
|
|
end);
|
|
Exit;
|
|
end;
|
|
|
|
DoFetch(LUrl, LTok, LPwd);
|
|
end;
|
|
|
|
procedure TForm8.DoFetch(const LUrl, LTok, LPwd: string);
|
|
begin
|
|
TThread.CreateAnonymousThread(
|
|
procedure
|
|
var
|
|
LClient: TSyncClient;
|
|
LRes: TSyncResult;
|
|
LPlain, LCached, LCachedETag: string;
|
|
LSw: TStopwatch;
|
|
begin
|
|
// Le coffre local d'abord : s'il est la, on connait deja l'ETag et on
|
|
// evite les 4 secondes de derivation quand rien n'a change.
|
|
if LoadVault(LCached, LCachedETag) then
|
|
begin
|
|
FETag := LCachedETag;
|
|
Log('Coffre local : ' + Length(LCached).ToString +
|
|
' caracteres, ETag ' + Copy(LCachedETag, 1, 16) + '...');
|
|
end
|
|
else
|
|
Log('Pas de coffre local - premier telechargement');
|
|
|
|
LClient := TSyncClient.Create(LUrl, LTok);
|
|
// try/finally et NON un simple enchainement : les Exit des branches
|
|
// d'erreur ci-dessous sautent la fin de la procedure, ce qui laissait le
|
|
// bouton desactive pour de bon apres le premier echec.
|
|
try
|
|
try
|
|
Log('GET ' + LUrl);
|
|
if FETag <> '' then Log(' If-None-Match: ' + FETag);
|
|
LSw := TStopwatch.StartNew;
|
|
LRes := LClient.Fetch(FETag);
|
|
LSw.Stop;
|
|
Log(' HTTP ' + LRes.HttpCode.ToString + ' en ' +
|
|
LSw.ElapsedMilliseconds.ToString + ' ms');
|
|
|
|
case LRes.Status of
|
|
ssNotModified:
|
|
begin
|
|
// C'est ICI que le cache paie : pas de telechargement, pas de
|
|
// derivation, le coffre vient du fichier local.
|
|
Log(' ==> 304 : inchange');
|
|
if LCached <> '' then
|
|
begin
|
|
LPlain := LCached;
|
|
Log(' coffre servi depuis le cache local, 0 ms de derivation');
|
|
CountEntries(LPlain);
|
|
end
|
|
else
|
|
Log(' mais aucun coffre local - incoherence, effacer le cache');
|
|
Exit;
|
|
end;
|
|
ssNoSnapshot:
|
|
begin
|
|
// Le serveur repond pareil dans les deux cas, par conception.
|
|
Log(' ==> 404 : pas d''instantane OU jeton invalide');
|
|
Exit;
|
|
end;
|
|
ssRefused, ssHttpError, ssNetworkError:
|
|
begin
|
|
Log(' ==> echec : ' + LRes.Error);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Log(' recu ' + Length(LRes.Container).ToString + ' octets');
|
|
|
|
Log('');
|
|
Log('Dechiffrement...');
|
|
LSw := TStopwatch.StartNew;
|
|
// Volontairement AVANT de retenir l'ETag : un echec ici doit laisser
|
|
// FETag vide pour que le prochain essai retelecharge.
|
|
LPlain := DecryptContainer(LRes.Container, LPwd);
|
|
LSw.Stop;
|
|
FETag := LRes.ETag;
|
|
if FETag <> '' then Log(' ETag retenu : ' + FETag);
|
|
|
|
// Ecrit APRES un dechiffrement reussi seulement, et avec son ETag :
|
|
// les deux doivent rester coherents.
|
|
try
|
|
// True : on DEMANDE la protection par authentification. PMA.Store
|
|
// retombe tout seul sur une cle simple si l'appareil n'a ni
|
|
// empreinte ni code, plutot que de renoncer au cache.
|
|
SaveVault(LPlain, FETag, True);
|
|
if VaultNeedsAuth then
|
|
Log(' coffre enregistre - protege par biometrie/code')
|
|
else
|
|
Log(' coffre enregistre - AUCUNE protection sur cet appareil');
|
|
except
|
|
on E: Exception do
|
|
Log(' cache non ecrit : ' + E.Message);
|
|
end;
|
|
Log(' ' + LSw.ElapsedMilliseconds.ToString + ' ms pour ' +
|
|
Length(LPlain).ToString + ' caracteres');
|
|
CountEntries(LPlain);
|
|
except
|
|
on E: Exception do
|
|
Log('ERREUR ' + E.ClassName + ' : ' + E.Message);
|
|
end;
|
|
finally
|
|
LClient.Free;
|
|
TThread.Queue(nil, procedure begin FBtnFetch.Enabled := True; end);
|
|
end;
|
|
end).Start;
|
|
end;
|
|
|
|
procedure TForm8.RunSelfTest(Sender: TObject);
|
|
begin
|
|
FLog.Lines.Clear;
|
|
FBtn.Enabled := False;
|
|
|
|
TThread.CreateAnonymousThread(
|
|
procedure
|
|
var
|
|
LSalt, LKey: TBytes;
|
|
LKeyHex, LPlain, LSha: string;
|
|
LSw: TStopwatch;
|
|
begin
|
|
try
|
|
// ---- Etage 1 : PBKDF2 -------------------------------------------
|
|
// Le sel vient du conteneur lui-meme, pas d'une copie : si le
|
|
// conteneur change, le test suit.
|
|
LSalt := TNetEncoding.Base64.DecodeStringToBytes(
|
|
'AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8=');
|
|
|
|
Log('Mot de passe : ' + IntToStr(Length(TESTVECTOR_PASSWORD)) +
|
|
' caracteres, ' +
|
|
IntToStr(Length(TEncoding.UTF8.GetBytes(TESTVECTOR_PASSWORD))) +
|
|
' octets UTF-8 (attendu 25)');
|
|
|
|
Log('PBKDF2 600k...');
|
|
LSw := TStopwatch.StartNew;
|
|
LKey := DeriveKeyPBKDF2(TESTVECTOR_PASSWORD, LSalt, 600000, 32);
|
|
LSw.Stop;
|
|
|
|
LKeyHex := LowerCase(THash.DigestAsString(LKey));
|
|
Log(' duree : ' + IntToStr(LSw.ElapsedMilliseconds) + ' ms');
|
|
Log(' obtenu : ' + LKeyHex);
|
|
if LKeyHex = TESTVECTOR_KEY_HEX then
|
|
Log(' ==> PBKDF2 OK')
|
|
else
|
|
begin
|
|
Log(' attendu: ' + TESTVECTOR_KEY_HEX);
|
|
Log(' ==> PBKDF2 FAUX - verifier l''encodage UTF-8 du mot de passe');
|
|
Exit; // inutile de tester AES avec une mauvaise cle
|
|
end;
|
|
|
|
// ---- Etage 1bis : le PBKDF2 natif d'Android ----------------------
|
|
// Question ouverte, tranchee ici plutot que supposee : PBEKeySpec
|
|
// prend un char[] et le fournisseur choisit l'encodage. S'il donne la
|
|
// MEME cle sur ce mot de passe non-ASCII, on peut l'adopter et gagner
|
|
// un ordre de grandeur. Sinon, le Pascal reste la seule option juste.
|
|
Log('');
|
|
Log('PBKDF2 natif (Android)...');
|
|
LSw := TStopwatch.StartNew;
|
|
LKey := DeriveKeyPBKDF2Native(TESTVECTOR_PASSWORD, LSalt, 600000, 32);
|
|
LSw.Stop;
|
|
if LKey = nil then
|
|
Log(' indisponible : ' + LastNativeError)
|
|
else
|
|
begin
|
|
LKeyHex := LowerCase(THash.DigestAsString(LKey));
|
|
Log(' duree : ' + IntToStr(LSw.ElapsedMilliseconds) + ' ms');
|
|
if LKeyHex = TESTVECTOR_KEY_HEX then
|
|
Log(' ==> IDENTIQUE - adoptable, encodage UTF-8 confirme')
|
|
else
|
|
begin
|
|
Log(' obtenu : ' + LKeyHex);
|
|
Log(' ==> DIFFERENT - encodage du char[] incompatible, garder le Pascal');
|
|
end;
|
|
end;
|
|
|
|
// ---- Etage 2 : AES-GCM + conteneur ------------------------------
|
|
Log('');
|
|
Log('Dechiffrement du conteneur...');
|
|
LPlain := DecryptContainer(TESTVECTOR_JSON, TESTVECTOR_PASSWORD);
|
|
LSha := LowerCase(THashSHA2.GetHashString(LPlain, THashSHA2.TSHA2Version.SHA256));
|
|
|
|
Log(' longueur : ' +
|
|
IntToStr(Length(TEncoding.UTF8.GetBytes(LPlain))) +
|
|
' octets (attendu ' + IntToStr(TESTVECTOR_PLAIN_LEN) + ')');
|
|
Log(' sha256 : ' + LSha);
|
|
if LSha = TESTVECTOR_PLAIN_SHA then
|
|
Log(' ==> AES-GCM OK - la chaine complete est bonne')
|
|
else
|
|
Log(' ==> SHA DIFFERENT - comparer avec testvector.md');
|
|
|
|
Log('');
|
|
Log('Debut du clair : ' + Copy(LPlain, 1, 60));
|
|
except
|
|
on E: Exception do
|
|
Log('ERREUR ' + E.ClassName + ' : ' + E.Message);
|
|
end;
|
|
TThread.Queue(nil, procedure begin FBtn.Enabled := True; end);
|
|
end).Start;
|
|
end;
|
|
|
|
end.
|