Add support for private indexes to "alr publish"

doc/catalog-format-spec.md

@@ -182,14 +182,18 @@ static, i.e. they cannot depend on the context.
                   "Bob For Instance <[email protected]>"]
    ```
 
- - `maintainers-logins`: mandatory (for indexing) array of strings. Flat
-   list of github login usernames used by the maintainers of the crate. This
-   information is used to authorize crate modifications. For instance:
+ - `maintainers-logins`: optional array of non-empty strings.
+   For crates submitted to the community index, this is a mandatory flat list of
+   the GitHub login usernames authorized to modify the crate.
+   For instance:
 
    ```toml
    maintainers-logins = ["alicehacks", "bobcoder"]
    ```
 
+   Private indexes may use whichever logins are appropriate for their
+   hosting arrangement, or none at all.
+
  - `licenses`: mandatory (for indexing) string. A valid [SPDX
    expression](https://spdx.org/licenses/). Custom license identifiers are
    accepted with the format: `custom-[0-9a-zA-Z.-]+`

doc/publishing.md

@@ -313,15 +313,32 @@ This will be shown as:
 
 ## Publishing to a local/private index
 
-Having a local index may be useful sometimes, be it for local testing, or for
-private crates not intended for publication.
-
-There is no practical difference between the community index that is cloned
-locally and a private local index stored on disk. Hence, after obtaining the
-manifest file with `alr publish`, it is a matter of placing it at the expected
-location within the index: `/path/to/index/cr/crate_name/crate_name-x.x.x.toml`
-
-If the crate being published locally contains `"provides"` definitions, it is
-necessary to call `alr index --update-all` once to ensure it is properly used
-by the dependency solver. This is only necessary for the first release in a
-crate that uses the `"provides"` feature.
+Having a local or private index may be useful sometimes, be it for local
+testing, or for private crates not intended for publication.
+
+There is no practical difference between the community index and a private index
+stored locally on disk or on your own infrastructure. An index must be an
+accessible path or URL at which an `index.toml` file can be found, either at the
+root or in any immediate subdirectory. This file specifies the version of the
+index, containing one line with the form `version = "0.0.0"`. No files should be placed in the same
+location as `index.toml` except for the manifests of published crates.
+
+To start using such an index, run
+
+`alr index --add=<URL> --name=<name>`,
+
+where `<name>` is a human-friendly label that `alr` will use to refer to it.
+
+To publish a crate to a private index, run
+
+`alr publish --for-private-index [<path|URL> <commit|tag|branch>]`
+
+as described in the sections above, then place the manifest file it generates at
+the indicated path (relative to the location of `index.toml`).
+
+Additions to indexes stored locally on the disk will take effect immediately,
+unless the crate being published contains `"provides"` definitions, in which
+case an index update will be required (either with `alr index --update-all`, or
+through a scheduled auto-update) to ensure it is properly used by the dependency
+solver. An index update will always be required when publishing to a remote
+index.

src/alire/alire-properties-from_toml.ads

@@ -53,14 +53,12 @@ package Alire.Properties.From_TOML is
                   Crates.External_Shared_Section  =>
                     (Description        |
                      Maintainers        |
-                     Maintainers_Logins |
                      Name   => True,
                      others => False),
 
                   Crates.Index_Release           =>
                     (Description        |
                      Maintainers        |
-                     Maintainers_Logins |
                      Name               |
                      Version => True,
                      others  => False),

src/alire/alire-properties-labeled.adb

@@ -131,10 +131,12 @@ package body Alire.Properties.Labeled is
             end if;
 
          when Maintainers_Logins =>
-            if not Utils.Is_Valid_GitHub_Username (L.Value) then
+            --  The crate may be published through a private index, so we don't
+            --  know the requirements for a valid username; reject only an
+            --  empty string.
+            if L.Value'Length = 0 then
                From.Checked_Error
-                 ("maintainers-logins must be a valid GitHub login, but got: "
-                  & L.Value);
+                 ("maintainers-logins values must be non-empty");
             end if;
 
          when Tag =>

src/alire/alire-publish-submit.adb

@@ -298,7 +298,7 @@ package body Alire.Publish.Submit is
          Target : constant Absolute_Path
            := Local_Repo_Path
               / VFS.To_Native
-                 (TOML_Index.Manifest_Path (Context.Root.Value.Name))
+                 (TOML_Index.Community_Manifest_Path (Context.Root.Value.Name))
               / Filename;
       begin
          Directories.Create_Tree (Directories.Parent (Target));

src/alire/alire-publish.adb

@@ -173,13 +173,15 @@ package body Alire.Publish is
    -- New_Options --
    -----------------
 
-   function New_Options (Skip_Build  : Boolean := False;
-                         Skip_Submit : Boolean := False;
-                         Manifest    : String  := Roots.Crate_File_Name)
+   function New_Options (Skip_Build        : Boolean := False;
+                         Skip_Submit       : Boolean := False;
+                         For_Private_Index : Boolean := False;
+                         Manifest          : String  := Roots.Crate_File_Name)
                          return All_Options
-   is (Manifest_File => +Manifest,
-       Skip_Build    => Skip_Build,
-       Skip_Submit   => Skip_Submit);
+   is (Manifest_File     => +Manifest,
+       Skip_Build        => Skip_Build,
+       Skip_Submit       => Skip_Submit,
+       For_Private_Index => For_Private_Index);
 
    ---------------
    -- Git_Error --
@@ -228,8 +230,9 @@ package body Alire.Publish is
    -------------------
    -- Check_Release --
    -------------------
-   --  Checks the presence of recommended/mandatory fileds in the release
-   procedure Check_Release (Release : Releases.Release) is
+   --  Checks the presence of recommended/mandatory fields in the release
+   procedure Check_Release (Release : Releases.Release; Context : in out Data)
+   is
       use CLIC.User_Input;
 
       Recommend : AAA.Strings.Vector; -- Optional
@@ -294,6 +297,20 @@ package body Alire.Publish is
          end if;
       end loop;
 
+      --  The maintainers-logins field is mandatory only if publishing to the
+      --  community index
+
+      if not Context.Options.For_Private_Index then
+         declare
+            Key_String : constant String := Tomify
+              (Properties.From_TOML.Maintainers_Logins'Image);
+         begin
+            if not Release.Has_Property (Key_String) then
+               Missing.Append (Key_String);
+            end if;
+         end;
+      end if;
+
       Caret_Pre_1 := Release.Check_Caret_Warning;
 
       if not Missing.Is_Empty then
@@ -312,6 +329,26 @@ package body Alire.Publish is
                         & " not be pre-release versions.");
       end if;
 
+      --  If we are submitting to the community index, the maintainers-logins
+      --  values must be valid GitHub usernames
+      if not Context.Options.For_Private_Index then
+         for Property of Release.Maint_Logins loop
+            declare
+               Maint_Login : constant String := Property.To_TOML.As_String;
+            begin
+               if not Utils.Is_Valid_GitHub_Username (Maint_Login) then
+                  Raise_Checked_Error ("The maintainer login '"
+                                       & Maint_Login
+                                       & "' is not a valid GitHub username");
+               end if;
+
+               --  We could also check GitHub.User_Exists at this point, but it
+               --  isn't worth the GitHub API call (running the testsuite a
+               --  couple of times would trigger GitHub's rate limits)
+            end;
+         end loop;
+      end if;
+
       --  Final confirmation. We default to Yes if no recommended missing or
       --  Force.
 
@@ -392,7 +429,8 @@ package body Alire.Publish is
                           (Starting_Manifest (Context),
                            Alire.Manifest.Local,
                            Strict    => True,
-                           Root_Path => Adirs.Full_Name (+Context.Path)));
+                           Root_Path => Adirs.Full_Name (+Context.Path)),
+                        Context);
          --  Will have raised if the release is not loadable or incomplete
       else
          declare
@@ -408,7 +446,7 @@ package body Alire.Publish is
                     ("Invalid metadata found at " & Root.Value.Path,
                      Root.Brokenness));
             when Valid =>
-               Check_Release (Root.Value.Release);
+               Check_Release (Root.Value.Release, Context);
             end case;
          end;
       end if;
@@ -557,8 +595,8 @@ package body Alire.Publish is
            ("Your index manifest file has been generated at "
             & TTY.URL (Index_Manifest));
 
-         --  Ask to submit, or show the upload URL if submission skipped, or a
-         --  more generic message otherwise (when lacking a github login).
+         --  Ask to submit, or provide submission instructions if submission
+         --  skipped.
 
          if not Context.Options.Skip_Submit then
             --  Safeguard to avoid tests creating a live pull request, unless
@@ -580,23 +618,40 @@ package body Alire.Publish is
             then
                raise Early_Stop;
             end if;
+         elsif Context.Options.For_Private_Index then
+            --  We are publishing to a private index, the location of which is
+            --  unknown, so we can only give generic instructions on where to
+            --  place the file.
+            Put_Info
+              ("Please upload this to the index in the "
+               & TTY.URL (String (TOML_Index.Manifest_Path (Name)) & "/")
+               & " subdirectory.");
          elsif not Settings.Builtins.User_Github_Login.Is_Empty then
+            --  The user has provided a GitHub login, so provide an upload URL
+            --  to create a pull request.
             Put_Info
-              ("Please upload this file to "
+              ("If you haven't already, please fork "
+               & TTY.URL (Tail (Index.Community_Repo, '+'))
+               & " to your GitHub.");
+            Put_Info
+              ("This file can then be uploaded to "
                & TTY.URL
                  (Index.Community_Host & "/"
                   & Settings.Builtins.User_Github_Login.Get & "/"
                   & Index.Community_Repo_Name
                   & "/upload/"
                   & Index.Community_Branch & "/"
-                  & String (TOML_Index.Manifest_Path (Name)))
+                  & String (TOML_Index.Community_Manifest_Path (Name)))
                & " to create a pull request against the community index.");
          else
+            --  We don't have the user's GitHub username, so show a more
+            --  generic message.
             Put_Info
               ("Please create a pull request against the community index at "
                & TTY.URL (Tail (Index.Community_Repo, '+'))
                & " including this file at "
-               & TTY.URL (String (TOML_Index.Manifest_Path (Name))));
+               & TTY.URL
+                 (String (TOML_Index.Community_Manifest_Path (Name)) & "/"));
          end if;
 
       exception
@@ -797,7 +852,7 @@ package body Alire.Publish is
                        Root_Path => Adirs.Full_Name (+Context.Path))
                     .Replacing (Origin => Context.Origin);
    begin
-      Check_Release (Release);
+      Check_Release (Release, Context);
    end Show_And_Confirm;
 
    -------------------
@@ -867,18 +922,20 @@ package body Alire.Publish is
 
       if URI.Scheme (URL) not in URI.HTTP then
          --  A git@ URL is private to the user and should not be used for
-         --  packaging:
+         --  packaging via the the community index
          if AAA.Strings.Has_Prefix (URL, "git@") then
-            Raise_Checked_Error
-              ("The origin cannot use a private git remote: " & URL);
-         end if;
+            if not Context.Options.For_Private_Index then
+               Raise_Checked_Error
+                  ("The origin cannot use a private remote: " & URL);
+            end if;
 
          --  Otherwise we assume this is a local path
-
-         Recoverable_User_Error
-           ("The origin must be a definitive remote location, but is " & URL);
-         --  For testing we may want to allow local URLs, or may be for
-         --  internal use with network drives? So allow forcing it.
+         else
+            Recoverable_User_Error
+            ("The origin must be a definitive remote location, but is " & URL);
+            --  For testing we may want to allow local URLs, or may be for
+            --  internal use with network drives? So allow forcing it.
+         end if;
       end if;
 
       Put_Success ("Origin is of supported kind: " & Context.Origin.Kind'Img);
@@ -1017,9 +1074,13 @@ package body Alire.Publish is
       Run_Steps (Context,
                  (Step_Check_User_Manifest,
                   Step_Prepare_Archive,
-                  Step_Verify_Origin,
-                  Step_Verify_Github,
-                  Step_Deploy_Sources,
+                  Step_Verify_Origin)
+                 &
+                 (if Options.Skip_Submit
+                    then No_Steps
+                    else (1 => Step_Verify_Github))
+                 &
+                 (Step_Deploy_Sources,
                   Step_Check_Build,
                   Step_Show_And_Confirm,
                   Step_Generate_Index_Manifest)
@@ -1164,9 +1225,16 @@ package body Alire.Publish is
                --  requires the owner keys.
                case URI.Scheme (Fetch_URL) is
                when URI.VCS_Schemes =>
-                  Raise_Checked_Error
-                    ("The remote URL seems to require repository ownership: "
-                     & Fetch_URL);
+                  if Options.For_Private_Index then
+                     Publish.Remote_Origin (URL     => Raw_URL,
+                                            Commit  => Commit,
+                                            Subdir  => +Subdir,
+                                            Options => Options);
+                  else
+                     Raise_Checked_Error
+                       ("The remote URL seems to require repository "
+                        & "ownership: " & Fetch_URL);
+                  end if;
                when URI.None | URI.Unknown =>
                   Publish.Remote_Origin (URL     => "git+file:" & Raw_URL,
                                          Commit  => Commit,
@@ -1249,9 +1317,13 @@ package body Alire.Publish is
                       Token          => <>);
       begin
          Run_Steps (Context,
-                    (Step_Verify_Origin,
-                     Step_Verify_Github,
-                     Step_Deploy_Sources,
+                    (Step_Verify_Origin)
+                    &
+                    (if Options.Skip_Submit
+                       then No_Steps
+                       else (1 => Step_Verify_Github))
+                    &
+                    (Step_Deploy_Sources,
                      Step_Check_Build,
                      Step_Show_And_Confirm,
                      Step_Generate_Index_Manifest)

src/alire/alire-publish.ads

@@ -8,9 +8,10 @@ package Alire.Publish is
 
    type All_Options is private;
 
-   function New_Options (Skip_Build  : Boolean := False;
-                         Skip_Submit : Boolean := False;
-                         Manifest    : String  := Roots.Crate_File_Name)
+   function New_Options (Skip_Build        : Boolean := False;
+                         Skip_Submit       : Boolean := False;
+                         For_Private_Index : Boolean := False;
+                         Manifest          : String  := Roots.Crate_File_Name)
                          return All_Options;
 
    procedure Directory_Tar (Path     : Any_Path := ".";
@@ -55,9 +56,10 @@ package Alire.Publish is
 private
 
    type All_Options is tagged record
-      Manifest_File : UString;
-      Skip_Build    : Boolean := False;
-      Skip_Submit   : Boolean := False;
+      Manifest_File     : UString;
+      Skip_Build        : Boolean := False;
+      Skip_Submit       : Boolean := False;
+      For_Private_Index : Boolean := False;
    end record;
 
    function Manifest (Options : All_Options) return Any_Path