From 748b833f82b22d2234d3e03eee7628b3036927ef Mon Sep 17 00:00:00 2001
From: Alejandro R Mosteo <amosteo@unizar.es>
Date: Fri, 27 Jan 2023 17:58:00 +0100
Subject: [PATCH] Check remote hosts during `alr index --check` (#1309)

---
 src/alire/alire-index.adb      | 26 ++++++++++++++++++++++++++
 src/alire/alire-index.ads      |  5 +++++
 src/alire/alire-publish.adb    | 14 +++++++++++---
 src/alire/alire-publish.ads    |  3 +++
 src/alr/alr-commands-index.adb |  6 ++++--
 5 files changed, 49 insertions(+), 5 deletions(-)

diff --git a/src/alire/alire-index.adb b/src/alire/alire-index.adb
index dbdba8a3..4457db98 100644
--- a/src/alire/alire-index.adb
+++ b/src/alire/alire-index.adb
@@ -3,6 +3,7 @@ with Ada.Containers.Indefinite_Ordered_Sets;
 
 with Alire.Containers;
 with Alire.Index_On_Disk.Loading;
+with Alire.Publish;
 with Alire.Utils.TTY;
 
 package body Alire.Index is
@@ -118,6 +119,31 @@ package body Alire.Index is
      new Ada.Containers.Indefinite_Ordered_Sets (Crate_Name);
    Already_Detected : Name_Sets.Set;
 
+   --------------------
+   -- Check_Contents --
+   --------------------
+
+   procedure Check_Contents is
+      OK : Boolean := True;
+   begin
+      for Crate of All_Crates.all loop
+         for Rel of Crate.Releases loop
+            if Rel.Origin.Kind in Origins.VCS_Kinds then
+               if not Publish.Is_Trusted (Rel.Origin.URL) then
+                  OK := False;
+                  Put_Warning ("Release " & Rel.Milestone.TTY_Image
+                               & " has URL not in known hosts: "
+                                 & TTY.URL (Rel.Origin.URL));
+               end if;
+            end if;
+         end loop;
+      end loop;
+
+      if not OK then
+         Raise_Checked_Error ("Issues were found in index contents");
+      end if;
+   end Check_Contents;
+
    ----------------------
    -- Detect_Externals --
    ----------------------
diff --git a/src/alire/alire-index.ads b/src/alire/alire-index.ads
index 26854841..49d8da98 100644
--- a/src/alire/alire-index.ads
+++ b/src/alire/alire-index.ads
@@ -153,4 +153,9 @@ package Alire.Index is
    function All_Crate_Aliases return access Provides.Crate_Provider_Map;
    --  For use from the loading functions; not intended for normal clients
 
+   procedure Check_Contents;
+   --  Applies some checks to alreadly loaded crates that cannot be easily
+   --  applied during load:
+   --  * Whether some origin is not in our allowed hosting sites.
+
 end Alire.Index;
diff --git a/src/alire/alire-publish.adb b/src/alire/alire-publish.adb
index bd8ce6db..47897d1d 100644
--- a/src/alire/alire-publish.adb
+++ b/src/alire/alire-publish.adb
@@ -831,9 +831,7 @@ package body Alire.Publish is
              --  for local file on Windows, where drive letters are interpreted
              --  as the scheme).
            or else
-            (for some Site of Trusted_Sites =>
-               URI.Authority_Without_Credentials (URL) = Site or else
-               Has_Suffix (URI.Authority (URL), "." & Site))
+            Is_Trusted (URL)
          then
             Put_Success ("Origin is hosted on trusted site: "
                          & URI.Authority_Without_Credentials (URL));
@@ -935,6 +933,16 @@ package body Alire.Publish is
                   Step_Generate_Index_Manifest));
    end Directory_Tar;
 
+   ----------------
+   -- Is_Trusted --
+   ----------------
+
+   function Is_Trusted (URL : Alire.URL) return Boolean
+   is (for some Site of Trusted_Sites =>
+          URI.Authority_Without_Credentials (URL) = Site
+       or else
+          Has_Suffix (URI.Authority (URL), "." & Site));
+
    ----------------------
    -- Local_Repository --
    ----------------------
diff --git a/src/alire/alire-publish.ads b/src/alire/alire-publish.ads
index e0b1532b..74f2650f 100644
--- a/src/alire/alire-publish.ads
+++ b/src/alire/alire-publish.ads
@@ -38,6 +38,9 @@ package Alire.Publish is
    procedure Print_Trusted_Sites;
    --  Print our list of allowed sites to host git releases
 
+   function Is_Trusted (URL : Alire.URL) return Boolean;
+   --  According to our whitelist
+
 private
 
    type All_Options is tagged record
diff --git a/src/alr/alr-commands-index.adb b/src/alr/alr-commands-index.adb
index c357aa4b..47d21ac0 100644
--- a/src/alr/alr-commands-index.adb
+++ b/src/alr/alr-commands-index.adb
@@ -1,6 +1,7 @@
 with AAA.Table_IO;
 
 with Alire.Config.Edit;
+with Alire.Index;
 with Alire.Index_On_Disk.Loading;
 with Alire.Utils;
 
@@ -137,7 +138,8 @@ package body Alr.Commands.Index is
    procedure Check (Cmd : in out Command) is
    begin
       Cmd.Requires_Full_Index (Strict => True);
-      Alire.Put_Success ("No unknown values found in index contents.");
+      Alire.Index.Check_Contents;
+      Alire.Put_Success ("No issues found in index contents.");
    end Check;
 
    ----------
@@ -250,7 +252,7 @@ package body Alr.Commands.Index is
          Output      => Cmd.Check'Access,
          Long_Switch => "--check",
          Help        =>
-           "Check index contents for unknown configuration values");
+           "Runs diagnostics on index contents (unknown values, hosts, etc.)");
 
       Define_Switch
         (Config      => Config,
-- 
2.39.5