r-zakarya
4effc3611d
Asked for, but it opens the whole vault once the container is downloaded, so it does not belong in a versioned file - even in a repo with no remote. It lives in PMA.LocalConfig.inc, gitignored, with a template checked in so a fresh clone knows what to create.
408 lines
14 KiB
ObjectPascal
408 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';
|
|
|
|
// TEST_PWD vient d'un fichier LOCAL, hors depot : il ouvre le coffre entier
|
|
// une fois le conteneur telecharge. Absent apres un clone -> recopier
|
|
// PMA.LocalConfig.template.inc.
|
|
{$I android-client\PMA.LocalConfig.inc}
|
|
|
|
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;
|
|
// Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci.
|
|
FPwd.Text := TEST_PWD;
|
|
|
|
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
|
|
// La classe compte autant que le message : "methode introuvable"
|
|
// designe une signature JNI fausse, pas un probleme de stockage.
|
|
on E: Exception do
|
|
Log(' cache non ecrit : ' + E.ClassName + ' - ' + 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.
|