From 90d45e985933d4db82b4531287056d2607483d4f Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Thu, 25 Mar 2021 18:29:36 +0100 Subject: [PATCH] Use of git repositories as pin remotes (#715) * Skeleton function and calls from Commands.* * Use a remote commit for a local pin * Ensure remote pins are in place for build * Show info for remote pins * Fix url section separator @ -> # * Generalize transitive links for remote links * Display remote source in `alr pin` * Refactor a few paths for reuse * New test for pinned remote * Document new feature * Fix help for affected commands * Tweaks during self-review * Fix test for Windows * Ensure cache is deletable on Windows --- doc/user-changes.md | 10 ++ src/alire/alire-directories.adb | 74 ++++++-- src/alire/alire-directories.ads | 14 ++ src/alire/alire-externals-softlinks.adb | 67 ++++++- src/alire/alire-externals-softlinks.ads | 65 ++++++- src/alire/alire-features-index.adb | 4 +- src/alire/alire-index_on_disk.ads | 2 +- src/alire/alire-origins-tweaks.adb | 2 +- src/alire/alire-origins.adb | 1 - src/alire/alire-origins.ads | 11 +- src/alire/alire-roots.adb | 185 +++++++++++++++++++- src/alire/alire-roots.ads | 29 ++- src/alire/alire-solutions.adb | 58 +++--- src/alire/alire-uri.ads | 8 +- src/alire/alire-vcss-git.adb | 30 ++++ src/alire/alire-vcss-git.ads | 5 + src/alire/alire-vcss.adb | 6 +- src/alire/alire-vcss.ads | 6 +- src/alr/alr-commands-clean.adb | 7 +- src/alr/alr-commands-pin.adb | 59 +++++-- src/alr/alr-commands-pin.ads | 3 +- src/alr/alr-commands-withing.adb | 83 ++++++++- src/alr/alr-commands-withing.ads | 15 +- testsuite/tests/pin/remote/test.py | 66 +++++++ testsuite/tests/pin/remote/test.yaml | 3 + testsuite/tests/with/pin-transitive/test.py | 6 +- 26 files changed, 715 insertions(+), 104 deletions(-) create mode 100644 testsuite/tests/pin/remote/test.py create mode 100644 testsuite/tests/pin/remote/test.yaml diff --git a/doc/user-changes.md b/doc/user-changes.md index f98e8e5b..1e17892a 100644 --- a/doc/user-changes.md +++ b/doc/user-changes.md @@ -6,6 +6,16 @@ stay on top of `alr` new features. ## Release `1.1` +### Git remotes for pinned releases + +PR [#715](https://github.com/alire-project/alire/pull/715) + +The pinning commands (`alr with --use`, `alr pin --use`) now also accept a git +repository URL, which will be downloaded and used to override a dependency, as +previously could be done only with local directories. The pinning feature works +recursively, so unpublished crates can now have complete dependencies prior to +submission to the community index (which relies only on indexed dependencies). + ### Switch to help with publishing of multi-crate repositories PR [#635](https://github.com/alire-project/alire/pull/635). diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 0d8830c7..64df9638 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -8,8 +8,12 @@ with Alire.Platform; with Alire.Properties; with Alire.Roots; +with GNATCOLL.VFS; + package body Alire.Directories is + package Adirs renames Ada.Directories; + ------------------------ -- Report_Deprecation -- ------------------------ @@ -160,6 +164,47 @@ package body Alire.Directories is return Find_Candidate_Folder (Starting_At); end Detect_Root_Path; + ---------------------- + -- Ensure_Deletable -- + ---------------------- + + procedure Ensure_Deletable (Path : Any_Path) is + use Ada.Directories; + begin + if Exists (Path) and then + Kind (Path) = Directory and then + Platform.On_Windows + then + Trace.Debug ("Forcing writability of dir " & Path); + OS_Lib.Subprocess.Checked_Spawn + ("attrib", + Utils.Empty_Vector + .Append ("-R") -- Remove read-only + .Append ("/D") -- On dirs + .Append ("/S") -- Recursively + .Append (Path & "\*")); + end if; + end Ensure_Deletable; + + ------------------ + -- Force_Delete -- + ------------------ + + procedure Force_Delete (Path : Any_Path) is + use Ada.Directories; + begin + if Exists (Path) then + if Kind (Path) = Ordinary_File then + Trace.Debug ("Deleting file " & Path & "..."); + Delete_File (Path); + elsif Kind (Path) = Directory then + Trace.Debug ("Deleting temporary folder " & Path & "..."); + Ensure_Deletable (Path); + Delete_Tree (Path); + end if; + end if; + end Force_Delete; + ---------------------- -- Find_Files_Under -- ---------------------- @@ -219,6 +264,21 @@ package body Alire.Directories is return Found; end Find_Files_Under; + ------------------------ + -- Find_Relative_Path -- + ------------------------ + + function Find_Relative_Path (Parent : Any_Path; + Child : Any_Path) + return Any_Path + is + use GNATCOLL.VFS; + begin + return +GNATCOLL.VFS.Relative_Path + (File => Create (+Adirs.Full_Name (Child)), + From => Create (+Adirs.Full_Name (Parent))); + end Find_Relative_Path; + ---------------------- -- Find_Single_File -- ---------------------- @@ -354,19 +414,7 @@ package body Alire.Directories is -- Force writability of folder when in Windows, as some tools (e.g. git) -- that create read-only files will cause a Use_Error - if Exists (This.Filename) and then - Kind (This.Filename) = Directory and then - Platform.On_Windows - then - Trace.Debug ("Forcing writability of temporary dir " & This.Filename); - OS_Lib.Subprocess.Checked_Spawn - ("attrib", - Utils.Empty_Vector - .Append ("-R") -- Remove read-only - .Append ("/D") -- On dirs - .Append ("/S") -- Recursively - .Append (This.Filename & "\*")); - end if; + Ensure_Deletable (This.Filename); if Exists (This.Filename) then if Kind (This.Filename) = Ordinary_File then diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index f09f4da8..c398c5c6 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -32,6 +32,13 @@ package Alire.Directories is return String; -- Return either the valid enclosing root folder, or "" + procedure Ensure_Deletable (Path : Any_Path); + -- In Windows, git checkouts are created with read-only file that do not + -- sit well with Ada.Directories.Delete_Tree. + + procedure Force_Delete (Path : Any_Path); + -- Calls Ensure_Deletable and then Adirs.Delete_Tree + function Find_Files_Under (Folder : String; Name : String; Max_Depth : Natural := Natural'Last) @@ -40,6 +47,13 @@ package Alire.Directories is -- Depth 0 means given folder only -- Returns all instances found + function Find_Relative_Path (Parent : Any_Path; + Child : Any_Path) + return Any_Path; + -- Given two paths, find the minimal relative path from Parent up to Child. + -- May still return an absolute path if Child is not in the same drive + -- (Windows) as Parent. + function Find_Single_File (Path : String; Extension : String) return String; diff --git a/src/alire/alire-externals-softlinks.adb b/src/alire/alire-externals-softlinks.adb index 4974303b..3967b1bc 100644 --- a/src/alire/alire-externals-softlinks.adb +++ b/src/alire/alire-externals-softlinks.adb @@ -1,3 +1,5 @@ +with Alire.OS_Lib; +with Alire.TOML_Keys; with Alire.URI; with Alire.Utils.TTY; @@ -13,8 +15,10 @@ package body Alire.Externals.Softlinks is -- TOML Keys used locally Kind : constant String := "kind"; + Origin : constant String := TOML_Keys.Origin; -- Must be the same key Path : constant String := "path"; Relative : constant String := "relative"; + Remote : constant String := "remote"; end Keys; @@ -25,10 +29,35 @@ package body Alire.Externals.Softlinks is function From_TOML (Table : TOML_Adapters.Key_Queue) return External is Path : constant String := Table.Checked_Pop (Keys.Path, TOML_String).As_String; + Remote : constant Boolean := + Table.Checked_Pop (Keys.Remote, TOML_Boolean).As_Boolean; begin - return New_Softlink (Path); + if Remote then + declare + Origin : Origins.Origin; + begin + Origin.From_TOML (Table).Assert; + return New_Remote (Origin => Origin, + Path => URI.Local_Path (Path)); + end; + else + return New_Softlink (Path); + end if; end From_TOML; + ---------------- + -- New_Remote -- + ---------------- + + function New_Remote (Origin : Origins.Origin; + Path : Relative_Path) return External + is (Externals.External with + Has_Remote => True, + Remote => (Used => True, Origin => Origin), + Relative => True, + Path_Length => Path'Length, + Rel_Path => Alire.VFS.To_Portable (Path)); + ------------------ -- New_Softlink -- ------------------ @@ -61,11 +90,15 @@ package body Alire.Externals.Softlinks is begin if Check_Absolute_Path (Path) then return (Externals.External with + Has_Remote => False, + Remote => <>, Relative => False, Path_Length => Path'Length, Abs_Path => Path); else return (Externals.External with + Has_Remote => False, + Remote => <>, Relative => True, Path_Length => Target'Length, Rel_Path => Alire.VFS.To_Portable (+Target)); @@ -74,6 +107,31 @@ package body Alire.Externals.Softlinks is end; end New_Softlink; + -------------- + -- Relocate -- + -------------- + + function Relocate (This : External; + From : Any_Path) return External + is + begin + if Check_Absolute_Path (This.Path) then + return This; + end if; + + declare + use Alire.OS_Lib.Operators; + New_Path : constant Any_Path := From / This.Path; + begin + return (Externals.External with + Has_Remote => This.Has_Remote, + Remote => This.Remote, + Relative => True, + Path_Length => New_Path'Length, + Rel_Path => Alire.VFS.To_Portable (New_Path)); + end; + end Relocate; + ------------- -- To_TOML -- ------------- @@ -84,9 +142,16 @@ package body Alire.Externals.Softlinks is begin Table.Set (Keys.Kind, Create_String (Utils.To_Lower_Case (Softlink'Img))); + Table.Set (Keys.Remote, + Create_Boolean (This.Has_Remote)); Table.Set (Keys.Relative, Create_Boolean (This.Relative)); + if This.Has_Remote then + Table.Set (Keys.Origin, + This.Remote.Origin.To_TOML); + end if; + if This.Relative then Table.Set (Keys.Path, Create_String ("file:" & String (This.Rel_Path))); diff --git a/src/alire/alire-externals-softlinks.ads b/src/alire/alire-externals-softlinks.ads index 4c35bdbb..1ab353b3 100644 --- a/src/alire/alire-externals-softlinks.ads +++ b/src/alire/alire-externals-softlinks.ads @@ -1,6 +1,7 @@ with Ada.Directories; with Alire.Interfaces; +with Alire.Origins.Deployers; with Alire.TOML_Adapters; private with Alire.VFS; @@ -16,7 +17,19 @@ package Alire.Externals.Softlinks is and Interfaces.Tomifiable with private; - function New_Softlink (From : URL) return External; + function New_Softlink (From : Any_Path) return External; + -- Create a softlink for a local dir. From must be absolute or relative to + -- Ada.Directories.Current. + + function New_Remote (Origin : Origins.Origin; + Path : Relative_Path) return External; + -- Create a softlink with an associated Origin source. Path is where it + -- has been/will be deployed. Path must be relative to the root using the + -- softlink. + + function Deploy (This : External) return Outcome; + -- For a Origin pin, redeploy sources if they're not at the expected + -- location. For a local pin, do nothing. overriding function Detect (This : External; @@ -25,9 +38,15 @@ package Alire.Externals.Softlinks is -- Never detected, as we want these crates to work as a wildcard for any -- version. + function Is_Remote (This : External) return Boolean; + -- Say if this is a softlink with a Origin origin + function Is_Valid (This : External) return Boolean; -- Check that the pointed-to folder exists + function Is_Broken (This : External) return Boolean + is (not This.Is_Valid); + overriding function Image (This : External) return String; @@ -46,6 +65,14 @@ package Alire.Externals.Softlinks is function Path (This : External) return Any_Path; + function Relocate (This : External; + From : Any_Path) return External; + -- Return the same external, but adjust its path (when relative) when seen + -- with prefix From. + + function Remote (This : External) return Origins.Origin + with Pre => This.Is_Remote; + function From_TOML (Table : TOML_Adapters.Key_Queue) return External; overriding @@ -53,15 +80,35 @@ package Alire.Externals.Softlinks is private - type External (Relative : Boolean; Path_Length : Positive) is + type Optional_Remote (Used : Boolean) is record + case Used is + when True => Origin : Origins.Origin; + when False => null; + end case; + end record; + + type External (Has_Remote, Relative : Boolean; Path_Length : Positive) is new Externals.External and Interfaces.Tomifiable with record + Remote : Optional_Remote (Has_Remote); case Relative is when True => Rel_Path : Portable_Path (1 .. Path_Length); when False => Abs_Path : Absolute_Path (1 .. Path_Length); end case; end record; + ------------ + -- Deploy -- + ------------ + + function Deploy (This : External) return Outcome + is (if This.Has_Remote + then (if GNAT.OS_Lib.Is_Directory (This.Path) + then Outcome_Success + else Origins.Deployers.New_Deployer (This.Remote.Origin) + .Deploy (This.Path)) + else Outcome_Success); + ----------- -- Image -- ----------- @@ -70,6 +117,13 @@ private function Image (This : External) return String is ("User-provided at " & This.Path); + --------------- + -- Is_Remote -- + --------------- + + function Is_Remote (This : External) return Boolean + is (This.Has_Remote); + -------------- -- Is_Valid -- -------------- @@ -95,4 +149,11 @@ private -- As the path may be relative, we make it absolute to avoid duplicates -- with absolute paths reported by a Release.Project_Paths. + ------------ + -- Origin -- + ------------ + + function Remote (This : External) return Origins.Origin + is (This.Remote.Origin); + end Alire.Externals.Softlinks; diff --git a/src/alire/alire-features-index.adb b/src/alire/alire-features-index.adb index 6d513cb7..980676dc 100644 --- a/src/alire/alire-features-index.adb +++ b/src/alire/alire-features-index.adb @@ -160,7 +160,7 @@ package body Alire.Features.Index is Trace.Debug ("Index was already set, deleting and re-adding..."); Assert (Indexes (I).Delete); return Add (Origin => Alire.Index.Community_Repo & - "@" & Alire.Index.Community_Branch, + "#" & Alire.Index.Community_Branch, Name => Alire.Index.Community_Name, Under => Config.Edit.Indexes_Directory, Before => (if Has_Element (Next (I)) @@ -173,7 +173,7 @@ package body Alire.Features.Index is Trace.Debug ("Index was not set, adding it..."); return Add (Origin => Alire.Index.Community_Repo & - "@" & Alire.Index.Community_Branch, + "#" & Alire.Index.Community_Branch, Name => Alire.Index.Community_Name, Under => Config.Edit.Indexes_Directory); exception diff --git a/src/alire/alire-index_on_disk.ads b/src/alire/alire-index_on_disk.ads index 12e9a8fc..3b9c957c 100644 --- a/src/alire/alire-index_on_disk.ads +++ b/src/alire/alire-index_on_disk.ads @@ -14,7 +14,7 @@ package Alire.Index_On_Disk is -- Actual index is stored in /indexes//repo -- URLs given to New_Handler functions must be complete, commit optional: - -- E.g.: git+https://path/to/server/and/project[@commit] + -- E.g.: git+https://path/to/server/and/project[#commit] -- E.g.: file:///path/to/local/folder Checkout_Directory : constant String := "repo"; diff --git a/src/alire/alire-origins-tweaks.adb b/src/alire/alire-origins-tweaks.adb index d7a61d9d..fa6092b8 100644 --- a/src/alire/alire-origins-tweaks.adb +++ b/src/alire/alire-origins-tweaks.adb @@ -38,7 +38,7 @@ package body Alire.Origins.Tweaks is function Fix_VCS return Origin is use Ada.Directories; - URL : constant String := This.URL; -- Doesn't include @commit + URL : constant String := This.URL; -- Doesn't include #commit begin -- Check for "xxx+file://" or return as-is: if URI.Scheme (URL) not in URI.File_Schemes then diff --git a/src/alire/alire-origins.adb b/src/alire/alire-origins.adb index e0b8fbeb..6b8b3039 100644 --- a/src/alire/alire-origins.adb +++ b/src/alire/alire-origins.adb @@ -1,5 +1,4 @@ with Alire.URI; -with Alire.Utils.TTY; with Alire.VCSs.Git; package body Alire.Origins is diff --git a/src/alire/alire-origins.ads b/src/alire/alire-origins.ads index b3952e41..038d8de6 100644 --- a/src/alire/alire-origins.ads +++ b/src/alire/alire-origins.ads @@ -1,6 +1,7 @@ with Alire.Hashes; with Alire.Interfaces; with Alire.TOML_Adapters; +with Alire.Utils.TTY; private with Ada.Containers.Indefinite_Vectors; private with Ada.Strings.Unbounded; @@ -9,6 +10,8 @@ with TOML; use all type TOML.Any_Value_Kind; package Alire.Origins is + package TTY renames Alire.Utils.TTY; + type Kinds is (External, -- A do-nothing origin, with some custom description Filesystem, -- Not really an origin, but a working copy of a release @@ -50,7 +53,9 @@ package Alire.Origins is with Pre => This.Kind in VCS_Kinds; function URL_With_Commit (This : Origin) return Alire.URL with Pre => This.Kind in VCS_Kinds; - -- Append commit as '@commit' + -- Append commit as '#commit' + function TTY_URL_With_Commit (This : Origin) return String + with Pre => This.Kind in VCS_Kinds; function Path (This : Origin) return String with Pre => This.Kind = Filesystem; @@ -234,7 +239,9 @@ private function Commit (This : Origin) return String is (+This.Data.Commit); function URL_With_Commit (This : Origin) return Alire.URL is - (This.URL & "@" & This.Commit); + (This.URL & "#" & This.Commit); + function TTY_URL_With_Commit (This : Origin) return String is + (TTY.URL (This.URL) & "#" & TTY.Emph (This.Commit)); function Path (This : Origin) return String is (+This.Data.Path); diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 0c9a9d53..f39f4612 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -1,21 +1,27 @@ with Ada.Calendar; with Ada.Directories; -with Alire.Conditional; with Alire.Crate_Configuration; with Alire.Dependencies.Containers; with Alire.Directories; with Alire.Environment; +with Alire.Externals.Softlinks; with Alire.Manifest; +with Alire.Origins.Deployers; with Alire.OS_Lib; with Alire.Roots.Optional; with Alire.Solutions.Diffs; with Alire.Utils.TTY; +with Alire.VCSs.Git; with GNAT.OS_Lib; +with Semantic_Versioning.Extended; + package body Alire.Roots is + package Adirs renames Ada.Directories; + package Semver renames Semantic_Versioning; package TTY renames Utils.TTY; ------------------- @@ -175,6 +181,16 @@ package body Alire.Roots is Round : Natural := 0; begin + -- Begin by retrieving any broken remote, so it is ready for actions + + for Dep of This.Solution.Links loop + if This.Solution.State (Dep.Crate).Link.Is_Remote and then + This.Solution.State (Dep.Crate).Link.Is_Broken + then + This.Solution.State (Dep.Crate).Link.Deploy.Assert; + end if; + end loop; + -- Prepare environment for any post-fetch actions. This must be done -- after the lockfile on disk is written, since the root will read -- dependencies from there. @@ -481,12 +497,22 @@ package body Alire.Roots is function Crate_File (This : Root) return Absolute_Path is (Path (This) / Crate_File_Name); + function Cache_Dir (This : Root) return Absolute_Path + is (This.Working_Folder / "cache"); + ---------------------- -- Dependencies_Dir -- ---------------------- function Dependencies_Dir (This : Root) return Absolute_Path is - (This.Working_Folder / "cache" / "dependencies"); + (This.Cache_Dir / "dependencies"); + + -------------- + -- Pins_Dir -- + -------------- + + function Pins_Dir (This : Root) return Absolute_Path + is (This.Cache_Dir / "pins"); -------------------- -- Working_Folder -- @@ -561,6 +587,10 @@ package body Alire.Roots is elsif (for some Rel of This.Solution.Releases => This.Solution.State (Rel.Name).Is_Solved and then not GNAT.OS_Lib.Is_Directory (This.Release_Base (Rel.Name))) + or else + (for some Dep of This.Solution.Links => + This.Solution.State (Dep.Crate).Link.Is_Remote and then + This.Solution.State (Dep.Crate).Link.Is_Broken) then Trace.Info ("Detected missing dependencies, updating workspace..."); -- Some dependency is missing; redeploy. Should we clean first ??? @@ -697,6 +727,157 @@ package body Alire.Roots is end; end Update_Dependencies; + ---------------------- + -- Pinned_To_Remote -- + ---------------------- + + function Pinned_To_Remote (This : in out Root; + Dependency : Conditional.Dependencies; + URL : String; + Commit : String; + Must_Depend : Boolean) + return Remote_Pin_Result + is + Requested_Crate : constant String := + (if Dependency.Is_Empty + then "" + else Dependency.Value.Crate.As_String); + begin + + -- Check whether are adding or modifying a dependency + + if Must_Depend and then not + (for some Dep of This.Release.Constant_Reference.Flat_Dependencies => + Dep.Crate.As_String = Requested_Crate) + then + Raise_Checked_Error + ("Cannot continue because the requested crate is not a dependency: " + & Requested_Crate); + end if; + + -- Identify the head commit, if not given: + + if Commit = "" then + declare + Head : constant String := + VCSs.Git.Handler.Remote_Head_Commit (URL); + begin + Trace.Info ("No commit provided; using default remote HEAD: " + & TTY.Emph (Head)); + return This.Pinned_To_Remote (Dependency => Dependency, + URL => URL, + Commit => Head, + Must_Depend => Must_Depend); + end; + end if; + + -- Check out the remote + + declare + Temp : Directories.Temp_File; + Depl : constant Origins.Deployers.Deployer'Class := + Origins.Deployers.New_Deployer + (Origins.New_Git (URL, Commit)); + begin + Depl.Deploy (Temp.Filename).Assert; + + -- Identify containing release, and if satisfying move it to its + -- final location in the release cache. + + declare + Linked_Root : constant Alire.Roots.Optional.Root := + Roots.Optional.Detect_Root (Temp.Filename); + Linked_Name : constant String := + (if Linked_Root.Is_Valid + then Linked_Root.Value.Release.Constant_Reference.Name_Str + else Requested_Crate); -- This may still be "" + Linked_Vers : constant String := + (if Linked_Root.Is_Valid + then Linked_Root.Value.Release.Constant_Reference + .Version.Image & "_" + else ""); + Linked_Path : constant Any_Path := + Directories.Find_Relative_Path + (Parent => Ada.Directories.Current_Directory, + Child => + This.Pins_Dir + / (Linked_Name & "_" + & Linked_Vers + & Depl.Base.Short_Unique_Id)); + begin + -- Fail if we needed to detect a crate and none found + + if Linked_Name = "" and Requested_Crate = "" then + Raise_Checked_Error + ("No crate specified and none found at remote."); + end if; + + -- Fail if we detected a crate not matching the requested one + + if Requested_Crate /= "" + and then Linked_Name /= "" + and then Requested_Crate /= Linked_Name + then + Raise_Checked_Error + ("Requested and retrieved crates do not match: " + & Requested_Crate & " /= " & Linked_Name); + end if; + + -- Fail if we are adding a crate that is already a dependency + + if not Must_Depend and then + (for some Dep + of This.Release.Constant_Reference.Flat_Dependencies => + Dep.Crate.As_String = Linked_Name) + then + Raise_Checked_Error + ("Cannot continue because crate is already a dependency: " + & Linked_Name); + end if; + + -- Everything OK, keep the release + + if not GNAT.OS_Lib.Is_Directory + (Adirs.Containing_Directory (Linked_Path)) + then + Adirs.Create_Path (Adirs.Containing_Directory (Linked_Path)); + end if; + + if not GNAT.OS_Lib.Is_Directory (Linked_Path) then + Ada.Directories.Rename (Temp.Filename, Linked_Path); + end if; + + -- Return the solution using the downloaded sources. For that, + -- we create a remote link, and use either the dependency we + -- were given (already in the manifest), or else the one found + -- at the remote. The version will be narrowed down during the + -- post-processing in `alr with`. + + declare + New_Link : constant Externals.Softlinks.External := + Externals.Softlinks.New_Remote + (Origin => Depl.Base, + Path => Linked_Path); + New_Dep : constant Conditional.Dependencies := + (if Dependency.Is_Empty + then Conditional.New_Dependency + (+Linked_Name, Semver.Extended.Any) + else Dependency); + begin + return Remote_Pin_Result' + (Crate_Length => Linked_Name'Length, + Crate => Linked_Name, + New_Dep => New_Dep, + Solution => This.Solution + .Depending_On (New_Dep.Value) + .Linking (+Linked_Name, New_Link)); + end; + end; + + end; + + end Pinned_To_Remote; + ------------------------------------ -- Update_And_Deploy_Dependencies -- ------------------------------------ diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index 6c2e22d8..754caf77 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -1,7 +1,8 @@ private with AAA.Caches.Files; -limited with Alire.Environment; +with Alire.Conditional; with Alire.Containers; +limited with Alire.Environment; private with Alire.Lockfiles; with Alire.Paths; with Alire.Properties; @@ -166,17 +167,43 @@ package Alire.Roots is procedure Write_Manifest (This : Root); -- Generates the crate.toml manifest at the appropriate location for Root + type Remote_Pin_Result (Crate_Length : Natural) is record + Crate : String (1 .. Crate_Length); -- May be empty for a "raw" remote + New_Dep : Conditional.Dependencies; -- Requested one or else found one + Solution : Solutions.Solution; -- Includes new remote pin + end record; + + function Pinned_To_Remote (This : in out Root; + Dependency : Conditional.Dependencies; + URL : String; + Commit : String; + Must_Depend : Boolean) + return Remote_Pin_Result + with Pre => Dependency.Is_Empty or else Dependency.Is_Value; + -- Prepares a pin to a remote repo with specific commit. If + -- Dependency.Crate is not already a dependency, it will be added as + -- top-level, unless Must_Depend, in which case Checked_Error. If Commit + -- is "", the default tip commit in the remote will be used instead. If + -- Dependency.Is_Empty, a valid root must be found at the given commit. + -- If Crate /= "" and Commit contains a root, their crate name must match. + -- Files and folders derived from the root path (this obsoletes Alr.Paths): function Working_Folder (This : Root) return Absolute_Path; -- The "alire" folder inside the root path + function Cache_Dir (This : Root) return Absolute_Path; + -- The "alire/cache" dir inside the root path, containing releases and pins + function Crate_File (This : Root) return Absolute_Path; -- The "/path/to/alire.toml" file inside Working_Folder function Dependencies_Dir (This : Root) return Absolute_Path; -- The folder where dependencies are checked out for this root + function Pins_Dir (This : Root) return Absolute_Path; + -- The folder where remote pins are checked out for this root + function Lock_File (This : Root) return Absolute_Path; -- The "/path/to/alire.lock" file inside Working_Folder diff --git a/src/alire/alire-solutions.adb b/src/alire/alire-solutions.adb index 6441eeaa..46e3d20b 100644 --- a/src/alire/alire-solutions.adb +++ b/src/alire/alire-solutions.adb @@ -6,7 +6,6 @@ with Alire.Dependencies.Containers; with Alire.Dependencies.Diffs; with Alire.Dependencies.Graphs; with Alire.Index; -with Alire.OS_Lib; with Alire.Roots.Optional; with Alire.Root; with Alire.Solutions.Diffs; @@ -298,17 +297,6 @@ package body Alire.Solutions is Link : Externals.Softlinks.External) return Solution is - use Alire.OS_Lib.Operators; - - ---------- - -- Join -- - ---------- - - function Join (Parent, Child : Any_Path) return Any_Path - is (if Check_Absolute_Path (Child) - then Child - else Parent / Child); - Linked_Root : constant Roots.Optional.Root := Roots.Optional.Detect_Root (Link.Path); begin @@ -334,11 +322,9 @@ package body Alire.Solutions is -- relative paths when possible. New_Link : constant Externals.Softlinks.External := - Externals.Softlinks.New_Softlink - (Join - (Parent => Link.Path, - Child => Linked_Solution.State - (Dep.Crate).Link.Path)); + Linked_Solution + .State (Dep.Crate) + .Link.Relocate (From => Link.Path); begin -- We may or not already depend on the transitively @@ -425,19 +411,28 @@ package body Alire.Solutions is Trace.Log ("Dependencies (solution):", Level); for Rel of This.Releases loop - Trace.Log (" " & Rel.Milestone.TTY_Image - & (if This.State (Rel.Name).Is_Pinned or else - This.State (Rel.Name).Is_Linked - then TTY.Emph (" (pinned)") - else "") - & (if Detailed - then " (origin: " - & (if This.State (Rel.Name).Is_Linked - then TTY.URL (This.State (Rel.Name).Link.Path) - else Utils.To_Lower_Case (Rel.Origin.Kind'Img)) - & ")" - else ""), - Level); + declare + Dep : Dependencies.States.State renames This.State (Rel.Name); + begin + Trace.Log + (" " + & Rel.Milestone.TTY_Image + & (if Dep.Is_Pinned or else Dep.Is_Linked + then TTY.Emph (" (pinned)") + else "") + & (if Detailed + then " (origin: " + & (if Dep.Is_Linked + then TTY.URL (Dep.Link.Path) + & (if Dep.Link.Is_Remote + then " from " + & Dep.Link.Remote.TTY_URL_With_Commit + else "") -- no remote + else Utils.To_Lower_Case (Rel.Origin.Kind'Img)) + & ")" -- origin completed + else ""), -- no details + Level); + end; end loop; end if; @@ -568,6 +563,9 @@ package body Alire.Solutions is Table .Append (TTY.Name (Dep.Crate)) .Append (TTY.Version ("file:" & Dep.Link.Path)) + .Append (if Dep.Link.Is_Remote + then Dep.Link.Remote.TTY_URL_With_Commit + else "") .New_Row; elsif Dep.Is_Pinned then Table diff --git a/src/alire/alire-uri.ads b/src/alire/alire-uri.ads index 0a3d0e19..ee0a165e 100644 --- a/src/alire/alire-uri.ads +++ b/src/alire/alire-uri.ads @@ -1,6 +1,6 @@ with Alire.Errors; +with Alire.Utils; -private with Alire.Utils; private with URI; package Alire.URI with Preelaborate is @@ -84,6 +84,12 @@ package Alire.URI with Preelaborate is function Path (This : URL) return String; -- The path as properly defined (without the authority, if any) + function Is_HTTP_Or_Git (This : URL) return Boolean + is (Scheme (This) in Git | Pure_Git | HTTP + or else Alire.Utils.Ends_With (This, ".git")); + -- Heuristic to detect a possible git remote. Implementation public so + -- there is no doubt to what it does. + private package U renames Standard.URI; diff --git a/src/alire/alire-vcss-git.adb b/src/alire/alire-vcss-git.adb index 5605f939..5e00d63d 100644 --- a/src/alire/alire-vcss-git.adb +++ b/src/alire/alire-vcss-git.adb @@ -240,6 +240,36 @@ package body Alire.VCSs.Git is end if; end Remote; + ------------------------ + -- Remote_Head_Commit -- + ------------------------ + + not overriding + function Remote_Head_Commit (This : VCS; + From : URL) return String + is + pragma Unreferenced (This); + Output : constant Utils.String_Vector := + Run_Git_And_Capture (Empty_Vector & "ls-remote" & From); + begin + -- Sample output from git (space is tab): + -- 95818710c1a2bea0cbfa617a67972fe984761227 HEAD + -- b0825ac9373ed587394cf5e7ecf51fd7caf9290a refs/heads/feat/cache + -- 95818710c1a2bea0cbfa617a67972fe984761227 refs/heads/master + -- a917c31c47a8bd0155c402f692b63bd77e53bae7 refs/pull/1/head + -- 22cb794ed99dfe6cbb0541af558ada1d2ed8fdbe refs/tags/v0.1 + -- ae6fdd0711bb3ca2c1e2d1d18caf7a1b82a11f0a refs/tags/v0.1^{} + -- 7376b76f23ab4421fbec31eb616d767edbec7343 refs/tags/v0.2 + + for Line of Output loop + if Tail (Crunch (Line), ASCII.HT) = "HEAD" then + return Head (Line, ASCII.HT); + end if; + end loop; + + return ""; + end Remote_Head_Commit; + ------------ -- Status -- ------------ diff --git a/src/alire/alire-vcss-git.ads b/src/alire/alire-vcss-git.ads index b7021597..ecb95491 100644 --- a/src/alire/alire-vcss-git.ads +++ b/src/alire/alire-vcss-git.ads @@ -29,6 +29,11 @@ package Alire.VCSs.Git is return Outcome; -- Specify a branch to check out after cloning + not overriding + function Remote_Head_Commit (This : VCS; + From : URL) return String; + -- Returns the commit reported as HEAD by ls-remote. If none, returns "" + not overriding function Revision_Commit (This : VCS; Repo : Directory_Path; diff --git a/src/alire/alire-vcss.adb b/src/alire/alire-vcss.adb index f8bd6ce2..4322d582 100644 --- a/src/alire/alire-vcss.adb +++ b/src/alire/alire-vcss.adb @@ -25,8 +25,8 @@ package body Alire.VCSs is ------------ function Commit (Origin : URL) return String is - (if Utils.Contains (Origin, "@") - then Utils.Tail (Origin, '@') + (if Utils.Contains (Origin, "#") + then Utils.Tail (Origin, '#') else ""); ---------- @@ -42,7 +42,7 @@ package body Alire.VCSs is ---------- function Repo (Origin : URL) return String is - (Utils.Head (Repo_And_Commit (Origin), '@')); + (Utils.Head (Repo_And_Commit (Origin), '#')); --------------------- -- Repo_And_Commit -- diff --git a/src/alire/alire-vcss.ads b/src/alire/alire-vcss.ads index f2ca9bd4..1197b052 100644 --- a/src/alire/alire-vcss.ads +++ b/src/alire/alire-vcss.ads @@ -7,7 +7,7 @@ package Alire.VCSs is subtype Known_Kinds is Kinds range Kinds'First .. Kinds'Pred (VCS_Unknown); -- URL format: - -- vcs+http[s]://path/to/repo[@commit] + -- vcs+http[s]://path/to/repo[#commit] function Clone (This : VCS; From : URL; @@ -28,10 +28,10 @@ package Alire.VCSs is -- Without kind and commit function Repo_And_Commit (Origin : URL) return String; - -- Without Kind and with optional Commit + -- Without Kind and with optional Commit (separated by #) function Commit (Origin : URL) return String; - -- Empty string if no commit part + -- Empty string if no commit part (separated by #) ------------------------ -- Classwide versions -- diff --git a/src/alr/alr-commands-clean.adb b/src/alr/alr-commands-clean.adb index d2ba5d0c..00ca98c7 100644 --- a/src/alr/alr-commands-clean.adb +++ b/src/alr/alr-commands-clean.adb @@ -1,8 +1,5 @@ -with Ada.Directories; - with Alire.Utils; -with Alr.Paths; with Alr.Spawn; with Alr.Platform; @@ -38,9 +35,9 @@ package body Alr.Commands.Clean is end if; if Cmd.Cache then - if OS_Lib.Is_Folder (Paths.Alr_Working_Cache_Folder) then + if OS_Lib.Is_Folder (Cmd.Root.Cache_Dir) then Trace.Detail ("Deleting working copy cache..."); - Ada.Directories.Delete_Tree (Paths.Alr_Working_Cache_Folder); + Alire.Directories.Force_Delete (Cmd.Root.Cache_Dir); else Trace.Detail ("Cache folder not present"); -- This is expected if the crate has no dependencies diff --git a/src/alr/alr-commands-pin.adb b/src/alr/alr-commands-pin.adb index e3439414..f48ed517 100644 --- a/src/alr/alr-commands-pin.adb +++ b/src/alr/alr-commands-pin.adb @@ -1,6 +1,9 @@ +with Alire.Conditional; +with Alire.Dependencies; with Alire.Releases; with Alire.Solutions.Diffs; with Alire.Pinning; +with Alire.URI; with Alire.Utils.TTY; with Alire.Utils.User_Input; @@ -175,21 +178,37 @@ package body Alr.Commands.Pin is elsif Cmd.URL.all /= "" then - -- Pin to dir + -- Pin to remote commit + + if Cmd.Commit.all /= "" + or else Alire.URI.Is_HTTP_Or_Git (Cmd.URL.all) + then + New_Sol := Cmd.Root.Pinned_To_Remote + (Dependency => Alire.Conditional.New_Dependency + (Alire.Dependencies.From_String (Argument (1))), + URL => Cmd.URL.all, + Commit => Cmd.Commit.all, + Must_Depend => True) + .Solution; + else + + -- Pin to dir + + if not Alire.Utils.User_Input.Approve_Dir (Cmd.URL.all) then + Trace.Info ("Abandoned by user."); + return; + end if; - if not Alire.Utils.User_Input.Approve_Dir (Cmd.URL.all) then - Trace.Info ("Abandoned by user."); - return; - end if; + Cmd.Requires_Full_Index; -- Next statement recomputes a solution - Cmd.Requires_Full_Index; -- Next statement recomputes a solution + New_Sol := Alire.Pinning.Pin_To + (+Argument (1), + Cmd.URL.all, + Cmd.Root.Release.Dependencies, + Platform.Properties, + Old_Sol); - New_Sol := Alire.Pinning.Pin_To - (+Argument (1), - Cmd.URL.all, - Cmd.Root.Release.Dependencies, - Platform.Properties, - Old_Sol); + end if; -- Report crate detection at target destination @@ -231,8 +250,8 @@ package body Alr.Commands.Pin is .New_Line .Append ("Specify a single crate to modify its pin.") .New_Line - .Append ("Use the --use switch to " - & " force alr to use the PATH target" + .Append ("Use the --use switch to " + & " force alr to use the target" & " to fulfill a dependency locally" & " instead of looking for indexed releases.") ); @@ -258,12 +277,20 @@ package body Alr.Commands.Pin is Long_Switch => "--unpin", Help => "Unpin a release"); + Define_Switch + (Config => Config, + Output => Cmd.Commit'Access, + Long_Switch => "--commit=", + Argument => "HASH", + Help => "Commit to retrieve from repository"); + Define_Switch (Config => Config, Output => Cmd.URL'Access, Long_Switch => "--use=", - Argument => "PATH", - Help => "Use a directory to fulfill a dependency"); + Argument => "PATH|URL", + Help => + "Use a directory or repository to fulfill a dependency"); end Setup_Switches; end Alr.Commands.Pin; diff --git a/src/alr/alr-commands-pin.ads b/src/alr/alr-commands-pin.ads index 07f2c1cc..9d833b2f 100644 --- a/src/alr/alr-commands-pin.ads +++ b/src/alr/alr-commands-pin.ads @@ -23,12 +23,13 @@ package Alr.Commands.Pin is overriding function Usage_Custom_Parameters (Cmd : Command) return String is ("[[crate[=]]" - & " | crate --use=" + & " | crate --use= [--commit=HASH]" & " | --all]"); private type Command is new Commands.Command with record + Commit : aliased GNAT.Strings.String_Access; Pin_All : aliased Boolean; Unpin : aliased Boolean; URL : aliased GNAT.Strings.String_Access; diff --git a/src/alr/alr-commands-withing.adb b/src/alr/alr-commands-withing.adb index 78550c66..e28b2049 100644 --- a/src/alr/alr-commands-withing.adb +++ b/src/alr/alr-commands-withing.adb @@ -13,6 +13,7 @@ with Alire.Releases; with Alire.Roots.Optional; with Alire.Solutions; with Alire.Solver; +with Alire.URI; with Alire.Utils.User_Input; with Alr.Commands.User_Input; @@ -88,6 +89,47 @@ package body Alr.Commands.Withing is Requested.Versions); end Add; + --------------------- + -- Add_Remote_Link -- + --------------------- + + procedure Add_Remote_Link (Cmd : in out Command; + Dep : String) + is + use Alire; + Old_Deps : constant Conditional.Dependencies := + Cmd.Root.Release.Dependencies; + New_Dep : constant Alire.Conditional.Dependencies := + (if Dep = "" + then Alire.Conditional.No_Dependencies + else Alire.Conditional.New_Dependency + (Alire.Dependencies.From_String (Dep))); + New_Solution : constant Roots.Remote_Pin_Result := + Cmd.Root.Pinned_To_Remote + (Dependency => New_Dep, + URL => Cmd.URL.all, + Commit => Cmd.Commit.all, + Must_Depend => False); + use type Conditional.Dependencies; + begin + + -- Report crate detection at target destination + + User_Input.Report_Pinned_Crate_Detection (+New_Solution.Crate, + New_Solution.Solution); + + -- If we made here there were no errors adding the dependency + -- and storing the softlink. We can proceed to confirming the + -- replacement. + + Replace_Current (Cmd, + Old_Deps => Old_Deps, + New_Deps => Old_Deps and New_Solution.New_Dep, + Old_Solution => New_Solution.Solution); + -- We use the New_Solution with the softlink as previous solution, so + -- the pinned directory is used by the solver. + end Add_Remote_Link; + ------------------ -- Add_Softlink -- ------------------ @@ -545,13 +587,29 @@ package body Alr.Commands.Withing is -- Must be Add, but it could be regular or softlink if Cmd.URL.all /= "" then - if Num_Arguments = 1 then - Add_Softlink (Cmd, - Dep_Spec => Argument (1), - Path => Cmd.URL.all); + if Cmd.Commit.all /= "" + or else Alire.URI.Is_HTTP_Or_Git (Cmd.URL.all) + then + + -- Pin to remote repo + + Add_Remote_Link (Cmd, + Dep => (if Num_Arguments = 1 + then Argument (1) + else "")); + else - Detect_Softlink (Cmd, - Cmd.URL.all); + + -- Pin to local folder + + if Num_Arguments = 1 then + Add_Softlink (Cmd, + Dep_Spec => Argument (1), + Path => Cmd.URL.all); + else + Detect_Softlink (Cmd, + Cmd.URL.all); + end if; end if; else Cmd.Requires_Full_Index; @@ -589,9 +647,9 @@ package body Alr.Commands.Withing is & " simultaneously added and removed in a single invocation.") .New_Line .Append ("* Adding dependencies pinned to external sources:") - .Append ("When a single crate name is accompanied by an --use PATH" + .Append ("When a single crate name is accompanied by an --use PATH|URL" & " argument, the crate is always fulfilled for any required" - & " version by the sources found at PATH.") + & " version by the sources found at the given target.") .New_Line .Append ("* Adding dependencies from a GPR file:") .Append ("The project file given with --from will be scanned looking" @@ -639,11 +697,18 @@ package body Alr.Commands.Withing is "", "--graph", "Show ASCII graph of dependencies"); + Define_Switch + (Config => Config, + Output => Cmd.Commit'Access, + Long_Switch => "--commit=", + Argument => "HASH", + Help => "Commit to retrieve from repository"); + Define_Switch (Config => Config, Output => Cmd.URL'Access, Long_Switch => Switch_URL & "=", - Argument => "PATH", + Argument => "PATH|URL", Help => "Add a dependency pinned to some external source"); Define_Switch (Config, diff --git a/src/alr/alr-commands-withing.ads b/src/alr/alr-commands-withing.ads index 19f0d7d6..587733d0 100644 --- a/src/alr/alr-commands-withing.ads +++ b/src/alr/alr-commands-withing.ads @@ -20,18 +20,19 @@ package Alr.Commands.Withing is overriding function Usage_Custom_Parameters (Cmd : Command) return String is ("[{ [--del] [versions]..." & " | --from ..." - & " | [versions] --use } ]" + & " | [versions] --use [--commit HASH} ]" & " | --solve | --tree | --versions"); private type Command is new Commands.Command with record - Del : aliased Boolean := False; - From : aliased Boolean := False; - Graph : aliased Boolean := False; - Solve : aliased Boolean := False; - Tree : aliased Boolean := False; - URL : aliased GNAT.Strings.String_Access; + Commit : aliased GNAT.Strings.String_Access; + Del : aliased Boolean := False; + From : aliased Boolean := False; + Graph : aliased Boolean := False; + Solve : aliased Boolean := False; + Tree : aliased Boolean := False; + URL : aliased GNAT.Strings.String_Access; Versions : aliased Boolean := False; end record; diff --git a/testsuite/tests/pin/remote/test.py b/testsuite/tests/pin/remote/test.py new file mode 100644 index 00000000..d26f6f56 --- /dev/null +++ b/testsuite/tests/pin/remote/test.py @@ -0,0 +1,66 @@ +""" +Check pinning to a remote, cleanup and redeploy +""" + +import os +import shutil + +from drivers.alr import run_alr, init_local_crate +from drivers.helpers import init_git_repo +from drivers.asserts import assert_eq + +s = os.sep + + +def verify(head): + # Check that the linked dir exists at the expected location + pin_path = f"alire{s}cache{s}pins{s}upstream_0.0.0_{head[:8]}" + assert os.path.isdir(pin_path) + + # Verify info reported by alr + p = run_alr("pin") + assert_eq(f"upstream file:{pin_path} ../upstream.git#{head}\n", p.out) + + # Verify building with pinned dependency + run_alr("build") + + # Verify removal of cached download + run_alr("clean", "--cache") + assert not os.path.isdir(pin_path) + + # Verify automatic redownload when needed + run_alr("build") + + # Prepare for next test + run_alr("with", "--del", "upstream") # Remove dependency + shutil.rmtree("alire") # Total cleanup not relying on alr + + +# Initialize a git repo that will act as the "online" remote +init_local_crate(name="upstream", binary=False) +head = init_git_repo(".") +os.chdir("..") +os.rename("upstream", "upstream.git") # so it is recognized as git repo + +# Initialize a client crate that will use the remote +init_local_crate() # This leaves us inside the new crate + +# Add using with directly +run_alr("with", "--use", "../upstream.git", "--commit", head) +verify(head) + +# Add using with, without head commit +run_alr("with", "--use", "../upstream.git") +verify(head) + +# Pin afterwards, with commit +run_alr("with", "upstream", force=True) # force, as it is unsolvable +run_alr("pin", "upstream", "--use", "../upstream.git", "--commit", head) +verify(head) + +# Pin afterwards, without commit +run_alr("with", "upstream", force=True) +run_alr("pin", "upstream", "--use", "../upstream.git") +verify(head) + +print('SUCCESS') diff --git a/testsuite/tests/pin/remote/test.yaml b/testsuite/tests/pin/remote/test.yaml new file mode 100644 index 00000000..872fc127 --- /dev/null +++ b/testsuite/tests/pin/remote/test.yaml @@ -0,0 +1,3 @@ +driver: python-script +indexes: + basic_index: {} diff --git a/testsuite/tests/with/pin-transitive/test.py b/testsuite/tests/with/pin-transitive/test.py index 2037cba0..ba8df745 100644 --- a/testsuite/tests/with/pin-transitive/test.py +++ b/testsuite/tests/with/pin-transitive/test.py @@ -29,8 +29,8 @@ s = os.sep # Verify created pins p = run_alr("pin") -assert_eq("direct file:.." + s + ".." + s + "direct \n" - "indirect file:.." + s + ".." + s + "indirect\n", +assert_eq("direct file:.." + s + ".." + s + "direct \n" + "indirect file:.." + s + ".." + s + "indirect \n", p.out) # Check pin removal @@ -40,7 +40,7 @@ os.chdir("../nest/base") run_alr("update") p = run_alr("pin") -assert_eq("direct file:.." + s + ".." + s + "direct\n", +assert_eq("direct file:.." + s + ".." + s + "direct \n", p.out) -- 2.39.5