Password-Manager/android-client/PMA.SyncClient.pas

unit PMA.SyncClient;
{
  Lecture de l'instantane chiffre. DEUX TRANSPORTS, reconnus a l'URL :

  - un depot Gitea prive, via l'API des contenus. C'est la destination : plus
    rien a heberger, HTTPS et certificat deja en place, acces depuis
    l'exterieur gratuit.
  - l'endpoint PHP historique (server-php/sync.php), garde le temps que le
    poste Windows publie aussi dans le depot. Sans lui, la migration exigerait
    de tout basculer d'un coup, des deux cotes, sans retour possible.

  Ne dechiffre rien : il ramene des octets opaques et l'empreinte qui les
  identifie. Le dechiffrement est le travail de PMA.Crypto, et il coute
  4 secondes - d'ou l'importance de cette empreinte, qui evite de le refaire
  quand rien n'a change.

  CE QUE L'EMPREINTE DESIGNE DIFFERE selon le transport, mais son role est le
  meme et l'appelant n'a pas a le savoir : l'ETag HTTP pour PHP, le sha du blob
  pour Gitea. Sur Gitea la comparaison se fait ICI, apres reception : l'API ne
  connait pas If-None-Match, donc le corps est retelecharge - ce qui est
  bon marche - mais la derivation, elle, est bien evitee.

  Le PHP repond 404 aussi bien pour un jeton invalide que pour un instantane
  absent : c'est voulu (un appelant non authentifie n'apprend pas ce qui
  existe), et le client ne peut donc pas les distinguer. Gitea repond de meme
  sur un depot prive. Le message utilisateur doit couvrir les deux cas.
}

interface

uses
  System.SysUtils, System.Classes, System.Net.HttpClient,
  System.Net.URLClient, System.Net.HttpClientComponent;

type
  TSyncStatus = (
    ssOK,            // 200 : nouveau contenu dans Container
    ssNotModified,   // 304 : l'ETag detenu est toujours le bon
    ssNoSnapshot,    // 404 : pas d'instantane, OU jeton invalide
    ssRefused,       // 403 : HTTPS exige par le serveur
    ssHttpError,     // autre code
    ssNetworkError,  // rien n'a repondu
    /// 409 ou 422 : le sha envoye n'est plus celui du fichier - un autre appareil a
    /// publie entre notre lecture et notre ecriture. L'appelant doit relire,
    /// refusionner et renvoyer, pas reessayer tel quel.
    ssConflict
  );

  TSyncResult = record
    Status:    TSyncStatus;
    Container: string;   // le JSON chiffre, vide sauf sur ssOK
    /// Ce qui identifie ce contenu : ETag HTTP sur PHP, sha du blob sur Gitea.
    /// A ranger avec le clair et a repasser au prochain appel.
    ETag:      string;
    HttpCode:  Integer;
    Error:     string;   // message brut, pour le journal
  end;

  TSyncClient = class
  private
    FBaseUrl: string;
    FToken: string;
    FTimeoutMs: Integer;
    FPrivacyChecked: Boolean;
  public
    constructor Create(const ABaseUrl, AToken: string);

    /// GET de l'instantane. AKnownETag non vide -> ssNotModified si le serveur
    /// rend le meme contenu, ce qui epargne la derivation de la cle.
    function Fetch(const AKnownETag: string = ''): TSyncResult;

    /// Vrai si l'URL designe l'API des contenus de Gitea. C'est le seul
    /// discriminant : le chemin de cette API est fixe, et une URL de dépôt qui
    /// n'y ressemble pas est de toute facon inutilisable.
    function IsGitea: Boolean;

    /// UN DEPOT PUBLIC EST REFUSE (Gitea comme GitHub) : chaque synchro est un
    /// commit, et l'historique garde tous les instantanes, attaquables hors
    /// ligne par quiconque peut les lire. Message a afficher, ou '' si le depot
    /// est prive ou si on n'a pas pu le savoir. Verifie une fois par instance.
    function PublicRepoWarning: string;

    /// POURQUOI UN 404 OU UN 401, en clair pour l'utilisateur. Gitea repond 404
    /// aussi bien pour un fichier absent que pour un depot ou un proprietaire
    /// inexistant : deux requetes de plus tranchent - le depot, puis
    /// l'utilisateur. Vide si rien de plus precis n'a pu etre etabli.
    function Diagnose(AHttpCode: Integer): string;

    /// Publie un conteneur. ASha est celui du fichier qu'on a lu : Gitea s'en
    /// sert pour refuser (409) une ecriture si quelqu'un d'autre a publie
    /// entre-temps. Vide = creation d'un fichier qui n'existait pas.
    ///
    /// GITEA SEULEMENT pour l'instant. L'endpoint PHP repond 405 au PUT, et
    /// lui ajouter l'ecriture n'a plus d'interet maintenant que le depot fait
    /// le meme travail avec un controle de concurrence eprouve.
    function Put(const AContainerJson, ASha, AMessage: string): TSyncResult;

    property BaseUrl: string read FBaseUrl write FBaseUrl;
    property Token: string read FToken write FToken;
    /// Volontairement court : sur mobile, un reseau qui ne repond pas doit
    /// rendre la main vite plutot que de figer l'ecran.
    property TimeoutMs: Integer read FTimeoutMs write FTimeoutMs;
  end;

implementation

uses
  System.JSON, System.NetEncoding;

function TSyncClient.IsGitea: Boolean;
begin
  // GitHub parle la meme API des contenus : meme chemin pour les deux.
  Result := FBaseUrl.ToLower.Contains('/api/v1/repos/') or
            FBaseUrl.ToLower.Contains('api.github.com/repos/');
end;

/// URL de l'API du depot (sans /contents/...), identique pour Gitea
/// (https://hote/api/v1/repos/O/R) et GitHub (https://api.github.com/repos/O/R).
function RepoApiUrl(const AContentsUrl: string): string;
var
  LP: Integer;
begin
  LP := Pos('/contents/', AContentsUrl);
  if LP > 0 then Result := Copy(AContentsUrl, 1, LP - 1) else Result := '';
end;

function TSyncClient.PublicRepoWarning: string;
var
  LHttp: THTTPClient;
  LResp: IHTTPResponse;
  LDoc: TJSONObject;
  LPriv: Boolean;
begin
  Result := '';
  if FPrivacyChecked or not IsGitea or (RepoApiUrl(FBaseUrl) = '') then Exit;
  FPrivacyChecked := True;
  LHttp := THTTPClient.Create;
  try
    LHttp.ConnectionTimeout := FTimeoutMs;
    LHttp.ResponseTimeout := FTimeoutMs;
    LHttp.HandleRedirects := False;
    LHttp.UserAgent := 'PMServer';
    // SANS JETON, expres : "public" = visible par n'importe qui. Un jeton faux
    // faisait repondre 401 avant tout verdict ; prive et anonyme = 404.
    try
      LResp := LHttp.Get(RepoApiUrl(FBaseUrl));
    except
      Exit;   // doute reseau : pas de verdict, la vraie requete le dira
    end;
    if LResp.StatusCode <> 200 then Exit;
    LDoc := TJSONObject.ParseJSONValue(LResp.ContentAsString(TEncoding.UTF8)) as TJSONObject;
    if LDoc = nil then Exit;
    try
      if LDoc.TryGetValue<Boolean>('private', LPriv) and not LPriv then
        Result := 'This repository is PUBLIC - make it private before syncing: anyone could download your encrypted vault and all its history.';
    finally
      LDoc.Free;
    end;
  finally
    LHttp.Free;
  end;
end;

function TSyncClient.Diagnose(AHttpCode: Integer): string;
var
  LHttp: THTTPClient;
  LApi, LOwner, LRepo: string;
  LParts: TArray<string>;
  LP: Integer;

  function CodeOf(const AUrl: string): Integer;
  begin
    try
      Result := LHttp.Get(AUrl).StatusCode;
    except
      Result := 0;
    end;
  end;

begin
  Result := '';
  if AHttpCode = 401 then
    Exit('Token refused - expired, revoked or mistyped');
  if (AHttpCode <> 404) or not IsGitea then Exit;
  // https://hote/api/v1/repos/O/R/contents/F  ou  https://api.github.com/repos/O/R/...
  // Tout ce qui precede "repos/" est la racine de l'API, pour les deux.
  LP := Pos('/repos/', LowerCase(FBaseUrl));
  if LP = 0 then Exit;
  LApi := Copy(FBaseUrl, 1, LP);
  LParts := Copy(FBaseUrl, LP + Length('/repos/'), MaxInt).Split(['/']);
  if Length(LParts) < 2 then Exit;
  LOwner := LParts[0];
  LRepo := LParts[1];
  LHttp := THTTPClient.Create;
  try
    LHttp.ConnectionTimeout := FTimeoutMs;
    LHttp.ResponseTimeout := FTimeoutMs;
    LHttp.HandleRedirects := False;
    LHttp.UserAgent := 'PMServer';
    LHttp.CustomHeaders['Authorization'] := 'token ' + FToken;
    case CodeOf(LApi + 'repos/' + LOwner + '/' + LRepo) of
      200: Result := 'No vault in this repository yet - sync from the PC first';
      401: Result := 'Token refused - expired, revoked or mistyped';
      404:
        if CodeOf(LApi + 'users/' + LOwner) = 404 then
          Result := 'User "' + LOwner + '" does not exist'
        else
          Result := 'Repository "' + LOwner + '/' + LRepo +
                    '" not found, or this token cannot see it';
    end;
  finally
    LHttp.Free;
  end;
end;

/// Le sha du fichier ecrit, tire de la reponse au PUT : Gitea rend
/// { "content": { "sha": ... }, "commit": { ... } }. Vide si la forme change -
/// l'appelant relira, ce qui coute un appel mais ne perd rien.
function ShaFromPutResponse(const ABody: string): string;
var
  LRoot, LContent: TJSONObject;
begin
  Result := '';
  LRoot := TJSONObject.ParseJSONValue(ABody) as TJSONObject;
  if LRoot = nil then Exit;
  try
    if LRoot.TryGetValue<TJSONObject>('content', LContent) then
      Result := LContent.GetValue<string>('sha', '');
  finally
    LRoot.Free;
  end;
end;

/// Extrait le conteneur et le sha de la reponse de l'API des contenus. Rend
/// faux, avec la raison, si la reponse n'a pas la forme attendue - une URL de
/// dépôt juste a cote rend du JSON, mais pas celui-la.
function ParseGiteaContents(const ABody: string;
  out AContainer, ASha, AError: string): Boolean;
var
  LRoot: TJSONObject;
  LEncoded, LEncoding: string;
begin
  Result := False;
  AContainer := '';
  ASha := '';
  LRoot := TJSONObject.ParseJSONValue(ABody) as TJSONObject;
  if LRoot = nil then
  begin
    AError := 'reponse Gitea illisible (pas du JSON)';
    Exit;
  end;
  try
    ASha := LRoot.GetValue<string>('sha', '');
    LEncoding := LRoot.GetValue<string>('encoding', '');
    LEncoded := LRoot.GetValue<string>('content', '');
    if (LEncoded = '') or (ASha = '') then
    begin
      AError := 'reponse Gitea sans content/sha - URL de contenu correcte ?';
      Exit;
    end;
    if not SameText(LEncoding, 'base64') then
    begin
      AError := 'encodage Gitea inattendu : ' + LEncoding;
      Exit;
    end;
    // Le base64 de Gitea est decoupe en lignes ; le decodeur s'en accommode,
    // mais on ne compte pas dessus.
    LEncoded := LEncoded.Replace(#13, '').Replace(#10, '');
    try
      AContainer := TEncoding.UTF8.GetString(TNetEncoding.Base64.DecodeStringToBytes(LEncoded));
    except
      on E: Exception do
      begin
        AError := 'base64 Gitea invalide : ' + E.Message;
        Exit;
      end;
    end;
    Result := AContainer.Trim <> '';
    if not Result then AError := 'fichier vide dans le depot';
  finally
    LRoot.Free;
  end;
end;

function TSyncClient.Put(const AContainerJson, ASha, AMessage: string): TSyncResult;
var
  LHttp: THTTPClient;
  LResp: IHTTPResponse;
  LEnv: TJSONObject;
  LReq, LResync: TStringStream;
  LB64: TBase64Encoding;
begin
  Result := Default(TSyncResult);
  Result.Status := ssNetworkError;

  if not IsGitea then
  begin
    Result.Status := ssHttpError;
    Result.Error := 'Ecriture disponible seulement vers un depot Gitea ou GitHub';
    Exit;
  end;
  if (FBaseUrl = '') or (FToken = '') then
  begin
    Result.Error := 'URL ou jeton non configure';
    Exit;
  end;
  Result.Error := PublicRepoWarning;
  if Result.Error <> '' then
  begin
    Result.Status := ssRefused;   // HttpCode 0 : refus local, pas du serveur
    Exit;
  end;

  LEnv := TJSONObject.Create;
  LB64 := TBase64Encoding.Create(0);   // pas de coupure : voir PMA.Crypto
  try
    LEnv.AddPair('message', AMessage);
    LEnv.AddPair('content',
      LB64.EncodeBytesToString(TEncoding.UTF8.GetBytes(AContainerJson)));
    // OMIS, PAS VIDE, quand on cree le fichier : Gitea lit la presence de la
    // cle comme « remplace exactement cette version-la », et une chaine vide
    // n'est pas la meme chose que son absence.
    if ASha <> '' then LEnv.AddPair('sha', ASha);
    // `branch` reste absent : le depot utilise alors sa branche par defaut,
    // plutot qu'un nom qu'on devinerait.
    LReq := TStringStream.Create(LEnv.ToJSON, TEncoding.UTF8);
    LResync := TStringStream.Create('', TEncoding.UTF8);
    try
      LHttp := THTTPClient.Create;
      try
        LHttp.ConnectionTimeout := FTimeoutMs;
        LHttp.ResponseTimeout   := FTimeoutMs;
        LHttp.HandleRedirects   := False;
        LHttp.UserAgent := 'PMServer';   // GitHub refuse toute requete sans
        LHttp.CustomHeaders['Authorization'] := 'token ' + FToken;
        LHttp.CustomHeaders['Content-Type']  := 'application/json';
        try
          LResp := LHttp.Put(FBaseUrl, LReq, LResync);
        except
          on E: Exception do
          begin
            Result.Status := ssNetworkError;
            Result.Error  := E.ClassName + ': ' + E.Message;
            Exit;
          end;
        end;
        Result.HttpCode := LResp.StatusCode;
        case LResp.StatusCode of
          200, 201:
            begin
              Result.Status := ssOK;
              // Le sha du fichier VENANT D'ETRE ECRIT, a garder pour la
              // prochaine ecriture - sans lui il faudrait relire pour publier.
              Result.ETag := ShaFromPutResponse(LResync.DataString);
            end;
          // 409 ET 422 : DANS LES DEUX CAS LE SHA N'EST PLUS LE BON.
          //
          // Gitea rend 409 quand le sha envoye ne correspond plus, et 422 quand
          // il manque ou qu'il juge la demande irrecevable - dont le cas « ce
          // fichier existe deja » d'une creation. Mesure a l'appui : un poste
          // qui publie entre notre lecture et notre ecriture nous a valu un
          // 422, pas un 409, et l'enregistrement echouait au lieu de reprendre.
          //
          // Relire et recommencer est la bonne reponse aux deux, et elle est
          // sans danger : la reprise republie avec le sha frais, donc elle
          // n'ecrase jamais rien. Un vrai corps mal forme echouerait de nouveau
          // et sortirait au bout de trois essais, avec le texte de Gitea.
          409, 422: Result.Status := ssConflict;
        else
          Result.Status := ssHttpError;
          // LE CORPS, TOUJOURS. Il etait remplace par un message fige sur 401
          // et 403 - « jeton sans droit d'ecriture » - ce qui est une
          // interpretation, pas une observation : le meme code couvre un depot
          // en lecture seule, une branche protegee, un jeton d'un autre compte.
          // Gitea dit lequel dans son corps, et le taire envoie chercher a
          // cote.
          Result.Error := Format('HTTP %d %s - %s', [LResp.StatusCode,
            LResp.StatusText, Copy(LResync.DataString, 1, 300)]);
        end;
      finally
        LHttp.Free;
      end;
    finally
      LResync.Free;
      LReq.Free;
    end;
  finally
    LB64.Free;
    LEnv.Free;
  end;
end;

constructor TSyncClient.Create(const ABaseUrl, AToken: string);
begin
  inherited Create;
  FBaseUrl   := ABaseUrl.Trim;
  FToken     := AToken.Trim;
  // 15 s ne suffisaient pas a GitHub depuis un telephone en mobile ou en
  // Wi-Fi charge : un simple 404 a ete mesure a 16,3 s, donc la requete
  // s'abandonnait juste avant la reponse et la synchro rendait "HTTP 0" une
  // fois sur deux. Le delai ne coute rien quand le reseau repond vite.
  FTimeoutMs := 40000;
end;

function TSyncClient.Fetch(const AKnownETag: string): TSyncResult;
var
  LHttp: THTTPClient;
  LResp: IHTTPResponse;
  LStream: TStringStream;
begin
  Result := Default(TSyncResult);
  Result.Status := ssNetworkError;

  if (FBaseUrl = '') or (FToken = '') then
  begin
    Result.Error := 'URL ou jeton non configure';
    Exit;
  end;
  Result.Error := PublicRepoWarning;
  if Result.Error <> '' then
  begin
    Result.Status := ssRefused;   // HttpCode 0 : refus local, pas du serveur
    Exit;
  end;

  LHttp := THTTPClient.Create;
  try
    LHttp.ConnectionTimeout := FTimeoutMs;
    LHttp.ResponseTimeout   := FTimeoutMs;
    LHttp.UserAgent := 'PMServer';   // GitHub refuse toute requete sans
    // Pas de redirection suivie : une redirection vers un autre hote nous
    // ferait envoyer le jeton ailleurs.
    LHttp.HandleRedirects := False;
    // Gitea attend "token <PAT>" pour un jeton d'acces personnel ; le PHP
    // attend "Bearer". Envoyer l'un a la place de l'autre donne un 401 qui ne
    // dit pas pourquoi.
    if IsGitea then
      LHttp.CustomHeaders['Authorization'] := 'token ' + FToken
    else
    begin
      LHttp.CustomHeaders['Authorization'] := 'Bearer ' + FToken;
      // Pas sur Gitea : le sha n'est pas un ETag HTTP, et l'envoyer ferait
      // repondre 200 avec un corps complet de toute facon.
      if AKnownETag <> '' then
        LHttp.CustomHeaders['If-None-Match'] := AKnownETag;
    end;

    LStream := TStringStream.Create('', TEncoding.UTF8);
    try
      try
        LResp := LHttp.Get(FBaseUrl, LStream);
      except
        on E: Exception do
        begin
          Result.Status := ssNetworkError;
          Result.Error  := E.ClassName + ': ' + E.Message;
          Exit;
        end;
      end;

      Result.HttpCode := LResp.StatusCode;
      Result.ETag     := LResp.HeaderValue['ETag'];

      case LResp.StatusCode of
        200:
          if IsGitea then
          begin
            if not ParseGiteaContents(LStream.DataString, Result.Container,
                                      Result.ETag, Result.Error) then
              Result.Status := ssHttpError
            // Meme sha : le contenu est celui qu'on detient deja. On rend la
            // meme reponse qu'un 304 pour que l'appelant epargne la derivation,
            // et on jette le conteneur - il ne servirait a rien.
            //
            // COMPARAISON INSENSIBLE A LA CASSE ET AUX BLANCS. Une empreinte
            // hexadecimale ne peut pas differer seulement par la casse ou par
            // un espace : trancher ainsi ne peut donc pas confondre deux
            // instantanes distincts, alors qu'une egalite stricte se laisse
            // battre par un caractere invisible - un guillemet d'en-tete, une
            // fin de ligne - et fait payer une derivation complete pour rien.
            else if (AKnownETag <> '') and
                    SameText(Result.ETag.Trim, AKnownETag.Trim) then
            begin
              Result.Status := ssNotModified;
              Result.Container := '';
            end
            else
              Result.Status := ssOK;
          end
          else
          begin
            Result.Status    := ssOK;
            Result.Container := LStream.DataString;
            // Un corps vide avec un 200 signale un proxy ou une erreur de
            // configuration, pas un instantane : le signaler ici evite un
            // "mot de passe incorrect" trompeur plus loin.
            if Result.Container.Trim = '' then
            begin
              Result.Status := ssHttpError;
              Result.Error  := '200 avec un corps vide';
            end;
          end;
        304: Result.Status := ssNotModified;
        403:
          begin
            Result.Status := ssRefused;
            Result.Error  := 'Le serveur exige HTTPS';
          end;
        // Gitea repond 404 sur un depot prive qu'on n'a pas le droit de voir,
        // comme sur un fichier absent - exactement l'ambiguite du PHP.
        404: Result.Status := ssNoSnapshot;
        401:
          begin
            Result.Status := ssHttpError;
            Result.Error  := '401 : jeton refuse';
          end;
      else
        Result.Status := ssHttpError;
        Result.Error  := 'HTTP ' + LResp.StatusCode.ToString + ' ' + LResp.StatusText;
      end;
    finally
      LStream.Free;
    end;
  finally
    LHttp.Free;
  end;
end;

end.