Password-Manager/mainApk.pas

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 Log(const AMsg: string);
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form8: TForm8;

implementation

uses
  System.JSON, PMA.Crypto, PMA.TestVector, PMA.SyncClient;

{$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.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;

  TThread.CreateAnonymousThread(
    procedure
    var
      LClient: TSyncClient;
      LRes: TSyncResult;
      LPlain: string;
      LSw: TStopwatch;
      LJson: TJSONObject;
      LArr: TJSONArray;
      LLive, LTrash, I: Integer;
    begin
      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
              Log('  ==> 304 : inchange, rien a re-dechiffrer');
              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);
        Log('  ' + LSw.ElapsedMilliseconds.ToString + ' ms pour ' +
            Length(LPlain).ToString + ' caracteres');

        // Compte vivant / corbeille : c'est ce que le vrai client devra
        // afficher separement.
        LJson := TJSONObject.ParseJSONValue(LPlain) as TJSONObject;
        if LJson <> nil then
        try
          if LJson.TryGetValue<TJSONArray>('entries', LArr) then
          begin
            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');
          end;
        finally
          LJson.Free;
        end;
      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.