Treat http with non-empty userinfo as private

src/alire/alire-index_on_disk.adb

@@ -241,7 +241,7 @@ package body Alire.Index_On_Disk is
             Result := Outcome_Failure ("Unknown index kind: " & Origin);
             return New_Invalid_Index;
 
-         when URI.Public_Other | URI.SSH_Other =>
+         when URI.HTTP_Other | URI.SSH_Other =>
             --  Warn that URL is not recognized and suggest 'git+http' or
             --  'git+ssh' instead.
             Result := Outcome_Failure

src/alire/alire-origins.adb

@@ -413,7 +413,7 @@ package body Alire.Origins is
             return New_Hg (VCS_URL, Commit, Subdir);
          when URI.SVN_URIs =>
             return New_SVN (VCS_URL, Commit, Subdir);
-         when URI.Public_Other | URI.SSH_Other =>
+         when URI.HTTP_Other | URI.SSH_Other =>
             Raise_Checked_Error ("ambiguous VCS URL: " & URL);
          when others =>
             Raise_Checked_Error ("unknown VCS URL: " & URL);
@@ -612,9 +612,9 @@ package body Alire.Origins is
             This := New_Filesystem (URI.Local_Path (URL));
 
          when URI.VCS_URIs                 =>
-            if URL_Kind = Public_Probably_Git and then Hashed then
-               --  To resolve the ambiguity of Public_Probably_Git, assume a
-               --  source archive if the "hashes" field is present.
+            if URL_Kind in URI.Probably_Git and then Hashed then
+               --  To resolve the ambiguity of Probably_Git, assume a source
+               --  archive if the "hashes" field is present.
                Load_Source_Archive (This, Table, URL);
             else
                --  In all other cases, treat this as a git repo.
@@ -634,7 +634,7 @@ package body Alire.Origins is
                end;
             end if;
 
-         when Public_Other                 =>
+         when URI.HTTP_Other               =>
             Load_Source_Archive (This, Table, URL);
 
          when SSH_Other                    =>
@@ -645,7 +645,7 @@ package body Alire.Origins is
          when System                       =>
             This := New_System (URI.Path (URL));
 
-         when Unknown               =>
+         when Unknown                      =>
             From.Checked_Error ("unsupported scheme in URL: " & URL);
          end case;
 

src/alire/alire-publish.adb

@@ -807,7 +807,7 @@ package body Alire.Publish is
 
          function Get_Default (Remote_URL : String)
                                return Answer_Kind
-         is (if Force or else URI.URI_Kind (Remote_URL) in URI.Public_Other
+         is (if Force or else URI.URI_Kind (Remote_URL) in URI.HTTP_Other
              then Yes
              else No);
 
@@ -1238,7 +1238,7 @@ package body Alire.Publish is
       --  to be the case).
 
       if Commit = "" and then Kind in URI.VCS_URIs then
-         if Kind in URI.Public_Probably_Git then
+         if Kind in URI.Probably_Git then
             Put_Warning ("Assuming origin is a source archive "
                          & "because no commit was provided.");
          else

src/alire/alire-uri.adb

@@ -7,13 +7,27 @@ package body Alire.URI is
    function Authority_Without_Credentials (This : URL) return String is
       Auth : constant String := Authority (This);
    begin
-      if (for some Char of Auth => Char = '@') then
-         return AAA.Strings.Tail (Auth, '@');
+      if Contains (Auth, "@") then
+         return Tail (Auth, '@');
       else
          return Auth;
       end if;
    end Authority_Without_Credentials;
 
+   --------------
+   -- Userinfo --
+   --------------
+
+   function Userinfo (This : URL) return String is
+      Auth : constant String := Authority (This);
+   begin
+      if Contains (Auth, "@") then
+         return Head (Auth, '@');
+      else
+         return "";
+      end if;
+   end Userinfo;
+
    -------------------
    -- Host_From_URL --
    -------------------
@@ -78,7 +92,8 @@ package body Alire.URI is
    --------------
 
    function URI_Kind (This : String) return URI_Kinds is
-      Scheme : constant String := L (U.Scheme (This));
+      Scheme       : constant String := L (U.Scheme (This));
+      Has_Userinfo : constant Boolean := (Userinfo (This) /= "");
    begin
       if Scheme = "external" then
          return External;
@@ -94,11 +109,13 @@ package body Alire.URI is
          --  required by git (https://git-scm.com/docs/git-clone#URLS)
          return SCP_Style_Git;
       elsif Scheme = "git+https" or else Scheme = "git+http" then
-         return Public_Definitely_Git;
+         return (if Has_Userinfo
+                 then Private_Definitely_Git
+                 else Public_Definitely_Git);
       elsif Scheme = "git+file" then
          return Local_Git;
       elsif Has_Prefix (Scheme, "git+") then
-         return Other_Git;
+         return Private_Definitely_Git;
       elsif Scheme = "hg+https" or else Scheme = "hg+http" then
          return Public_Hg;
       elsif Scheme = "hg+file" then
@@ -113,21 +130,27 @@ package body Alire.URI is
          return Private_SVN;
       elsif Scheme = "http" or else Scheme = "https" then
          if Has_Git_Suffix (This) then
-            return Public_Definitely_Git;
+            return (if Has_Userinfo
+                    then Private_Definitely_Git
+                    else Public_Definitely_Git);
          elsif Is_Known_Git_Host (Host_From_URL (This)) then
             --  These are known git hosts, so recognize them even without a
             --  ".git" suffix
-            return Public_Probably_Git;
+            return (if Has_Userinfo
+                    then Private_Probably_Git
+                    else Public_Probably_Git);
          else
-            return Public_Other;
+            return (if Has_Userinfo
+                    then Private_HTTP_Other
+                    else Public_HTTP_Other);
          end if;
       elsif Scheme = "ssh" then
          if Has_Git_Suffix (This) then
-            return Other_Git;
+            return Private_Definitely_Git;
          elsif Is_Known_Git_Host (Host_From_URL (This)) then
             --  These are known git hosts (over SSH, so This can't be a raw
             --  file), so recognize them even without a ".git" suffix
-            return Other_Git;
+            return Private_Definitely_Git;
          else
             return SSH_Other;
          end if;
@@ -166,7 +189,7 @@ package body Alire.URI is
          when Bare_Path =>
             --  Convert "/some/path" to "vcs+file:/some/path"
             return VCS_Prefix & To_URL (This);
-         when SSH_Other | Public_Other | File =>
+         when HTTP_Other | SSH_Other | File =>
             --  Not recognizable, so prepend prefix
             return VCS_Prefix & This;
          when VCS_URIs =>
@@ -176,8 +199,8 @@ package body Alire.URI is
             elsif Current_Kind = SCP_Style_Git then
                --  git@host:/path is already explicit
                return This;
-            elsif Current_Kind = Public_Probably_Git then
-               --  Prepend prefix to make it Public_Definitely_Git
+            elsif Current_Kind in Probably_Git then
+               --  Prepend prefix to make it *_Definitely_Git
                return VCS_Prefix & This;
             else
                --  This is already recognized as the correct VCS, so do nothing

src/alire/alire-uri.ads

@@ -45,7 +45,8 @@ package Alire.URI with Preelaborate is
       --  Scheme is "git+file:"
 
       Public_Probably_Git,
-      --  Scheme is "http:"/"https:" and host is known to serve git repos
+      --  Scheme is "http:"/"https:", userinfo component is empty or absent and
+      --  host is known to serve git repos
       --
       --  Such URLs are occasionally raw file downloads, not repositories, but
       --  will never be a non-git VCS.
@@ -57,7 +58,14 @@ package Alire.URI with Preelaborate is
       SCP_Style_Git,
       --  An SCP-like git remote, with the form git@host:path
 
-      Other_Git,
+      Private_Probably_Git,
+      --  Scheme is "http:"/"https:", userinfo component is non-empty and host
+      --  is known to serve git repos
+      --
+      --  Such URLs are occasionally raw file downloads, not repositories, but
+      --  will never be a non-git VCS.
+
+      Private_Definitely_Git,
       --  Recognizably git and scheme is "ssh:", or scheme
       --  is "git+<proto>:" (where proto is not "http"/"https" or "file")
 
@@ -76,9 +84,12 @@ package Alire.URI with Preelaborate is
       File,
       --  Scheme is "file:"
 
-      Public_Other,
+      Public_HTTP_Other,
       --  http/https, but not a recognized VCS
 
+      Private_HTTP_Other,
+      --  Scheme is http/https, userinfo is non-empty and not a recognized VCS
+
       SSH_Other,
       --  ssh, but not a recognized VCS
 
@@ -88,18 +99,30 @@ package Alire.URI with Preelaborate is
 
    subtype Local_Other is URI_Kinds range Bare_Path .. File;
 
+   subtype HTTP_Other is URI_Kinds
+     range Public_HTTP_Other .. Private_HTTP_Other;
+
    subtype Public_Git is URI_Kinds
      range Public_Probably_Git .. Public_Definitely_Git;
    --  Note that this includes the ambiguous case Public_Probably_Git
 
-   subtype Private_Git is URI_Kinds range SCP_Style_Git .. Other_Git;
+   subtype Private_Git is URI_Kinds
+     range SCP_Style_Git .. Private_Definitely_Git;
+   --  Note that this includes the ambiguous case Public_Probably_Git
+
+   subtype Probably_Git is URI_Kinds
+     with Static_Predicate =>
+       Probably_Git in Private_Probably_Git | Public_Probably_Git;
+
+   subtype Private_Other is URI_Kinds range Private_HTTP_Other .. SSH_Other;
 
    subtype Non_URLs is URI_Kinds
      with Static_Predicate =>
        Non_URLs in External | System | SCP_Style_Git | Bare_Path | Unknown;
 
    subtype VCS_URIs is URI_Kinds range Local_Git .. Private_SVN;
-   --  Note that this includes the ambiguous case Public_Probably_Git
+   --  Note that this includes the ambiguous cases Public_Probably_Git and
+   --  Private_Probably_Git
 
    subtype Local_VCS_URIs is URI_Kinds
      with Static_Predicate =>
@@ -116,18 +139,20 @@ package Alire.URI with Preelaborate is
 
    subtype Public_URIs is URI_Kinds
      with Static_Predicate =>
-       Public_URIs in Public_VCS_URIs | Public_Other;
+       Public_URIs in Public_VCS_URIs | Public_HTTP_Other;
 
    subtype Private_VCS_URIs is URI_Kinds
      with Static_Predicate =>
        Private_VCS_URIs in Private_Git | Private_Hg | Private_SVN;
+   --  Note that this includes the ambiguous case Private_Probably_Git
 
    subtype Private_URIs is URI_Kinds
      with Static_Predicate =>
-       Private_URIs in Private_VCS_URIs | SSH_Other;
+       Private_URIs in Private_VCS_URIs | Private_Other;
 
-   subtype Git_URIs is VCS_URIs range Local_Git .. Other_Git;
-   --  Note that this includes the ambiguous case Public_Probably_Git
+   subtype Git_URIs is VCS_URIs range Local_Git .. Private_Definitely_Git;
+   --  Note that this includes the ambiguous cases Public_Probably_Git and
+   --  Private_Probably_Git
 
    subtype Hg_URIs is VCS_URIs range Local_Hg .. Private_Hg;
 
@@ -141,11 +166,7 @@ package Alire.URI with Preelaborate is
    --    host.name:/path/to/repo.git      [returns Unknown]
    --    git://host/path/to/repo.git      [returns Unknown]
    --    ftp://host/path/to/repo.git      [returns Unknown]
-   --    svn://(something)                [returns Unknown]
-   --    https://user:pass@host/repo.git  [returns Public_Git]
-   --    https://user@host/repo.git       [returns Public_Git]
-   --    https://user:pass@host/path      [returns Public_Other]
-   --    https://user@host/path           [returns Public_Other]
+   --    svn://host/path/to/repo          [returns Unknown]
 
    type VCS_Kinds is (Git, Hg, SVN);
 
@@ -158,6 +179,11 @@ package Alire.URI with Preelaborate is
    function Authority_Without_Credentials (This : URL) return String;
    --  Only the part after @ in an authority
 
+   function Userinfo (This : URL) return String;
+   --  Only the part before @ in an authority
+   --
+   --  Returns an empty string if there is no @.
+
    function Host (This : URL) return String;
    --  The host part of a remote URL
    --
@@ -233,9 +259,9 @@ private
    type String_Access is access constant String;
    type Prefix_Array is array (VCS_Kinds) of String_Access;
 
-   Prefix_Git      : aliased constant String := "git+";
-   Prefix_Hg       : aliased constant String := "hg+";
-   Prefix_SVN      : aliased constant String := "svn+";
+   Prefix_Git : aliased constant String := "git+";
+   Prefix_Hg  : aliased constant String := "hg+";
+   Prefix_SVN : aliased constant String := "svn+";
 
    VCS_Prefixes : constant Prefix_Array := (Git => Prefix_Git'Access,
                                             Hg  => Prefix_Hg'Access,

testsuite/tests/publish/check-trusted/test.py

@@ -14,12 +14,16 @@
     assert_match(f".*Origin is hosted on unknown site: {domain}.*", p.out)
 
 # Try that having credentials doesn't interfere with the previous check and
-# that the domain was recognized properly
+# that the domain was recognized properly.
+#
+# The presence of credentials means the origin is considered private, so
+# we use '--for-private-index' to skip the "The origin cannot use a private
+# remote" error.
 for domain in ["badsite.com", "ggithub.com", "github.comm"]:
     for creds in ["user", "user:passwd"]:
         p = run_alr("publish", f"http://{creds}@{domain}/repo.git",
                     "deadbeefdeadbeefdeadbeefdeadbeefdeadbeef",
-                    "--skip-submit",
+                    "--for-private-index",
                     complain_on_error=False)
         assert_match(f".*Origin is hosted on unknown site: {domain}.*", p.out)