diff --git a/bin/common.ml b/bin/common.ml index 97db9c619b4..48b8894e5ae 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -1380,8 +1380,8 @@ let init_with_root ~(root : Workspace_root.t) (builder : Builder.t) = ]; Log.info [ Pp.textf - "Shared cache location: %s" - (Path.to_string (Lazy.force Dune_cache_storage.Layout.root_dir)) + "Shared build cache location: %s" + (Path.to_string (Lazy.force Dune_cache_storage.Layout.build_cache_dir)) ]; Dune_rules.Main.init ~stats:c.stats @@ -1505,8 +1505,15 @@ let envs = ~doc:"If different than $(b,0), ANSI colors should be enabled no matter what." "CLICOLOR_FORCE" ; info + ~doc: + "If set, determines the location of all the different caches used by dune. \ + Defaults to XDG_CACHE_HOME/dune if unset." + "DUNE_CACHE_HOME" + ; info + ~doc: + "If set, determines the location of the machine-global shared cache. This is \ + the main build cache used by dune. Defaults to DUNE_CACHE_HOME/db if unset" "DUNE_CACHE_ROOT" - ~doc:"If set, determines the location of the machine-global shared cache." ] ;; diff --git a/doc/changes/fixed/11612.md b/doc/changes/fixed/11612.md new file mode 100644 index 00000000000..ed2a9706f0d --- /dev/null +++ b/doc/changes/fixed/11612.md @@ -0,0 +1,4 @@ +- Introduce a new variable `$DUNE_CACHE_HOME` encompassing all dune caches, + instead of relying only on `$XDG_CACHE_HOME` in the case of toolchains / + git-repo / rev-store caches. `$DUNE_CACHE_ROOT` still exists and has priority, + but might be removed in the future. (#11612, fixes #11584, @ElectreAAS) diff --git a/src/dune_cache_storage/dune_cache_storage.ml b/src/dune_cache_storage/dune_cache_storage.ml index b30776ac141..ea46e0477f7 100644 --- a/src/dune_cache_storage/dune_cache_storage.ml +++ b/src/dune_cache_storage/dune_cache_storage.ml @@ -376,5 +376,5 @@ let clear () = rm_rf (Lazy.force Layout.temp_dir); (* Do not catch errors when deleting the root directory so that they are reported to the user. *) - Path.rmdir (Lazy.force Layout.root_dir) + Path.rmdir (Lazy.force Layout.build_cache_dir) ;; diff --git a/src/dune_cache_storage/layout.ml b/src/dune_cache_storage/layout.ml index ac695019326..8c03607fca9 100644 --- a/src/dune_cache_storage/layout.ml +++ b/src/dune_cache_storage/layout.ml @@ -1,25 +1,22 @@ open Stdune open Import -let default_root_dir = - lazy - (let cache_dir = Xdg.cache_dir (Lazy.force Dune_util.xdg) in - Path.L.relative (Path.of_filename_relative_to_initial_cwd cache_dir) [ "dune"; "db" ]) -;; +let ( / ) = Path.relative -let root_dir = +let build_cache_dir = lazy (let var = "DUNE_CACHE_ROOT" in match Sys.getenv_opt var with - | None -> Lazy.force default_root_dir | Some path -> if Filename.is_relative path - then failwith (sprintf "%s should be an absolute path, but is %s" var path); - Path.of_filename_relative_to_initial_cwd path) + then + User_error.raise + [ Pp.paragraphf "$%s should be an absolute path, but is %S" var path ]; + Path.external_ (Path.External.of_string path) + | None -> Lazy.force Dune_util.cache_home_dir / "db") ;; -let ( / ) = Path.relative -let temp_dir = lazy (Lazy.force root_dir / "temp") +let temp_dir = lazy (Lazy.force build_cache_dir / "temp") let cache_path ~dir ~hex = let two_first_chars = sprintf "%c%c" hex.[0] hex.[1] in @@ -52,13 +49,15 @@ let list_entries ~storage = module Versioned = struct let metadata_storage_dir t = - lazy (Lazy.force root_dir / "meta" / Version.Metadata.to_string t) + lazy (Lazy.force build_cache_dir / "meta" / Version.Metadata.to_string t) ;; - let file_storage_dir t = lazy (Lazy.force root_dir / "files" / Version.File.to_string t) + let file_storage_dir t = + lazy (Lazy.force build_cache_dir / "files" / Version.File.to_string t) + ;; let value_storage_dir t = - lazy (Lazy.force root_dir / "values" / Version.Value.to_string t) + lazy (Lazy.force build_cache_dir / "values" / Version.Value.to_string t) ;; let metadata_path t ~rule_or_action_digest = diff --git a/src/dune_cache_storage/layout.mli b/src/dune_cache_storage/layout.mli index 73798fc94bf..ea0beccc27d 100644 --- a/src/dune_cache_storage/layout.mli +++ b/src/dune_cache_storage/layout.mli @@ -8,8 +8,10 @@ open Stdune open Import -(** The path to the root directory of the cache. *) -val root_dir : Path.t Lazy.t +(** The directory containing the build cache. + Set to [$DUNE_CACHE_ROOT] if it exists, or + [Dune_util.cache_home_dir/db] otherwise. *) +val build_cache_dir : Path.t Lazy.t (** Create a few subdirectories in [root_dir]. We expose this function because we don't want to modify the file system when the cache is disabled. diff --git a/src/dune_pkg/rev_store.ml b/src/dune_pkg/rev_store.ml index cc8d22fa57c..a462c0bca3d 100644 --- a/src/dune_pkg/rev_store.ml +++ b/src/dune_pkg/rev_store.ml @@ -145,33 +145,28 @@ module Cache = struct Dune_config.Config.make_toggle ~name:"rev_store_cache" ~default:`Disabled ;; - let cache_dir = + let revision_store_dir = lazy - (let path = - Path.L.relative - (Lazy.force Dune_util.xdg - |> Xdg.cache_dir - |> Path.Outside_build_dir.of_string - |> Path.outside_build_dir) - [ "dune"; "rev_store" ] - in + (let path = Path.relative (Lazy.force Dune_util.cache_home_dir) "rev_store" in let rev_store_cache = Dune_config.Config.get rev_store_cache in Dune_util.Log.info [ Pp.textf "Revision store cache: %s" (Dune_config.Config.Toggle.to_string rev_store_cache) ]; - match rev_store_cache, Path.mkdir_p path with - | `Enabled, () -> + (* Why do we create the directory in all cases, and not just when enabled? *) + Path.mkdir_p path; + match rev_store_cache with + | `Enabled -> Dune_util.Log.info [ Pp.textf "Revision store cache location: %s" (Path.to_string path) ]; Some path - | `Disabled, () -> None) + | `Disabled -> None) ;; let db = lazy - (Lazy.force cache_dir + (Lazy.force revision_store_dir |> Option.map ~f:(fun path -> Lmdb.Env.create ~map_size:(Int64.to_int 5_000_000_000L) (* 5 GB *) @@ -1220,13 +1215,15 @@ let content_of_files t files = | None -> Cache.Key.Map.find_exn to_write key) ;; +let git_repo_dir = + lazy + (let dir = Path.relative (Lazy.force Dune_util.cache_home_dir) "git-repo" in + Dune_util.Log.info + [ Pp.textf "Git repository cache location: %s" (Path.to_string dir) ]; + dir) +;; + let get = - Fiber.Lazy.create (fun () -> - let dir = - Path.L.relative - (Path.of_string (Xdg.cache_dir (Lazy.force Dune_util.xdg))) - [ "dune"; "git-repo" ] - in - load_or_create ~dir) + Fiber.Lazy.create (fun () -> load_or_create ~dir:(Lazy.force git_repo_dir)) |> Fiber.Lazy.force ;; diff --git a/src/dune_rules/pkg_toolchain.ml b/src/dune_rules/pkg_toolchain.ml index b83ac13c771..c7f2d249b55 100644 --- a/src/dune_rules/pkg_toolchain.ml +++ b/src/dune_rules/pkg_toolchain.ml @@ -1,21 +1,21 @@ open Import +let base_dir = + lazy + (let dir = Path.relative (Lazy.force Dune_util.cache_home_dir) "toolchains" in + Dune_util.Log.info [ Pp.textf "Toolchains cache location: %s" (Path.to_string dir) ]; + Path.as_outside_build_dir_exn dir) +;; + let base_dir () = - let cache_dir = - Lazy.force Dune_util.xdg |> Xdg.cache_dir |> Path.Outside_build_dir.of_string - in - let path = - Path.Outside_build_dir.relative - (Path.Outside_build_dir.relative cache_dir "dune") - "toolchains" - in - (let path = Path.outside_build_dir path in - if not (Path.Untracked.exists path) then Path.mkdir_p path; - if not (Path.Untracked.is_directory path) - then - User_error.raise - [ Pp.textf "Expected %s to be a directory but it is not." (Path.to_string path) ]); - path + let base_dir = Lazy.force base_dir in + let path = Path.outside_build_dir base_dir in + if not (Path.Untracked.exists path) then Path.mkdir_p path; + if not (Path.Untracked.is_directory path) + then + User_error.raise + [ Pp.textf "Expected %s to be a directory but it is not." (Path.to_string path) ]; + base_dir ;; let pkg_dir (pkg : Dune_pkg.Lock_dir.Pkg.t) = diff --git a/src/dune_rules/pkg_toolchain.mli b/src/dune_rules/pkg_toolchain.mli index 5e22008f982..d6b91169e5c 100644 --- a/src/dune_rules/pkg_toolchain.mli +++ b/src/dune_rules/pkg_toolchain.mli @@ -1,7 +1,8 @@ open Import (** The path to the directory that will contain all toolchain - versions. Creates the directory if it doesn't already exist. *) + versions. Creates the directory if it doesn't already exist. + Set to [Dune_util.cache_home_dir/toolchains]. *) val base_dir : unit -> Path.Outside_build_dir.t (** Dune will download and build the ocaml-base-compiler and @@ -21,7 +22,7 @@ val is_compiler_and_toolchains_enabled : Package.Name.t -> bool (** Returns the path to the directory containing the given package within the toolchain directory. This will be something like - $XDG_CACHE_HOME/dune/toolchains/ocaml-base-compiler.5.2.1.XXXXXXXX where + [base_dir/ocaml-base-compiler.5.2.1.XXXXXXXX] where XXXXXXXX is a hash of the package's lockfile. *) val installation_prefix : Lock_dir.Pkg.t -> Path.Outside_build_dir.t diff --git a/src/dune_util/dune_util.ml b/src/dune_util/dune_util.ml index 2741bd3e812..0619fbef9a4 100644 --- a/src/dune_util/dune_util.ml +++ b/src/dune_util/dune_util.ml @@ -1,3 +1,8 @@ +module Action = Action +module Alias_name = Alias_name +module Build_path_prefix_map = Build_path_prefix_map0 +module Gc = Gc +module Global_lock = Global_lock module Log = Log module Persistent = Persistent module Report_error = Report_error @@ -5,11 +10,6 @@ module Stringlike = Stringlike module type Stringlike = Stringlike_intf.S -module Build_path_prefix_map = Build_path_prefix_map0 -module Global_lock = Global_lock -module Action = Action -module Alias_name = Alias_name -module Gc = Gc open Stdune let manual_xdg = ref None @@ -38,6 +38,30 @@ let override_xdg : Xdg.t -> unit = else manual_xdg := Some new_xdg ;; +let ( / ) = Path.relative + +(** The default directory of all caches (build and others), used when + environment variables are unset. + Set to [$XDG_CACHE_HOME/dune]. *) +let default_cache_dir = + lazy + (let cache_dir = Xdg.cache_dir (Lazy.force xdg) in + Path.of_filename_relative_to_initial_cwd cache_dir / "dune") +;; + +let cache_home_dir = + lazy + (let var = "DUNE_CACHE_HOME" in + match Sys.getenv_opt var with + | Some path -> + if Filename.is_relative path + then + User_error.raise + [ Pp.paragraphf "$%s should be an absolute path, but is %S" var path ]; + Path.external_ (Path.External.of_string path) + | None -> Lazy.force default_cache_dir) +;; + let frames_per_second () = match Dune_config.Config.(get threaded_console_frames_per_second) with | `Custom fps -> fps diff --git a/src/dune_util/dune_util.mli b/src/dune_util/dune_util.mli new file mode 100644 index 00000000000..f48a14cad45 --- /dev/null +++ b/src/dune_util/dune_util.mli @@ -0,0 +1,23 @@ +module Action = Action +module Alias_name = Alias_name +module Build_path_prefix_map = Build_path_prefix_map0 +module Gc = Gc +module Global_lock = Global_lock +module Log = Log +module Persistent = Persistent +module Report_error = Report_error +module Stringlike = Stringlike + +module type Stringlike = Stringlike_intf.S + +open Stdune + +val xdg : Xdg.t Lazy.t +val override_xdg : Xdg.t -> unit + +(** The directory containing all caches (build and others). + Set to [$DUNE_CACHE_HOME] if it exists, or + [$XDG_CACHE_HOME/dune] otherwise. *) +val cache_home_dir : Path.t Lazy.t + +val frames_per_second : unit -> int diff --git a/test/blackbox-tests/test-cases/pkg/toolchain-installation.t b/test/blackbox-tests/test-cases/pkg/toolchain-installation.t index 4978e700cc4..56ed8c3fb20 100644 --- a/test/blackbox-tests/test-cases/pkg/toolchain-installation.t +++ b/test/blackbox-tests/test-cases/pkg/toolchain-installation.t @@ -76,8 +76,9 @@ name so the output is consistent across test runs. > sed 's/\(ocaml-base-compiler.1-\)[^/]*/\1HASH/' > } -Attempt to build the project. This will fail due to the fake compiler +Attempt to build the project. This will fail due to the fake compiler, but the fake compiler will end up installed as a toolchain package. +Also test that XDG_CACHE_HOME is respected. $ XDG_CACHE_HOME=$PWD/fake-cache DUNE_CONFIG__TOOLCHAINS=enabled build_pkg ocaml-base-compiler 2>&1 | remove_hash Enumerate the contents of the fake toolchains directory: @@ -87,3 +88,14 @@ Enumerate the contents of the fake toolchains directory: fake-cache/dune/toolchains/ocaml-base-compiler.1-HASH/target fake-cache/dune/toolchains/ocaml-base-compiler.1-HASH/target/bin fake-cache/dune/toolchains/ocaml-base-compiler.1-HASH/target/bin/ocamlc + +Also test that DUNE_CACHE_HOME is respected. + $ DUNE_CACHE_HOME=$PWD/other-fake-cache DUNE_CONFIG__TOOLCHAINS=enabled build_pkg ocaml-base-compiler 2>&1 | remove_hash + +Enumerate the contents of the fake toolchains directory: + $ find other-fake-cache/toolchains/ | sort | remove_hash + other-fake-cache/toolchains/ + other-fake-cache/toolchains/ocaml-base-compiler.1-HASH + other-fake-cache/toolchains/ocaml-base-compiler.1-HASH/target + other-fake-cache/toolchains/ocaml-base-compiler.1-HASH/target/bin + other-fake-cache/toolchains/ocaml-base-compiler.1-HASH/target/bin/ocamlc