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;
  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;

    /// 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
  Result := FBaseUrl.ToLower.Contains('/api/v1/repos/');
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';
    Exit;
  end;
  if (FBaseUrl = '') or (FToken = '') then
  begin
    Result.Error := 'URL ou jeton non configure';
    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.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;
  FTimeoutMs := 15000;
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;

  LHttp := THTTPClient.Create;
  try
    LHttp.ConnectionTimeout := FTimeoutMs;
    LHttp.ResponseTimeout   := FTimeoutMs;
    // 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.