New shared builds mechanism (mockup) (alire-project#1419)

* New shared builds mechanism (mockup)

* Self-review

* Fixes for Windows

doc/user-changes.md

@@ -6,6 +6,35 @@ stay on top of `alr` new features.
 
 ## Release `2.0-dev`
 
+### Deprecation of `dependencies.dir` in favor of `dependencies.shared`
+
+PR [#1419](https://github.com/alire-project/alire/pull/1419)
+
+A new system of shared sources and builds is being implemented, which will
+ensure full consistency and reuse of builds.
+
+In the new system (still disabled; enable it by setting `alr config --set
+dependencies.shared true`), dependencies will no longer be stored under
+`<workspace>/alire/cache/dependencies`. Instead, three new directories are
+introduced:
+
+- `$HOME/.cache/alire/releases`: contains sources for read-only purposes and
+  binary releases (except toolchains, see below).
+- `$HOME/.cache/alire/builds`: contains source builds for a unique combination
+  of build profile, GPR externals and environment variables.
+- `$HOME/.cache/alire/toolchains`: contains downloaded toolchains.
+
+The previous `$HOME/.cache/alire/dependencies` that contained both toolchains
+and binary releases is no longer in use.
+
+Users wanting to modify dependencies in tandem within a workspace are
+encouraged to use the pin system.
+
+If these default locations for shared dependencies must be relocated, this can
+be achieved by using a new configuration path (`ALR_CONFIG` or `-c` global
+switch). In that case, the aforementioned paths will be found under
+`/path/to/config/cache`.
+
 ### Request review of an index submission with `alr publish --request-review`
 
 PR [#1409](https://github.com/alire-project/alire/pull/1409)

src/alire/alire-builds.adb

@@ -0,0 +1,135 @@
+with AAA.Strings;
+
+with Alire.Config.Edit;
+with Alire.Directories;
+with Alire.OS_Lib.Subprocess;
+with Alire.Paths.Vault;
+with Alire.Platforms.Current;
+with Alire.Properties.Actions.Executor;
+with Alire.Utils.Tools;
+
+package body Alire.Builds is
+
+   use Directories.Operators; -- "/"
+
+   ----------------------------
+   -- Sandboxed_Dependencies --
+   ----------------------------
+
+   function Sandboxed_Dependencies return Boolean
+   is (not Config.DB.Get (Config.Keys.Dependencies_Shared,
+                          Config.Defaults.Dependencies_Shared));
+
+   -------------------
+   -- To_Msys2_Path --
+   -------------------
+   --  Convert C:\blah\blah into /c/blah/blah. This is needed because otherwise
+   --  rsync confuses drive letters with remote hostnames. This might be useful
+   --  in our troubles with tar?
+   function To_Msys2_Path (Path : Absolute_Path) return String
+   is
+   begin
+      if not Platforms.Current.On_Windows then
+         return Path;
+      end if;
+
+      declare
+         use AAA.Strings;
+         New_Path : String (1 .. Path'Length) := Path;
+      begin
+         --  Replace ':' with '/'
+         New_Path (2) := '/';
+
+         --  Replace '\' with '/'
+         return "/" & Replace (New_Path, "\", "/");
+      end;
+   end To_Msys2_Path;
+
+   ----------
+   -- Sync --
+   ----------
+
+   procedure Sync (Release   : Releases.Release;
+                   Was_There : out Boolean)
+   is
+      Src       : constant Absolute_Path := Paths.Vault.Path
+                                            / Release.Deployment_Folder;
+      Dst       : constant Absolute_Path := Builds.Path (Release);
+      Completed : Directories.Completion := Directories.New_Completion (Dst);
+
+      use AAA.Strings;
+   begin
+      Was_There := False;
+
+      if Completed.Is_Complete then
+         Trace.Detail ("Skipping build syncing to existing " & Dst);
+         Was_There := True;
+         return;
+      end if;
+
+      Directories.Create_Tree (Dst);
+      --  Ensure the sync destination dir exists
+
+      Utils.Tools.Check_Tool (Utils.Tools.Rsync);
+
+      declare
+         Busy : constant Simple_Logging.Ongoing :=
+                  Simple_Logging.Activity
+                    ("Syncing " & Release.Milestone.TTY_Image)
+                    with Unreferenced;
+      begin
+         OS_Lib.Subprocess.Checked_Spawn
+           (Command   => "rsync",
+            Arguments =>
+              To_Vector ("--del")
+            & "-aChH"
+            --  Archive, no CVS folders, keep hard links, human units
+            & (if Log_Level > Detail then To_Vector ("-P") else Empty_Vector)
+            & (if Log_Level < Info   then To_Vector ("-q") else Empty_Vector)
+            --  Trailing '/' to access contents directly in the following paths
+            & To_Msys2_Path (Src / "")
+            & To_Msys2_Path (Dst / "")
+           );
+         --  TODO: this may take some time, and rsync doesn't have a way
+         --  to show oneliner progress, so at some point we may want to use
+         --  something like GNAT.Expect for our spawns, and spin on newlines
+         --  for example.
+      end;
+
+      declare
+         use Directories;
+         Work_Dir : Guard (Enter (Dst)) with Unreferenced;
+      begin
+         Alire.Properties.Actions.Executor.Execute_Actions
+           (Release => Release,
+            Env     => Platforms.Current.Properties,
+            Moment  => Properties.Actions.Post_Fetch);
+      exception
+         when E : others =>
+            Log_Exception (E);
+            Trace.Warning ("A post-fetch action failed, " &
+                             "re-run with -vv -d for details");
+      end;
+
+      Completed.Mark (Complete => True);
+   end Sync;
+
+   ----------
+   -- Path --
+   ----------
+
+   function Path return Absolute_Path
+   is (Config.Edit.Cache_Path
+       / Paths.Build_Folder_Inside_Working_Folder);
+
+   ----------
+   -- Path --
+   ----------
+
+   function Path (Release : Releases.Release) return Absolute_Path
+   is (Builds.Path
+       / (Release.Deployment_Folder
+         & "_deadbeef"));
+   --  TODO: implement actual hashing of environment for a release
+
+end Alire.Builds;

src/alire/alire-builds.ads

@@ -0,0 +1,42 @@
+with Alire.Releases;
+
+package Alire.Builds is
+
+   --  Stuff for shared builds: build hashes, syncing from the vault, etc.
+
+   --  The new "shared builds" mechanism aims to provide safe sharing of
+   --  builds, which should result in decreased recompilations (as most
+   --  configs should be compiled only once, unless some actions are touching
+   --  something) and decreased disk use (as multiple workspaces will reuse the
+   --  same builds).
+
+   --  This relies on having a separate source folder for each build
+   --  configuration (a 'build folder'). This build folder is uniquely
+   --  identified by a hash derived from the configuration variables,
+   --  environment variables, GPR externals, and build profile that affect a
+   --  release, according to manifests in scope.
+
+   --  The build folder is created on-demand, under the name of
+   --  <crate_version_commithash_buildhash>, syncing it from a "read-only"
+   --  location, the 'vault', where all releases are fetched initially.
+
+   --  To be able to quickly identify available toolchains without maintaining
+   --  a "state" file, these are now separately stored, whereas in the past
+   --  they were stored together with all binary releases. Since now we'll have
+   --  many more shared releases in the vault, finding toolchains could take
+   --  much more time, hence the separate storage.
+
+   function Sandboxed_Dependencies return Boolean;
+   --  Queries config to see if dependencies should be sandboxed in workspace
+
+   procedure Sync (Release   : Releases.Release;
+                   Was_There : out Boolean)
+     with Pre => Release.Origin.Requires_Build;
+
+   function Path return Absolute_Path;
+   --  Location of shared builds
+
+   function Path (Release : Releases.Release) return Absolute_Path;
+   --  Computes the complete path in which the release is going to be built
+
+end Alire.Builds;

src/alire/alire-config-edit.adb

@@ -1,6 +1,7 @@
 with Ada.Text_IO;
 
 with Alire.Environment;
+with Alire.Paths;
 with Alire.Platforms.Folders;
 with Alire.Platforms.Current;
 with Alire.Utils;
@@ -181,6 +182,8 @@ package body Alire.Config.Edit is
 
    end Load_Config;
 
+   Default_Config_Path : constant Absolute_Path := Platforms.Folders.Config;
+
    ----------
    -- Path --
    ----------
@@ -191,10 +194,19 @@ package body Alire.Config.Edit is
          return Config_Path.all;
       else
          return OS_Lib.Getenv (Environment.Config,
-                               Platforms.Folders.Config);
+                               Default_Config_Path);
       end if;
    end Path;
 
+   ----------------
+   -- Cache_Path --
+   ----------------
+
+   function Cache_Path return Absolute_Path
+   is (if Path = Default_Config_Path
+       then Platforms.Folders.Cache
+       else Path / Paths.Cache_Folder_Inside_Working_Folder);
+
    --------------
    -- Set_Path --
    --------------

src/alire/alire-config-edit.ads

@@ -1,7 +1,6 @@
 with AAA.Strings;
 
 with Alire.Directories;
-with Alire.Paths;
 
 with CLIC.Config;
 
@@ -47,6 +46,12 @@ package Alire.Config.Edit is
    --  * An ALR_CONFIG env given folder
    --  * Default per-platform path (see alire-platforms-*)
 
+   function Cache_Path return Absolute_Path;
+   --  The location for data that will be recreated if missing; defaults to
+   --  Platforms.Folders.Cache; if Path above is overridden, the cache will
+   --  be inside the config folder so as to keep that configuration completely
+   --  isolated.
+
    procedure Set_Path (Path : Absolute_Path);
    --  Override global config folder path
 
@@ -103,17 +108,11 @@ private
 
    Builtins : constant array (Natural range <>) of Builtin_Entry :=
      (
-      (+Keys.Dependencies_Dir,
-       Cfg_Existing_Absolute_Path,
-      +("Overrides the default storage directory of regular (non-binary) "
-        & " dependencies. When unset, releases are stored inside each "
-        & "workspace at '" & TTY.URL
-          (Paths.Working_Folder_Inside_Root
-           / Paths.Cache_Folder_Inside_Working_Folder
-           / Paths.Deps_Folder_Inside_Cache_Folder) & "'. "
-        & "Sharing dependencies across workspaces may save disk space, but "
-        & "it is generally not recommended as different dependents may need "
-        & "to configure dependencies differently. Use at your own risk."
+        (+Keys.Dependencies_Shared,
+      Cfg_Bool,
+      +("When true, dependencies are downloaded and built in a shared "
+        & "location inside the global cache. When false (default), "
+        & "dependencies are sandboxed in each workspace."
        )),
 
       (+Keys.Index_Auto_Community,

src/alire/alire-config.ads

@@ -23,7 +23,7 @@ package Alire.Config with Preelaborate is
       --  A few predefined keys that are used in several places. This list is
       --  not exhaustive.
 
-      Dependencies_Dir : constant Config_Key := "dependencies.dir";
+      Dependencies_Shared : constant Config_Key := "dependencies.shared";
 
       Editor_Cmd  : constant Config_Key := "editor.cmd";
 
@@ -88,12 +88,15 @@ package Alire.Config with Preelaborate is
 
    package Defaults is
 
-      Warning_Old_Index : constant Boolean := True;
+      Dependencies_Shared : constant Boolean := False;
+      --  TODO: enable it when hashing is complete
 
       Index_Host        : constant String := "https://github.com";
       Index_Owner       : constant String := "alire-project";
       Index_Repo_Name   : constant String := "alire-index";
 
+      Warning_Old_Index : constant Boolean := True;
+
    end Defaults;
 
 end Alire.Config;

src/alire/alire-crate_configuration.adb

@@ -551,9 +551,7 @@ package body Alire.Crate_Configuration is
    is
       use type Profile_Maps.Map;
    begin
-      return
-         Config.DB.Get (Config.Keys.Dependencies_Dir, "") /= "" or else
-         This.Profile_Map /= Last_Build_Profiles;
+      return This.Profile_Map /= Last_Build_Profiles;
    end Must_Regenerate;
 
    ---------------------------

src/alire/alire-directories.adb

@@ -1065,4 +1065,38 @@ package body Alire.Directories is
       end if;
    end Touch;
 
+   ----------
+   -- File --
+   ----------
+
+   function File (This : Completion) return Absolute_File
+   is (This.Path
+       / Paths.Working_Folder_Inside_Root
+       / Paths.Complete_Flag);
+
+   -----------------
+   -- Is_Complete --
+   -----------------
+
+   function Is_Complete (This : Completion) return Boolean
+   is (Is_File (This.File));
+
+   ----------
+   -- Mark --
+   ----------
+
+   procedure Mark (This     : in out Completion;
+                   Complete : Boolean)
+   is
+   begin
+      if Complete then
+         Create_Tree (Parent (This.File));
+         Touch (This.File);
+      else
+         if This.Is_Complete then
+            Delete_Tree (This.File);
+         end if;
+      end if;
+   end Mark;
+
 end Alire.Directories;