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

  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;

    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;

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

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.
            else if (AKnownETag <> '') and (Result.ETag = AKnownETag) 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.