unit PMA.Favicon;
{
  L'icone d'un site, par le relais de DuckDuckGo.

  MEME SOURCE QUE LE POSTE, et pour la meme raison. Aller chercher
  `https://<site>/favicon.ico` en direct ferait resoudre un DNS - et ouvrir une
  connexion - vers CHAQUE domaine range dans le coffre. La liste des sites ou
  quelqu'un a un compte est precisement ce que ce coffre protege : la donner au
  reseau pour un dessin de seize pixels serait un mauvais marche.

  Le relais, lui, ne voit qu'une chose : que quelqu'un s'interesse a ce domaine.
  C'est deja quelque chose, d'ou le caractere facultatif de l'appel - il ne part
  que lorsqu'on le demande, entree par entree.

  DEUX ESSAIS : l'hote complet, puis le domaine de second niveau. `chat.qwen.ai`
  n'a pas d'icone chez le relais, `qwen.ai` en a une.
}

interface

uses
  System.SysUtils;

/// Rend une URI `data:` prete a etre rangee dans `icon_b64`, ou '' si rien
/// n'a ete trouve - AError dit alors pourquoi.
function FetchFaviconDataUri(const ASite: string; out AError: string): string;

/// L'hote d'une adresse, sans schema ni chemin. Public parce que c'est aussi
/// ce qu'il faut pour decider s'il y a quelque chose a chercher.
function HostOf(const ASite: string): string;

implementation

uses
  System.Classes, System.NetEncoding, System.Net.HttpClient,
  System.Net.URLClient;

const
  // 64 Ko : une icone de site en fait quelques-uns. Au-dela, ce n'est pas une
  // icone, et l'accepter ferait gonfler l'instantane que chaque enregistrement
  // republie en entier.
  MAX_BYTES = 64 * 1024;
  TIMEOUT_MS = 5000;

function HostOf(const ASite: string): string;
var
  I: Integer;
begin
  Result := Trim(ASite);
  if Result = '' then Exit;
  I := Pos('://', Result);
  if I > 0 then Result := Copy(Result, I + 3, MaxInt);
  // Chemin, requete, ancre, et les identifiants d'une URL a la user@host.
  I := Pos('/', Result); if I > 0 then Result := Copy(Result, 1, I - 1);
  I := Pos('?', Result); if I > 0 then Result := Copy(Result, 1, I - 1);
  I := Pos('#', Result); if I > 0 then Result := Copy(Result, 1, I - 1);
  I := LastDelimiter('@', Result);
  if I > 0 then Result := Copy(Result, I + 1, MaxInt);
  I := Pos(':', Result); if I > 0 then Result := Copy(Result, 1, I - 1);
  Result := LowerCase(Trim(Result));
  // Un site note "Gitea" plutot qu'en adresse n'a pas d'hote : sans point, il
  // n'y a rien a demander au relais.
  if Pos('.', Result) = 0 then Result := '';
end;

/// Le domaine de second niveau, ou '' s'il n'y a rien de plus court a essayer.
function SecondLevel(const AHost: string): string;
var
  LParts: TArray<string>;
begin
  Result := '';
  LParts := AHost.Split(['.']);
  if Length(LParts) < 3 then Exit;   // deja un SLD
  Result := LParts[High(LParts) - 1] + '.' + LParts[High(LParts)];
end;

/// Le type d'apres les premiers octets, jamais d'apres l'extension : le relais
/// rend du PNG sous une adresse en .ico, et un type faux ferait afficher un
/// cadre vide sans rien dire.
function SniffMime(const AData: TBytes): string;
begin
  Result := '';
  if Length(AData) < 4 then Exit;
  if (AData[0] = $89) and (AData[1] = Ord('P')) then Result := 'image/png'
  else if (AData[0] = $FF) and (AData[1] = $D8) then Result := 'image/jpeg'
  else if (AData[0] = Ord('G')) and (AData[1] = Ord('I')) then Result := 'image/gif'
  else if (AData[0] = 0) and (AData[1] = 0) and (AData[2] = 1) then
    Result := 'image/x-icon'
  else if (AData[0] = Ord('<')) then Result := 'image/svg+xml';
end;

function TryHost(const AHost: string; out AData: TBytes): Boolean;
var
  LHttp: THTTPClient;
  LStream: TBytesStream;
  LResp: IHTTPResponse;
begin
  Result := False;
  AData := nil;
  LHttp := THTTPClient.Create;
  try
    LHttp.ConnectionTimeout := TIMEOUT_MS;
    LHttp.ResponseTimeout := TIMEOUT_MS;
    LHttp.MaxRedirects := 3;
    LStream := TBytesStream.Create;
    try
      try
        LResp := LHttp.Get('https://icons.duckduckgo.com/ip3/' + AHost + '.ico',
                           LStream);
      except
        Exit;
      end;
      if LResp.StatusCode <> 200 then Exit;
      if (LStream.Size = 0) or (LStream.Size > MAX_BYTES) then Exit;
      AData := Copy(LStream.Bytes, 0, LStream.Size);
      Result := True;
    finally
      LStream.Free;
    end;
  finally
    LHttp.Free;
  end;
end;

function FetchFaviconDataUri(const ASite: string; out AError: string): string;
var
  LHost, LSld, LMime: string;
  LData: TBytes;
  LB64: TBase64Encoding;
begin
  Result := '';
  AError := '';
  LHost := HostOf(ASite);
  if LHost = '' then
  begin
    AError := 'this entry has no web address';
    Exit;
  end;

  if not TryHost(LHost, LData) then
  begin
    LSld := SecondLevel(LHost);
    if (LSld = '') or not TryHost(LSld, LData) then
    begin
      AError := 'no icon found for ' + LHost;
      Exit;
    end;
  end;

  LMime := SniffMime(LData);
  if LMime = '' then
  begin
    AError := 'what came back is not an image';
    Exit;
  end;

  // SANS COUPURE DE LIGNE. L'encodeur de Delphi coupe a 76 caracteres par
  // defaut ; une URI data: coupee ne s'affiche pas, et le piege s'est deja
  // paye une fois sur les conteneurs.
  LB64 := TBase64Encoding.Create(0);
  try
    Result := 'data:' + LMime + ';base64,' + LB64.EncodeBytesToString(LData);
  finally
    LB64.Free;
  end;
end;

end.