diff --git a/android-client/PMA.Vault.pas b/android-client/PMA.Vault.pas new file mode 100644 index 0000000..d095dc1 --- /dev/null +++ b/android-client/PMA.Vault.pas @@ -0,0 +1,198 @@ +unit PMA.Vault; +{ + Le coffre en memoire : lecture de l'instantane dechiffre, et recherche. + + Volontairement des ENREGISTREMENTS et un tableau, pas une hierarchie + d'objets : l'instantane est lu d'un bloc, consulte, puis jete au + verrouillage. Rien ne justifie de la mutabilite ni des references croisees. + + CE QUE CETTE UNITE MANIPULE EST EN CLAIR. Elle ne doit rien ecrire sur le + disque : la persistance passe par PMA.Store, qui chiffre. +} + +interface + +uses + System.SysUtils, System.Classes, System.JSON, System.Generics.Collections; + +type + TVaultEntry = record + Uuid, Title, Site, Username, Password, Folder, Tags, Kind, Totp: string; + Deleted: 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. + function Display: string; + end; + + TVault = class + private + FEntries: TArray; + FUsername: string; + FExportedAt: string; + public + /// Remplit depuis le JSON dechiffre. Leve si la structure est absente. + procedure LoadFromJson(const APlainJson: string); + /// Efface le contenu. Appele au verrouillage. + procedure Clear; + + /// Indices des entrees correspondant a AQuery, dans l'ordre d'affichage. + /// Requete vide = tout ce qui n'est pas en corbeille. + /// La recherche porte sur le nom, le site, l'identifiant et les tags - + /// PAS sur le mot de passe : personne ne cherche par mot de passe, et le + /// comparer allongerait inutilement son sejour en memoire de travail. + function Search(const AQuery: string; AIncludeTrash: Boolean = False): TArray; + + function Count: Integer; + function LiveCount: Integer; + function TrashCount: Integer; + function Entry(AIndex: Integer): TVaultEntry; + + property Username: string read FUsername; + property ExportedAt: string read FExportedAt; + end; + +implementation + +uses + System.Character; + +{ TVaultEntry } + +function TVaultEntry.Display: string; +begin + Result := Title.Trim; + if Result = '' then Result := Site.Trim; + if Result = '' then Result := Username.Trim; + if Result = '' then Result := '(sans nom)'; +end; + +{ TVault } + +procedure TVault.Clear; +begin + SetLength(FEntries, 0); + FUsername := ''; + FExportedAt := ''; +end; + +/// Les tags arrivent en tableau JSON depuis nos conteneurs, mais en chaine +/// separee par des virgules depuis un import CSV etranger. On accepte les deux. +function TagsToString(const AVal: TJSONValue): string; +var + LArr: TJSONArray; + I: Integer; +begin + Result := ''; + if AVal = nil then Exit; + if AVal is TJSONArray then + begin + LArr := AVal as TJSONArray; + for I := 0 to LArr.Count - 1 do + begin + if Result <> '' then Result := Result + ', '; + Result := Result + LArr.Items[I].Value; + end; + end + else + Result := AVal.Value; +end; + +procedure TVault.LoadFromJson(const APlainJson: string); +var + LRoot, LObj: TJSONObject; + LArr: TJSONArray; + I, N: Integer; +begin + Clear; + LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject; + if LRoot = nil then + raise Exception.Create('Instantane illisible : ce n''est pas du JSON'); + try + FUsername := LRoot.GetValue('username', ''); + FExportedAt := LRoot.GetValue('exported_at', + LRoot.GetValue('snapshot_at', '')); + + if not LRoot.TryGetValue('entries', LArr) then + raise Exception.Create('Instantane sans tableau "entries"'); + + SetLength(FEntries, 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; + FEntries[N].Uuid := LObj.GetValue('uuid', ''); + FEntries[N].Title := LObj.GetValue('title', ''); + FEntries[N].Site := LObj.GetValue('site', ''); + FEntries[N].Username := LObj.GetValue('username', ''); + FEntries[N].Password := LObj.GetValue('password', ''); + FEntries[N].Folder := LObj.GetValue('folder', ''); + FEntries[N].Kind := LObj.GetValue('kind', 'login'); + FEntries[N].Totp := LObj.GetValue('totp_secret', ''); + FEntries[N].Tags := TagsToString(LObj.GetValue('tags')); + // deleted arrive en 0/1 depuis nos conteneurs ; absent = vivant. + FEntries[N].Deleted := LObj.GetValue('deleted', 0) = 1; + Inc(N); + end; + SetLength(FEntries, N); + finally + LRoot.Free; + end; +end; + +function TVault.Count: Integer; +begin + Result := Length(FEntries); +end; + +function TVault.LiveCount: Integer; +var E: TVaultEntry; +begin + Result := 0; + for E in FEntries do if not E.Deleted then Inc(Result); +end; + +function TVault.TrashCount: Integer; +begin + Result := Count - LiveCount; +end; + +function TVault.Entry(AIndex: Integer): TVaultEntry; +begin + Result := FEntries[AIndex]; +end; + +function TVault.Search(const AQuery: string; AIncludeTrash: Boolean): TArray; +var + LQ: string; + LRes: TList; + I: Integer; + E: TVaultEntry; + + function Matches(const E: TVaultEntry): Boolean; + begin + Result := (LQ = '') + or (Pos(LQ, E.Title.ToLower) > 0) + or (Pos(LQ, E.Site.ToLower) > 0) + or (Pos(LQ, E.Username.ToLower) > 0) + or (Pos(LQ, E.Tags.ToLower) > 0); + end; + +begin + LQ := AQuery.Trim.ToLower; + LRes := TList.Create; + try + for I := 0 to High(FEntries) do + begin + E := FEntries[I]; + if E.Deleted and not AIncludeTrash then Continue; + if Matches(E) then LRes.Add(I); + end; + Result := LRes.ToArray; + finally + LRes.Free; + end; +end; + +end. diff --git a/android-client/README.md b/android-client/README.md index 6f959ae..707c90c 100644 --- a/android-client/README.md +++ b/android-client/README.md @@ -53,6 +53,41 @@ réception paraît naturel et c'est un piège : après un échec, le prochain ap répond 304 et l'application se retrouve sans données tout en se croyant à jour. L'ETag appartient au **clair détenu**, pas au téléchargement. +## L'interface + +Trois écrans dans une seule forme, construits en code (`mainApk.pas`) : +déverrouillage, liste, détail. Une forme par écran aurait coûté trois `.fmx` +pour des dispositions triviales. + +L'écran de déverrouillage s'adapte à ce que l'appareil détient : coffre local +présent → *Ouvrir* (biométrie si la clé l'exige) ; absent → seul le +téléchargement peut en produire un. La liste filtre à la frappe sur le nom, le +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. + +Deux règles tenues dans l'interface, pas ailleurs : + +- **Le clair est jeté quand l'application passe en arrière-plan.** L'écran est + masqué sur `WillBecomeInactive`, qui précède la capture de l'aperçu des + applications récentes — sans quoi la liste des comptes y resterait visible — + et le coffre est réellement effacé sur `EnteredBackground`. +- **Le presse-papiers se vide après 45 s**, et seulement si son contenu est + toujours celui qu'on y a mis : l'utilisateur a pu copier autre chose + entre-temps. + +L'écriture n'existe pas. Le poste Windows reste la source ; modifier depuis le +téléphone demanderait le `PUT` côté serveur et une fusion côté client. + +### Tester sans téléphone + +Tout sauf le Keystore et la biométrie tourne en **Win64** — `PMA.Store` +retourne « pas de coffre » hors Android, donc chaque lancement retélécharge et +redérive. Suffisant pour éprouver la liste, la recherche et la copie : + +```bash +"C:\Program Files (x86)\Embarcadero\Studio\23.0\bin\dcc64.exe" -B "-UC:\Program Files (x86)\Embarcadero\Studio\23.0\lib\Win64\release" pmserverApk.dpr +``` + ## Diagnostiquer un échec de déchiffrement `try-open.js` ouvre un conteneur avec Node, donc avec les primitives du @@ -76,11 +111,15 @@ Node ouvre le fichier et pas le client, le défaut est dans le client. | | | |---|---| | `PMA.Crypto.pas` | PBKDF2 (Pascal + natif JNI), AES-GCM, ouverture du conteneur | -| `PMA.TestVector.pas` | le vecteur embarqué, pour le banc d'essai | +| `PMA.SyncClient.pas` | `GET` authentifié, ETag, statuts distingués | +| `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.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 | -Le banc d'essai est `mainApk.pas`, à la racine du dépôt. +L'interface est `mainApk.pas`, à la racine du dépôt. ## Piège de compilation rencontré diff --git a/mainApk.pas b/mainApk.pas index 60d9c4d..f193d8e 100644 --- a/mainApk.pas +++ b/mainApk.pas @@ -1,27 +1,34 @@ unit mainApk; { - Banc d'essai de la crypto du conteneur, avant toute interface reelle. + Client Android en LECTURE SEULE : deverrouiller, chercher, copier. - Deux etages testes SEPAREMENT, parce qu'un echec global ne dit pas ou : + Trois ecrans dans une seule forme, montres a tour de role - une forme par + ecran couterait un fichier .fmx chacun pour trois dispositions triviales. - 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). + 1. Deverrouillage : ouvre le coffre local (biometrie), ou telecharge le + conteneur et le dechiffre si l'appareil n'en a pas encore. + 2. Liste : recherche + entrees. + 3. Detail : les champs d'une entree, mot de passe masque. - 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. + DEUX REGLES DE SURETE tenues ici, pas ailleurs : + - le coffre en clair est EFFACE des que l'application passe en arriere-plan + (sinon il reste dans l'apercu des applications recentes) ; + - le presse-papiers est VIDE apres un delai, et seulement si son contenu + est toujours celui qu'on y a mis. + + L'ecriture n'existe pas : le poste Windows reste la source. Modifier ici + demanderait le PUT cote serveur et une fusion cote client. } 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, + System.SysUtils, System.Types, System.UITypes, System.Classes, + System.Diagnostics, System.Rtti, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types, - FMX.ScrollBox, FMX.Layouts, FMX.Edit; + FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox, + PMA.Vault; const // Parametres du banc d'essai, pre-remplis pour ne pas les retaper. @@ -39,6 +46,10 @@ const // donne acces qu'a du chiffre - mais a remplacer avant toute mise en ligne. TEST_TOKEN = '8765e5bf426039e9888f44bfbab27d489d12b7dbaaa54c8c695ae6af8b2a820e'; + // Assez pour aller coller dans une autre application, trop court pour qu'un + // mot de passe traine dans l'historique du presse-papiers. + CLIPBOARD_CLEAR_SECONDS = 45; + // 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. @@ -47,22 +58,75 @@ const type TForm8 = class(TForm) private - FLog: TMemo; - FBtn: TButton; - FBtnFetch: TButton; - FUrl, FToken, FPwd: TEdit; + FVault: TVault; + FFiltered: TArray; // indices dans FVault, resultat de la recherche + FCurrent: TVaultEntry; + FPwdShown: Boolean; // 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. + // economiser un telechargement pour se retrouver sans donnees. FETag: string; - procedure RunSelfTest(Sender: TObject); - procedure RunFetch(Sender: TObject); - procedure DoFetch(const LUrl, LTok, LPwd: string); - procedure CountEntries(const APlainJson: string); + FBusy: Boolean; + + // --- ecran 1 : deverrouillage + FLayUnlock: TLayout; + FUrl, FToken, FPwd: TEdit; + FBtnOpen, FBtnSync, FBtnSettings: TButton; + FLaySettings: TLayout; + FStatus: TLabel; + FLog: TMemo; + + // --- ecran 2 : liste + FLayList: TLayout; + FSearch: TEdit; + FList: TListBox; + FCount: TLabel; + + // --- ecran 3 : detail + FLayDetail: TLayout; + FDetTitle: TLabel; + FDetSite, FDetUser, FDetPwd, FDetMeta, FDetToast: TLabel; + FBtnReveal: TButton; + + // --- presse-papiers + FClipTimer: TTimer; + FCopied: string; + + procedure BuildUnlock; + procedure BuildList; + procedure BuildDetail; + + procedure ShowUnlock; + procedure ShowList; + procedure ShowDetail(AVaultIndex: Integer); + + procedure DoOpenLocal(Sender: TObject); + // Separee de DoOpenLocal : une methode anonyme ne peut pas appeler une + // procedure imbriquee (E2555), et le rappel de la biometrie en est une. + procedure OpenLocalNow; + procedure DoSync(Sender: TObject); + procedure FetchAndDecrypt(const AUrl, ATok, APwd: string); + procedure AdoptVault(const APlainJson: string); + procedure LockVault; + + procedure OnSearchChanged(Sender: TObject); + procedure OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem); + procedure OnRevealTap(Sender: TObject); + procedure OnCopyTap(Sender: TObject); + procedure OnBackTap(Sender: TObject); + procedure OnToggleSettings(Sender: TObject); + procedure OnClipTimer(Sender: TObject); + procedure OnHardwareBack(Sender: TObject; var Key: Word; + var KeyChar: WideChar; Shift: TShiftState); + + procedure CopyToClipboard(const AText, ALabel: string); + function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; procedure Log(const AMsg: string); + procedure Status(const AMsg: string); + procedure SetBusy(ABusy: Boolean); public constructor Create(AOwner: TComponent); override; + destructor Destroy; override; end; var @@ -71,66 +135,715 @@ var implementation uses - System.JSON, PMA.Crypto, PMA.TestVector, PMA.SyncClient, PMA.Store, PMA.Biometric; + PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric; {$R *.fmx} +const + // Puces en points de code, PAS en caracteres litteraux : un .pas sans BOM + // est lu comme de l'ANSI, et un bullet UTF-8 y devient trois glyphes. + BULLET = #$2022; + MASK = BULLET+BULLET+BULLET+BULLET+BULLET+BULLET+ + BULLET+BULLET+BULLET+BULLET+BULLET+BULLET; + +{ ---------------------------------------------------------------------------- + Construction + ---------------------------------------------------------------------------- } + constructor TForm8.Create(AOwner: TComponent); +var + LEvents: IFMXApplicationEventService; begin inherited; - Caption := 'PM - crypto self-test'; + Caption := 'Coffre'; + FVault := TVault.Create; - // 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; + BuildDetail; // cree en dernier a l'ecran = au-dessus des autres + BuildList; + BuildUnlock; - 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; + FClipTimer := TTimer.Create(Self); + FClipTimer.Enabled := False; + FClipTimer.Interval := CLIPBOARD_CLEAR_SECONDS * 1000; + FClipTimer.OnTimer := OnClipTimer; - 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; + // 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. + OnKeyUp := OnHardwareBack; - 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; + if TPlatformServices.Current.SupportsPlatformService( + IFMXApplicationEventService, LEvents) then + LEvents.SetApplicationEventHandler(HandleAppEvent); - 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; + ShowUnlock; +end; +destructor TForm8.Destroy; +begin + FVault.Free; + 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 = 48): TButton; +begin + Result := TButton.Create(AParent); + Result.Parent := AParent; + Result.Align := TAlignLayout.Top; + Result.Margins.Rect := RectF(8, 4, 8, 0); + Result.Height := AHeight; + Result.Text := AText; + Result.OnClick := AOnClick; +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; +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 := Self; - FLog.Align := TAlignLayout.Client; - FLog.Margins.Rect := RectF(8, 0, 8, 8); + FLog.Parent := FLayUnlock; + FLog.Align := TAlignLayout.Bottom; + FLog.Height := 150; + FLog.Margins.Rect := RectF(8, 8, 8, 8); FLog.ReadOnly := True; FLog.TextSettings.Font.Family := 'monospace'; + FLog.TextSettings.Font.Size := 11; + + // --- du bas vers le haut (voir TopButton) + FLaySettings := TLayout.Create(Self); + FLaySettings.Parent := FLayUnlock; + FLaySettings.Align := TAlignLayout.Top; + FLaySettings.Height := 116; + FLaySettings.Visible := False; + FToken := TopEdit(FLaySettings, 'jeton Bearer', TEST_TOKEN); + FUrl := TopEdit(FLaySettings, 'URL de l''endpoint', TEST_URL); + + FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur', + OnToggleSettings, 36); + FBtnSettings.TextSettings.Font.Size := 12; + + FBtnSync := TopButton(FLayUnlock, 'Synchroniser', DoSync); + FBtnOpen := TopButton(FLayUnlock, 'Ouvrir le coffre', DoOpenLocal); + + // Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci. + FPwd := TopEdit(FLayUnlock, 'mot de passe de sync', TEST_PWD, True); + FPwd.Margins.Top := 12; + + FStatus := TLabel.Create(Self); + FStatus.Parent := FLayUnlock; + FStatus.Align := TAlignLayout.Top; + FStatus.Margins.Rect := RectF(8, 16, 8, 0); + FStatus.Height := 24; + FStatus.StyledSettings := FStatus.StyledSettings - [TStyledSetting.Size]; + FStatus.TextSettings.Font.Size := 15; end; +procedure TForm8.BuildList; +var + LBar: TLayout; + LBtnLock: TButton; +begin + FLayList := TLayout.Create(Self); + FLayList.Parent := Self; + FLayList.Align := TAlignLayout.Client; + FLayList.Visible := False; + + LBar := TLayout.Create(Self); + LBar.Parent := FLayList; + LBar.Align := TAlignLayout.Bottom; + LBar.Height := 52; + + LBtnLock := TButton.Create(Self); + LBtnLock.Parent := LBar; + LBtnLock.Align := TAlignLayout.Left; + LBtnLock.Margins.Rect := RectF(8, 4, 0, 8); + LBtnLock.Width := 130; + LBtnLock.Text := 'Verrouiller'; + LBtnLock.OnClick := OnBackTap; + LBtnLock.Tag := 1; // 1 = verrouiller, 0 = simple retour (voir OnBackTap) + + FCount := TLabel.Create(Self); + FCount.Parent := LBar; + FCount.Align := TAlignLayout.Client; + FCount.Margins.Rect := RectF(12, 4, 8, 8); + FCount.TextSettings.HorzAlign := TTextAlign.Trailing; + FCount.TextSettings.VertAlign := TTextAlign.Center; + + FList := TListBox.Create(Self); + FList.Parent := FLayList; + FList.Align := TAlignLayout.Client; + FList.Margins.Rect := RectF(4, 0, 4, 0); + FList.ItemHeight := 56; + FList.OnItemClick := OnItemTap; + + FSearch := TEdit.Create(Self); + FSearch.Parent := FLayList; + FSearch.Align := TAlignLayout.Top; + FSearch.Margins.Rect := RectF(8, 8, 8, 8); + FSearch.TextPrompt := 'Rechercher'; + FSearch.OnChangeTracking := OnSearchChanged; +end; + +/// Une ligne du detail : intitule discret, valeur, bouton Copier. +/// ATag porte ce qu'il faut copier (1 site, 2 identifiant, 3 mot de passe). +function DetailRow(AParent: TFmxObject; const ACaption: string; ATag: Integer; + AOnCopy: TNotifyEvent; out AValue: TLabel): TLayout; +var + LCap: TLabel; + LBtn: TButton; +begin + Result := TLayout.Create(AParent); + Result.Parent := AParent; + Result.Align := TAlignLayout.Top; + Result.Height := 62; + 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.Parent := Result; + LCap.Align := TAlignLayout.Top; + LCap.Height := 20; + LCap.Text := ACaption; + LCap.Opacity := 0.6; + LCap.StyledSettings := LCap.StyledSettings - [TStyledSetting.Size]; + LCap.TextSettings.Font.Size := 12; + + AValue := TLabel.Create(Result); + AValue.Parent := Result; + AValue.Align := TAlignLayout.Client; + AValue.StyledSettings := AValue.StyledSettings - [TStyledSetting.Size]; + AValue.TextSettings.Font.Size := 16; +end; + +procedure TForm8.BuildDetail; +var + LRowPwd: TLayout; + LBtnBack: TButton; +begin + FLayDetail := TLayout.Create(Self); + FLayDetail.Parent := Self; + FLayDetail.Align := TAlignLayout.Client; + FLayDetail.Visible := False; + + LBtnBack := TButton.Create(Self); + LBtnBack.Parent := FLayDetail; + LBtnBack.Align := TAlignLayout.Bottom; + LBtnBack.Height := 48; + LBtnBack.Margins.Rect := RectF(8, 8, 8, 8); + LBtnBack.Text := 'Retour'; + LBtnBack.Tag := 0; + LBtnBack.OnClick := OnBackTap; + + FDetToast := TLabel.Create(Self); + FDetToast.Parent := FLayDetail; + FDetToast.Align := TAlignLayout.Bottom; + FDetToast.Height := 22; + FDetToast.Margins.Rect := RectF(12, 0, 12, 0); + FDetToast.StyledSettings := FDetToast.StyledSettings - [TStyledSetting.Size]; + FDetToast.TextSettings.Font.Size := 12; + FDetToast.Opacity := 0.7; + + // Du bas vers le haut : dossier/tags, mot de passe, identifiant, site, titre. + DetailRow(FLayDetail, 'Dossier / etiquettes', 0, nil, FDetMeta); + + LRowPwd := DetailRow(FLayDetail, 'Mot de passe', 3, OnCopyTap, FDetPwd); + FBtnReveal := TButton.Create(LRowPwd); + 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.Parent := FLayDetail; + FDetTitle.Align := TAlignLayout.Top; + FDetTitle.Height := 44; + FDetTitle.Margins.Rect := RectF(12, 12, 12, 0); + FDetTitle.StyledSettings := FDetTitle.StyledSettings - [TStyledSetting.Size]; + FDetTitle.TextSettings.Font.Size := 22; +end; + +{ ---------------------------------------------------------------------------- + Navigation + ---------------------------------------------------------------------------- } + +procedure TForm8.ShowUnlock; +begin + FLayDetail.Visible := False; + FLayList.Visible := False; + FLayUnlock.Visible := True; + + // Le bouton d'ouverture n'a de sens que si un coffre local existe ; sinon + // seul le telechargement peut en produire un. + FBtnOpen.Visible := HasVault; + if HasVault then + begin + if VaultNeedsAuth then + Status('Coffre present sur cet appareil - protege') + else + Status('Coffre present sur cet appareil'); + FBtnSync.Text := 'Synchroniser'; + end + else + begin + Status('Aucun coffre local - premier telechargement'); + FBtnSync.Text := 'Telecharger le coffre'; + end; +end; + +procedure TForm8.ShowList; +begin + FLayUnlock.Visible := False; + FLayDetail.Visible := False; + FLayList.Visible := True; + FSearch.Text := ''; + OnSearchChanged(nil); +end; + +procedure TForm8.ShowDetail(AVaultIndex: Integer); +var + LMeta: string; +begin + FCurrent := FVault.Entry(AVaultIndex); + FPwdShown := False; + + FDetTitle.Text := FCurrent.Display; + FDetSite.Text := FCurrent.Site; + FDetUser.Text := FCurrent.Username; + FDetPwd.Text := MASK; + FDetToast.Text := ''; + FBtnReveal.Text := 'Afficher'; + + LMeta := FCurrent.Folder; + if FCurrent.Tags <> '' then + begin + if LMeta <> '' then LMeta := LMeta + ' - '; + LMeta := LMeta + FCurrent.Tags; + end; + FDetMeta.Text := LMeta; + + FLayList.Visible := False; + FLayDetail.Visible := True; +end; + +procedure TForm8.OnBackTap(Sender: TObject); +begin + // Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail. + if (Sender is TButton) and (TButton(Sender).Tag = 1) then + LockVault + else + ShowList; +end; + +procedure TForm8.OnHardwareBack(Sender: TObject; var Key: Word; + var KeyChar: WideChar; Shift: TShiftState); +begin + if Key <> vkHardwareBack then Exit; + if FLayDetail.Visible then + begin + ShowList; + Key := 0; // consomme : sinon Android ferme l'application + end + else if FLayList.Visible then + begin + LockVault; + Key := 0; + end; +end; + +procedure TForm8.OnToggleSettings(Sender: TObject); +begin + FLaySettings.Visible := not FLaySettings.Visible; +end; + +{ ---------------------------------------------------------------------------- + Ouverture, synchronisation, verrouillage + ---------------------------------------------------------------------------- } + +procedure TForm8.LockVault; +begin + // Le clair dispararait de la memoire ET de l'ecran. Le fichier local reste : + // il est chiffre par le materiel, c'est tout l'interet du cache. + FVault.Clear; + FList.Clear; + FCurrent := Default(TVaultEntry); + FDetPwd.Text := MASK; + FPwdShown := False; + ShowUnlock; +end; + +procedure TForm8.AdoptVault(const APlainJson: string); +begin + FVault.LoadFromJson(APlainJson); + Log(' ' + FVault.LiveCount.ToString + ' entrees, ' + + FVault.TrashCount.ToString + ' en corbeille'); + ShowList; +end; + +procedure TForm8.OpenLocalNow; +var + LPlain, LETag: string; +begin + if LoadVault(LPlain, LETag) then + begin + FETag := LETag; + try + AdoptVault(LPlain); + except + on E: Exception do + begin + // Un coffre local illisible se remplace, il ne se repare pas. + Log('Coffre local corrompu : ' + E.Message); + ClearVault; + ShowUnlock; + end; + end; + end + else + begin + Status('Coffre local illisible - retelechargement necessaire'); + ShowUnlock; + end; +end; + +procedure TForm8.DoOpenLocal(Sender: TObject); +begin + if FBusy then Exit; + // L'authentification affiche un dialogue systeme : elle doit rester sur le + // thread principal, et PRECEDER toute lecture du coffre. + if not VaultNeedsAuth then + begin + OpenLocalNow; + Exit; + end; + + Status('Authentification...'); + AuthenticateThen('Acceder au coffre', + procedure(AOutcome: TBioOutcome) + begin + case AOutcome of + boOK: OpenLocalNow; + boCancelled: Status('Annule'); + boUnavailable: + begin + // La protection a ete retiree de l'appareil depuis l'ecriture du + // cache : celui-ci est devenu illisible pour toujours. + Log('Plus aucune protection sur l''appareil - cache efface'); + ClearVault; + ShowUnlock; + end; + else + Status('Echec de l''authentification'); + end; + end); +end; + +procedure TForm8.DoSync(Sender: TObject); +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; + LPwd := FPwd.Text; + if LPwd = '' then + begin + Status('Mot de passe de sync requis'); + Exit; + end; + FLog.Lines.Clear; + FetchAndDecrypt(LUrl, LTok, LPwd); +end; + +procedure TForm8.FetchAndDecrypt(const AUrl, ATok, APwd: string); +begin + SetBusy(True); + Status('Telechargement...'); + 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 (FETag = '') and LoadVault(LCached, LCachedETag) then + FETag := LCachedETag; + + LClient := TSyncClient.Create(AUrl, ATok); + // try/finally et NON un simple enchainement : les Exit des branches + // d'erreur ci-dessous sautent la fin de la procedure, ce qui laissait + // l'interface bloquee apres le premier echec. + try + try + Log('GET ' + AUrl); + 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, coffre servi depuis le cache'); + // SetBusy AVANT l'ouverture : la file est FIFO, et celui du + // bloc finally passerait apres - DoOpenLocal sortirait aussitot + // sur son garde-fou "occupe". + TThread.Queue(nil, procedure + begin SetBusy(False); DoOpenLocal(nil); end); + Exit; + end; + ssNoSnapshot: + begin + // Le serveur repond pareil dans les deux cas, par conception. + Log(' 404 : pas d''instantane OU jeton invalide'); + TThread.Queue(nil, procedure + begin Status('Rien a telecharger (404)'); end); + Exit; + end; + ssRefused, ssHttpError, ssNetworkError: + begin + Log(' echec : ' + LRes.Error); + TThread.Queue(nil, procedure + begin Status('Echec reseau'); end); + Exit; + end; + end; + + Log(' recu ' + Length(LRes.Container).ToString + ' octets'); + TThread.Queue(nil, procedure begin Status('Dechiffrement...'); end); + + 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, APwd); + LSw.Stop; + FETag := LRes.ETag; + Log(' dechiffre en ' + LSw.ElapsedMilliseconds.ToString + ' ms'); + + // 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(' cache ecrit - protege par biometrie/code') + else + Log(' cache ecrit - 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; + + TThread.Queue(nil, + procedure + begin + try + AdoptVault(LPlain); + except + on E: Exception do Status('Instantane illisible : ' + E.Message); + end; + end); + except + on E: Exception do + begin + Log('ERREUR ' + E.ClassName + ' : ' + E.Message); + // Le cas de loin le plus frequent, et le message par defaut ne le + // dit pas : GCM echoue a la verification quand la cle est fausse. + TThread.Queue(nil, procedure + begin Status('Echec - mot de passe de sync incorrect ?'); end); + end; + end; + finally + LClient.Free; + TThread.Queue(nil, procedure begin SetBusy(False); end); + end; + end).Start; +end; + +{ ---------------------------------------------------------------------------- + Liste et recherche + ---------------------------------------------------------------------------- } + +procedure TForm8.OnSearchChanged(Sender: TObject); +var + I: Integer; + LItem: TListBoxItem; + E: TVaultEntry; +begin + // ponytail: refonte complete de la liste a chaque frappe. Sur un coffre de + // quelques centaines d'entrees c'est imperceptible ; passer a un modele + // virtuel (TListView) le jour ou ca rame. + FFiltered := FVault.Search(FSearch.Text); + + FList.BeginUpdate; + try + FList.Clear; + for I := 0 to High(FFiltered) do + begin + E := FVault.Entry(FFiltered[I]); + LItem := TListBoxItem.Create(FList); + LItem.Parent := FList; + LItem.Text := E.Display; + LItem.ItemData.Detail := E.Username; + LItem.StyleLookup := 'listboxitembottomdetail'; + LItem.Tag := FFiltered[I]; // indice dans le coffre, pas dans la liste + end; + finally + FList.EndUpdate; + end; + + if FSearch.Text.Trim = '' then + FCount.Text := FVault.LiveCount.ToString + ' entrees' + else + FCount.Text := Length(FFiltered).ToString + ' / ' + + FVault.LiveCount.ToString; +end; + +procedure TForm8.OnItemTap(const Sender: TCustomListBox; const AItem: TListBoxItem); +begin + if AItem <> nil then ShowDetail(AItem.Tag); +end; + +{ ---------------------------------------------------------------------------- + Detail : reveler et copier + ---------------------------------------------------------------------------- } + +procedure TForm8.OnRevealTap(Sender: TObject); +begin + FPwdShown := not FPwdShown; + if FPwdShown then + begin + FDetPwd.Text := FCurrent.Password; + FBtnReveal.Text := 'Masquer'; + end + else + begin + FDetPwd.Text := MASK; + FBtnReveal.Text := 'Afficher'; + end; +end; + +procedure TForm8.OnCopyTap(Sender: TObject); +begin + if not (Sender is TButton) then Exit; + case TButton(Sender).Tag of + 1: CopyToClipboard(FCurrent.Site, 'Site'); + 2: CopyToClipboard(FCurrent.Username, 'Identifiant'); + 3: CopyToClipboard(FCurrent.Password, 'Mot de passe'); + end; +end; + +procedure TForm8.CopyToClipboard(const AText, ALabel: string); +var + LClip: IFMXClipboardService; +begin + if AText = '' then Exit; + if not TPlatformServices.Current.SupportsPlatformService( + IFMXClipboardService, LClip) then Exit; + LClip.SetClipboard(AText); + FCopied := AText; + // Reprogramme depuis zero : deux copies successives donnent au second + // contenu son delai complet, pas le reste de celui du premier. + FClipTimer.Enabled := False; + FClipTimer.Enabled := True; + // ponytail: le message reste jusqu'a la prochaine navigation, pas de minuterie + // pour l'effacer. Un deuxieme TTimer pour deux secondes d'affichage serait + // plus de code que ce que ca apporte. + FDetToast.Text := ALabel + ' copie - presse-papiers efface dans ' + + CLIPBOARD_CLEAR_SECONDS.ToString + ' s'; +end; + +procedure TForm8.OnClipTimer(Sender: TObject); +var + LClip: IFMXClipboardService; +begin + FClipTimer.Enabled := False; + if FCopied = '' then Exit; + if TPlatformServices.Current.SupportsPlatformService( + IFMXClipboardService, LClip) then + // Seulement si c'est TOUJOURS notre texte : l'utilisateur a pu copier + // autre chose entre-temps, et le lui effacer serait une surprise. + if LClip.GetClipboard.ToString = FCopied then + LClip.SetClipboard(''); + FCopied := ''; +end; + +{ ---------------------------------------------------------------------------- + Cycle de vie + ---------------------------------------------------------------------------- } + +function TForm8.HandleAppEvent(AAppEvent: TApplicationEvent; + AContext: TObject): Boolean; +begin + Result := True; + case AAppEvent of + // WillBecomeInactive arrive AVANT la capture d'ecran des applications + // recentes : masquer ici, c'est ne pas y laisser la liste des comptes. + TApplicationEvent.WillBecomeInactive: + if FLayList.Visible or FLayDetail.Visible then + begin + FLayDetail.Visible := False; + FLayList.Visible := False; + FLayUnlock.Visible := True; + end; + // Et le clair est reellement jete quand l'application passe derriere. + TApplicationEvent.EnteredBackground: + if FVault.Count > 0 then LockVault; + end; +end; + +{ ---------------------------------------------------------------------------- + Journal + ---------------------------------------------------------------------------- } + procedure TForm8.Log(const AMsg: string); begin // Appele depuis le thread de calcul : la mise a jour d'un controle FMX doit @@ -143,265 +856,16 @@ begin end); end; -procedure TForm8.CountEntries(const APlainJson: string); -var - LJson: TJSONObject; - LArr: TJSONArray; - LLive, LTrash, I: Integer; +procedure TForm8.Status(const AMsg: string); begin - LJson := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject; - if LJson = nil then Exit; - try - if not LJson.TryGetValue('entries', LArr) then Exit; - LLive := 0; LTrash := 0; - for I := 0 to LArr.Count - 1 do - if (LArr.Items[I] as TJSONObject).GetValue('deleted', 0) = 1 - then Inc(LTrash) else Inc(LLive); - Log(' ' + LLive.ToString + ' entrees, ' + LTrash.ToString + ' en corbeille'); - finally - LJson.Free; - end; + FStatus.Text := AMsg; end; -procedure TForm8.RunFetch(Sender: TObject); -var - LUrl, LTok, LPwd: string; +procedure TForm8.SetBusy(ABusy: Boolean); 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; + FBusy := ABusy; + FBtnSync.Enabled := not ABusy; + FBtnOpen.Enabled := not ABusy; end; end. diff --git a/pmserverApk.dpr b/pmserverApk.dpr index 6fd6914..cb272d1 100644 --- a/pmserverApk.dpr +++ b/pmserverApk.dpr @@ -8,7 +8,8 @@ uses PMA.TestVector in 'android-client\PMA.TestVector.pas', PMA.SyncClient in 'android-client\PMA.SyncClient.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'; {$R *.res}