From 412f297e010903891e595b7760c806742d333883 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 21 Mar 2023 12:26:03 +0100 Subject: [PATCH] Actually use the cache location for shared releases (#1349) * Use the cache location for shared releases * Self-review * User changes summary * Cache migration to avoid redownloads * Removed cache migration --- .vscode/settings.json | 10 +++- .vscode/tasks.json | 9 ++-- doc/user-changes.md | 17 +++++- src/alire/alire-config-edit.adb | 7 +++ src/alire/alire-config-edit.ads | 3 ++ src/alire/alire-directories.adb | 45 +++++++++------- src/alire/alire-directories.ads | 10 ++-- src/alire/alire-environment.ads | 4 -- src/alire/alire-install.adb | 3 +- src/alire/alire-platforms-folders.ads | 4 +- src/alire/alire-roots.adb | 2 +- src/alire/alire-shared.adb | 53 ++++++++++++++----- src/alire/alire-shared.ads | 12 +++-- src/alire/alire-toolchains-solutions.adb | 31 +++++++++++ .../alire-platforms-folders__freebsd.adb | 4 +- .../alire-platforms-folders__linux.adb | 4 +- .../alire-platforms-folders__macos.adb | 4 +- .../alire-platforms-folders__windows.adb | 4 +- src/alr/alr-commands-version.adb | 2 + src/alr/alr-commands.adb | 23 ++++---- 20 files changed, 175 insertions(+), 76 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index 4ce017bc..bf6ebb9b 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -1,3 +1,11 @@ { - "ada.projectFile": "alr_env.gpr" + "ada.projectFile": "alr_env.gpr", + "cSpell.words": [ + "alire", + "rlimit" + ], + "ada.defaultCharset": "utf-8", + "ada.scenarioVariables": { + ALIRE_OS="linux", + } } diff --git a/.vscode/tasks.json b/.vscode/tasks.json index ca6cb8f5..99a04eed 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -8,10 +8,7 @@ "$ada" ], "label": "Alire: Build alr", - "group": { - "kind": "build", - "isDefault": true - } + "group": "build" }, { "type": "shell", @@ -19,7 +16,7 @@ "problemMatcher": [ "$ada" ], - "label": "Alire: Compile current file", + "label": "Alire: Compile current file" }, { "type": "shell", @@ -27,7 +24,7 @@ "problemMatcher": [ "$ada" ], - "label": "Alire: Clean all projects", + "label": "Alire: Clean all projects" }, { "type": "shell", diff --git a/doc/user-changes.md b/doc/user-changes.md index dcc1e18a..97143e39 100644 --- a/doc/user-changes.md +++ b/doc/user-changes.md @@ -4,7 +4,20 @@ This document is a development diary summarizing changes in `alr` that notably affect the user experience. It is intended as a one-stop point for users to stay on top of `alr` new features. -## Release 1.3-dev +## Release `1.3-dev` + +### Binary releases moved to system cache from system config directory + +PR [#1349](https://github.com/alire-project/alire/pull/1349) + +Alire was storing large binary releases like compilers in the config location, +which is against best practices. + +Users are advised to delete the old location to recover disk space, or to +manually move the contents to avoid redownloading toolchains. + +- Old location: `/.config/alire/cache` +- New location: `/.cache/alire` ### Installation of indexed crates @@ -168,7 +181,7 @@ PR [#1080](https://github.com/alire-project/alire/pull/1080) this PR this was always a development build. Now, the last profile used during an `alr build` will be reused. -## Release 1.2 +## Release `1.2` ### New subcommand for listing and manual triggering of actions diff --git a/src/alire/alire-config-edit.adb b/src/alire/alire-config-edit.adb index c241085f..fa3e8f2e 100644 --- a/src/alire/alire-config-edit.adb +++ b/src/alire/alire-config-edit.adb @@ -171,6 +171,13 @@ package body Alire.Config.Edit is end if; end Set_Path; + ----------------------- + -- Is_At_Default_Dir -- + ----------------------- + + function Is_At_Default_Dir return Boolean + is (Path = Platforms.Folders.Config); + ------------------- -- Valid_Builtin -- ------------------- diff --git a/src/alire/alire-config-edit.ads b/src/alire/alire-config-edit.ads index f562a408..0547a8d6 100644 --- a/src/alire/alire-config-edit.ads +++ b/src/alire/alire-config-edit.ads @@ -36,6 +36,9 @@ package Alire.Config.Edit is procedure Set_Path (Path : Absolute_Path); -- Override global config folder path + function Is_At_Default_Dir return Boolean; + -- Says if we are using the default config location (no -c or env override) + function Indexes_Directory return Absolute_Path is (Path / "indexes"); function Filepath (Lvl : Level) return Absolute_Path diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 7b05464f..70106893 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -168,16 +168,6 @@ package body Alire.Directories is end if; end Delete_Temporaries; - ----------------- - -- Delete_Tree -- - ----------------- - - procedure Delete_Tree (Path : Any_Path) is - begin - Ensure_Deletable (Path); - Ada.Directories.Delete_Tree (Path); - end Delete_Tree; - ---------------------- -- Detect_Root_Path -- ---------------------- @@ -568,7 +558,8 @@ package body Alire.Directories is procedure Merge_Contents (Src, Dst : Any_Path; Skip_Top_Level_Files : Boolean; - Fail_On_Existing_File : Boolean) + Fail_On_Existing_File : Boolean; + Remove_From_Source : Boolean) is Base : constant Absolute_Path := Adirs.Full_Name (Src); @@ -602,7 +593,9 @@ package body Alire.Directories is and then Base = Parent (Src) then Trace.Debug (" Merge: Not merging top-level file " & Src); - Adirs.Delete_File (Src); + if Remove_From_Source then + Adirs.Delete_File (Src); + end if; return; end if; @@ -611,7 +604,7 @@ package body Alire.Directories is if Adirs.Kind (Item) = Directory then if not Is_Directory (Dst) then Trace.Debug (" Merge: Creating destination dir " & Dst); - Adirs.Create_Directory (Dst); + Create_Tree (Dst); end if; return; @@ -619,10 +612,12 @@ package body Alire.Directories is -- recursion we could more efficiently rename now into place. end if; - -- Move a file into place + -- Copy/Move a file into place - Trace.Debug (" Merge: Moving " & Adirs.Full_Name (Item) - & " into " & Dst); + Trace.Debug (" Merge: " + & (if Remove_From_Source then " moving " else " copying ") + & Adirs.Full_Name (Item) + & " into " & Dst); if Adirs.Exists (Dst) then if Fail_On_Existing_File then Recoverable_Error ("Cannot move " & TTY.URL (Src) @@ -650,14 +645,24 @@ package body Alire.Directories is OK : Boolean := False; begin if VF.Is_Symbolic_Link then - VF.Rename (VFS.New_Virtual_File (Dst), OK); + if Remove_From_Source then + VF.Rename (VFS.New_Virtual_File (Dst), OK); + else + VF.Copy (VFS.Filesystem_String (Dst), OK); + end if; if not OK then - Raise_Checked_Error ("Failed to move softlink: " + Raise_Checked_Error ("Failed to copy/move softlink: " & TTY.URL (Src)); end if; else - Adirs.Rename (Old_Name => Src, - New_Name => Dst); + if Remove_From_Source then + Adirs.Rename (Old_Name => Src, + New_Name => Dst); + else + Adirs.Copy_File (Source_Name => Src, + Target_Name => Dst, + Form => "preserve=all_attributes"); + end if; end if; end; end Merge; diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index 30ea6d03..24d7b031 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -39,15 +39,14 @@ package Alire.Directories is procedure Create_Tree (Path : Any_Path); -- Create Path and all necessary intermediate folders - procedure Delete_Tree (Path : Any_Path); - -- Equivalent to Ensure_Deletable + Ada.Directories.Delete_Tree - 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 + -- Calls Ensure_Deletable and then uses GNATCOLL.VFS deletion + + procedure Delete_Tree (Path : Any_Path) renames Force_Delete; function Find_Files_Under (Folder : String; Name : String; @@ -78,7 +77,8 @@ package Alire.Directories is procedure Merge_Contents (Src, Dst : Any_Path; Skip_Top_Level_Files : Boolean; - Fail_On_Existing_File : Boolean); + Fail_On_Existing_File : Boolean; + Remove_From_Source : Boolean); -- Move all contents from Src into Dst, recursively. Dirs already existing -- on Dst tree will be merged. For existing regular files, either log -- at debug level or fail. If Skip, discard files at the Src top-level. diff --git a/src/alire/alire-environment.ads b/src/alire/alire-environment.ads index 5b9db5a2..6114cebe 100644 --- a/src/alire/alire-environment.ads +++ b/src/alire/alire-environment.ads @@ -15,10 +15,6 @@ package Alire.Environment is Config : constant String := "ALR_CONFIG"; -- Folder where current alr will look for configuration - Source : constant String := "ALR_SOURCE"; - -- Folder that overrides where alr sources are checked out - -- Intended to help developers by pointing it to their sources - type Context is tagged limited private; procedure Set (This : in out Context; Name, Value, Origin : String); diff --git a/src/alire/alire-install.adb b/src/alire/alire-install.adb index 7e5232a1..6bc1bc37 100644 --- a/src/alire/alire-install.adb +++ b/src/alire/alire-install.adb @@ -71,7 +71,8 @@ package body Alire.Install is (Src => Prefix / Rel.Base_Folder, Dst => Prefix, Skip_Top_Level_Files => True, - Fail_On_Existing_File => not Alire.Force); + Fail_On_Existing_File => not Alire.Force, + Remove_From_Source => True); -- Keep track that this was installed diff --git a/src/alire/alire-platforms-folders.ads b/src/alire/alire-platforms-folders.ads index 690f425c..e2613af3 100644 --- a/src/alire/alire-platforms-folders.ads +++ b/src/alire/alire-platforms-folders.ads @@ -2,14 +2,14 @@ package Alire.Platforms.Folders is -- This spec must be fulfilled by bodies for each different OS we support - function Config return String; + function Config return Absolute_Path; -- Folder where alire will store its global configuration, indexes, and -- any other global data. Deleting it is akin to running alr afresh for -- the first time. -- On Linux/macOS it is ${XDG_CONFIG_HOME:-$HOME/.config}/alire -- On Windows it is $UserProfile\.config\alire - function Cache return String; + function Cache return Absolute_Path; -- Folder for dependencies, global toolchains, and any other info that is -- not critical to lose. Can be deleted freely, it's repopulated on-demand. -- On Linux/macOS it is ${XDG_CACHE_HOME:-$HOME/.cache}/alire diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 2730dd2d..28f8bbc4 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -1263,7 +1263,7 @@ package body Alire.Roots is begin if This.Solution.State (Crate).Is_Solved then if This.Solution.State (Crate).Is_Shared then - return Shared.Install_Path; + return Shared.Path; else return This.Cache_Dir / Paths.Deps_Folder_Inside_Cache_Folder; diff --git a/src/alire/alire-shared.adb b/src/alire/alire-shared.adb index 1dc179a7..932d3f6e 100644 --- a/src/alire/alire-shared.adb +++ b/src/alire/alire-shared.adb @@ -1,12 +1,15 @@ with Ada.Directories; -with Alire.Config.Edit; +with Alire.Config; with Alire.Containers; with Alire.Directories; +with Alire.Environment; with Alire.Index; with Alire.Manifest; with Alire.Origins; +with Alire.OS_Lib; with Alire.Paths; +with Alire.Platforms.Folders; with Alire.Properties.Actions; with Alire.Root; with Alire.Toolchains.Solutions; @@ -59,9 +62,9 @@ package body Alire.Shared is end Detect; begin - if Ada.Directories.Exists (Install_Path) then + if Ada.Directories.Exists (Path) then Directories.Traverse_Tree - (Start => Install_Path, + (Start => Path, Doing => Detect'Access); end if; @@ -84,21 +87,43 @@ package body Alire.Shared is return Result; end Available; - ------------------ - -- Install_Path -- - ------------------ - - function Install_Path return String - is (Config.Edit.Path - / Paths.Cache_Folder_Inside_Working_Folder - / Paths.Deps_Folder_Inside_Cache_Folder); + Global_Cache_Path : access String; + + ---------- + -- Path -- + ---------- + + function Path return String + is ((if Global_Cache_Path /= null + then Global_Cache_Path.all + else OS_Lib.Getenv (Environment.Config, + Platforms.Folders.Cache)) + -- Up to here, it's the default prefix or an overriden prefix + / + (if Global_Cache_Path = null and then + OS_Lib.Getenv (Environment.Config, "") = "" + then Paths.Deps_Folder_Inside_Cache_Folder + else Paths.Cache_Folder_Inside_Working_Folder + / Paths.Deps_Folder_Inside_Cache_Folder) + -- This second part is either cache/dependencies or just dependencies, + -- depending on if the location is shared with the config folder or not + ); + + -------------- + -- Set_Path -- + -------------- + + procedure Set_Path (Path : Absolute_Path) is + begin + Global_Cache_Path := new String'(Path); + end Set_Path; ----------- -- Share -- ----------- procedure Share (Release : Releases.Release; - Location : Any_Path := Install_Path) + Location : Any_Path := Path) is Already_Installed : Boolean := False; @@ -157,7 +182,7 @@ package body Alire.Shared is end if; -- See if it can be skipped - if Location = Install_Path and then Available.Contains (Release) then + if Location = Path and then Available.Contains (Release) then Trace.Detail ("Skipping installation of already available release: " & Release.Milestone.TTY_Image); return; @@ -193,7 +218,7 @@ package body Alire.Shared is is use CLIC.User_Input; Path : constant Absolute_Path := - Install_Path / Release.Deployment_Folder; + Shared.Path / Release.Deployment_Folder; begin if not Release.Origin.Is_Regular then Raise_Checked_Error diff --git a/src/alire/alire-shared.ads b/src/alire/alire-shared.ads index 2d1c0757..bcb5fdbb 100644 --- a/src/alire/alire-shared.ads +++ b/src/alire/alire-shared.ads @@ -19,11 +19,17 @@ package Alire.Shared is -- Retrieve the release corresponding to Target, if it exists. Will raise -- Constraint_Error if not among Available. - function Install_Path return Any_Path; - -- Returns the base folder in which all shared releases live + function Path return Any_Path; + -- Returns the base folder in which all shared releases live: + -- * /cache/dependencies if set with --config/-c + -- * /cache/dependencies if set through ALR_CONFIG + -- * ~/.cache/alire/dependencies by default + + procedure Set_Path (Path : Absolute_Path); + -- Override the location of the global cache location procedure Share (Release : Releases.Release; - Location : Any_Path := Install_Path); + Location : Any_Path := Path); -- Deploy a release in the specified location procedure Remove diff --git a/src/alire/alire-toolchains-solutions.adb b/src/alire/alire-toolchains-solutions.adb index 5640ebd5..2d2e79ef 100644 --- a/src/alire/alire-toolchains-solutions.adb +++ b/src/alire/alire-toolchains-solutions.adb @@ -1,3 +1,6 @@ +with AAA.Strings; + +with Alire.Index; with Alire.Root; with Alire.Shared; @@ -10,8 +13,28 @@ package body Alire.Toolchains.Solutions is function Add_Toolchain (Solution : Alire.Solutions.Solution) return Alire.Solutions.Solution is + + ------------------------ + -- Redeploy_If_Needed -- + ------------------------ + + procedure Redeploy_If_Needed (Mil : Milestones.Milestone) is + use type Milestones.Milestone; + begin + -- Check that is not already there + if (for some Rel of Shared.Available => Rel.Milestone = Mil) then + return; + end if; + + -- It must be redeployed + Put_Warning ("Tool " & Mil.TTY_Image & " is missing, redeploying..."); + + Shared.Share (Index.Find (Mil.Crate, Mil.Version)); + end Redeploy_If_Needed; + Result : Alire.Solutions.Solution := Solution; begin + -- For every tool in the toolchain that does not appear in the solution, -- we will insert the user-configured tool, if any. @@ -21,6 +44,14 @@ package body Alire.Toolchains.Solutions is ("Toolchain environment: solution already depends on " & Solution.State (Tool).TTY_Image); elsif Toolchains.Tool_Is_Configured (Tool) then + + -- This shouldn't happen normally, but it can happen if the user + -- has just changed the cache location. + if not Tool_Is_External (Tool) then + Redeploy_If_Needed (Tool_Milestone (Tool)); + end if; + + -- Add the configured tool release to the solution Result := Result.Including (Release => Shared.Release (Target => Tool_Milestone (Tool), diff --git a/src/alire/os_freebsd/alire-platforms-folders__freebsd.adb b/src/alire/os_freebsd/alire-platforms-folders__freebsd.adb index 0f9147c4..41020bd6 100644 --- a/src/alire/os_freebsd/alire-platforms-folders__freebsd.adb +++ b/src/alire/os_freebsd/alire-platforms-folders__freebsd.adb @@ -8,13 +8,13 @@ package body Alire.Platforms.Folders is -- Cache -- ----------- - function Cache return String is (Common.XDG_Cache_Folder); + function Cache return Absolute_Path is (Common.XDG_Cache_Folder); ----------- -- Config-- ----------- - function Config return String is (Common.XDG_Config_Folder); + function Config return Absolute_Path is (Common.XDG_Config_Folder); ---------- -- Home -- diff --git a/src/alire/os_linux/alire-platforms-folders__linux.adb b/src/alire/os_linux/alire-platforms-folders__linux.adb index 0f9147c4..41020bd6 100644 --- a/src/alire/os_linux/alire-platforms-folders__linux.adb +++ b/src/alire/os_linux/alire-platforms-folders__linux.adb @@ -8,13 +8,13 @@ package body Alire.Platforms.Folders is -- Cache -- ----------- - function Cache return String is (Common.XDG_Cache_Folder); + function Cache return Absolute_Path is (Common.XDG_Cache_Folder); ----------- -- Config-- ----------- - function Config return String is (Common.XDG_Config_Folder); + function Config return Absolute_Path is (Common.XDG_Config_Folder); ---------- -- Home -- diff --git a/src/alire/os_macos/alire-platforms-folders__macos.adb b/src/alire/os_macos/alire-platforms-folders__macos.adb index ecd30f6b..3fbc8b10 100644 --- a/src/alire/os_macos/alire-platforms-folders__macos.adb +++ b/src/alire/os_macos/alire-platforms-folders__macos.adb @@ -8,13 +8,13 @@ package body Alire.Platforms.Folders is -- Cache -- ----------- - function Cache return String is (Common.XDG_Cache_Folder); + function Cache return Absolute_Path is (Common.XDG_Cache_Folder); ----------- -- Config-- ----------- - function Config return String is (Common.XDG_Config_Folder); + function Config return Absolute_Path is (Common.XDG_Config_Folder); ---------- -- Home -- diff --git a/src/alire/os_windows/alire-platforms-folders__windows.adb b/src/alire/os_windows/alire-platforms-folders__windows.adb index 24a733c8..7a70bd39 100644 --- a/src/alire/os_windows/alire-platforms-folders__windows.adb +++ b/src/alire/os_windows/alire-platforms-folders__windows.adb @@ -15,12 +15,12 @@ package body Alire.Platforms.Folders is -- Cache -- ----------- - function Cache return String is (Home / ".cache" / "alire"); + function Cache return Absolute_Path is (Home / ".cache" / "alire"); ------------ -- Config -- ------------ - function Config return String is (Home / ".config" / "alire"); + function Config return Absolute_Path is (Home / ".config" / "alire"); end Alire.Platforms.Folders; diff --git a/src/alr/alr-commands-version.adb b/src/alr/alr-commands-version.adb index 50e10e69..68e7e899 100644 --- a/src/alr/alr-commands-version.adb +++ b/src/alr/alr-commands-version.adb @@ -4,6 +4,7 @@ with Alire.Index_On_Disk.Loading; with Alire.Milestones; with Alire.Properties; with Alire.Roots.Optional; +with Alire.Shared; with Alire.Toolchains; with Alire.Utils.Tables; @@ -51,6 +52,7 @@ package body Alr.Commands.Version is Table.Append ("").New_Row; Table.Append ("CONFIGURATION").New_Row; Table.Append ("config folder:").Append (Alire.Config.Edit.Path).New_Row; + Table.Append ("cache folder:").Append (Alire.Shared.Path).New_Row; Table.Append ("force flag:").Append (Alire.Force'Image).New_Row; Table.Append ("non-interactive flag:") .Append (CLIC.User_Input.Not_Interactive'Image).New_Row; diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index 72ba10e7..41e0abaf 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -16,6 +16,7 @@ with Alire.Lockfiles; with Alire.Paths; with Alire.Platforms.Current; with Alire.Root; +with Alire.Shared; with Alire.Solutions; with Alire.Toolchains; @@ -471,18 +472,22 @@ package body Alr.Commands is -- Also use a fancier busy spinner end if; + -- Set overriden config path. For now, we tie the config and cache paths + -- to a single location when overridden, as this was the old behavior + -- before we started using ~/.cache for dependencies, so people using + -- custom config locations will expect shared dependencies to be at the + -- new config location, as always. + if Command_Line_Config_Path /= null and then Command_Line_Config_Path.all /= "" then - if not Alire.Check_Absolute_Path (Command_Line_Config_Path.all) then - -- Make an absolute path from user relative path - Alire.Config.Edit.Set_Path - (Ada.Directories.Full_Name (Command_Line_Config_Path.all)); - else - - -- Use absolute path from user - Alire.Config.Edit.Set_Path (Command_Line_Config_Path.all); - end if; + declare + Config_Path : constant Alire.Absolute_Path + := Ada.Directories.Full_Name (Command_Line_Config_Path.all); + begin + Alire.Config.Edit.Set_Path (Config_Path); + Alire.Shared.Set_Path (Config_Path); + end; end if; Create_Alire_Folders; -- 2.39.5