Use DUNE_CACHE_ROOT instead of XDG_CACHE_HOME in toolchains/revstore caches

bin/common.ml

@@ -1377,8 +1377,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
@@ -1495,8 +1495,8 @@ 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."
         "DUNE_CACHE_ROOT"
-        ~doc:"If set, determines the location of the machine-global shared cache."
     ]
 ;;
 

doc/changes/fixed/11612.md

@@ -0,0 +1,8 @@
+- Fixed non-build caches not following `$DUNE_CACHE_ROOT` and instead only
+  relying on `$XDG_CACHE_HOME`.
+  This means the normal build cache moves:
+  `$DUNE_CACHE_ROOT -> $DUNE_CACHE_ROOT/db` (no changes if that variable was
+  unset). Affected users can prevent a full cache invalidation by moving
+  previous contents:
+  `cd $DUNE_CACHE_ROOT; mkdir db; mv <contents of directory> db`.
+  (#11612, fixes #11584, @ElectreAAS)

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)
 ;;

src/dune_cache_storage/layout.ml

@@ -1,25 +1,9 @@
 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 root_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)
-;;
-
 let ( / ) = Path.relative
-let temp_dir = lazy (Lazy.force root_dir / "temp")
+let build_cache_dir = lazy (Lazy.force Dune_util.cache_root_dir / "db")
+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 +36,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 =

src/dune_cache_storage/layout.mli

@@ -8,8 +8,9 @@
 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_util.cache_root_dir/db]. *)
+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.

src/dune_pkg/rev_store.ml

@@ -145,32 +145,26 @@ 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_root_dir) "rev_store" in
        let rev_store_cache = Dune_config.Config.get rev_store_cache in
        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, () ->
+       match rev_store_cache with
+       | `Enabled ->
+         Path.mkdir_p path;
          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 *)
@@ -1219,13 +1213,14 @@ 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_root_dir) "git-repo" in
+     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
 ;;

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_root_dir) "toolchains" in
+     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) =

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
 

src/dune_util/dune_util.ml

@@ -1,14 +1,14 @@
+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 Persistent = Persistent
 module Report_error = Report_error
 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
@@ -37,6 +37,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
+    [$DUNE_CACHE_ROOT] is 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_root_dir =
+  lazy
+    (let var = "DUNE_CACHE_ROOT" 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

src/dune_util/dune_util.mli

@@ -0,0 +1,22 @@
+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 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_ROOT] if it exists, or
+    [$XDG_CACHE_HOME/dune] otherwise. *)
+val cache_root_dir : Path.t Lazy.t
+
+val frames_per_second : unit -> int

test/blackbox-tests/test-cases/dune-cache/clear.t

@@ -13,28 +13,28 @@ Test for the "dune cache clear" command.
 
   $ dune build
 
-  $ ls $DUNE_CACHE_ROOT | sort -u
+  $ ls $DUNE_CACHE_ROOT/db | sort -u
   files
   meta
   temp
   values
 
   $ dune cache clear
 
-  $ ! test -d $DUNE_CACHE_ROOT
+  $ ! test -d $DUNE_CACHE_ROOT/db
 
 Next let us add some extra directories/files and check that they are not deleted
 by mistake.
 
   $ dune build
 
-  $ mkdir -p $DUNE_CACHE_ROOT/extra; touch $DUNE_CACHE_ROOT/extra1 $DUNE_CACHE_ROOT/extra/extra2
+  $ mkdir -p $DUNE_CACHE_ROOT/db/extra; touch $DUNE_CACHE_ROOT/db/extra1 $DUNE_CACHE_ROOT/db/extra/extra2
 
   $ dune cache clear
   Error:
-  rmdir($TESTCASE_ROOT/dune-cache): Directory not empty
+  rmdir($TESTCASE_ROOT/dune-cache/db): Directory not empty
   [1]
 
-  $ find $DUNE_CACHE_ROOT -type f | sort -u
-  $TESTCASE_ROOT/dune-cache/extra/extra2
-  $TESTCASE_ROOT/dune-cache/extra1
+  $ find $DUNE_CACHE_ROOT/db -type f | sort -u
+  $TESTCASE_ROOT/dune-cache/db/extra/extra2
+  $TESTCASE_ROOT/dune-cache/db/extra1

test/blackbox-tests/test-cases/dune-cache/default-cache.t

@@ -26,7 +26,7 @@ Change source files to force a recompilation
   > let f x y = x - y
   > EOF
   $ dune build
-  $ ls $DUNE_CACHE_ROOT | sort
+  $ ls $DUNE_CACHE_ROOT/db | sort
   files
   meta
   temp

test/blackbox-tests/test-cases/dune-cache/possible-locations.t

@@ -0,0 +1,35 @@
+Showcase all possible locations of the cache.
+
+  $ echo "(lang dune 3.17)" > dune-project
+
+  $ cat > dune << EOF
+  > (library
+  >  (name foo))
+  > EOF
+
+  $ cat > foo.ml << EOF
+  > let f x y = x + y
+  > EOF
+
+Populate the different cache locations.
+- Without any configuration
+  $ dune build
+  $ dune_cmd exists ~/.cache/dune/db
+  true
+
+- With XDG standard config
+  $ XDG_CACHE_HOME=$(pwd)/a dune build --force
+  $ dune_cmd exists $(pwd)/a/dune/db
+  true
+
+- With dune-specific config
+  $ DUNE_CACHE_ROOT=$(pwd)/b dune build --force
+  $ dune_cmd exists $(pwd)/b/db
+  true
+
+- With both of them, only the latter is used
+  $ XDG_CACHE_HOME=$(pwd)/c DUNE_CACHE_ROOT=$(pwd)/d dune build --force
+  $ dune_cmd exists $(pwd)/c/dune/db
+  false
+  $ dune_cmd exists $(pwd)/d/db
+  true

test/blackbox-tests/test-cases/dune-cache/readonly-fs.t

@@ -20,7 +20,7 @@ where Dune is supposed to store the cache:
   Warning: Cache directories could not be created: Permission denied; disabling
   cache
   Hint: Make sure the directory
-  $TESTCASE_ROOT/readonly/cache-dir/temp
+  $TESTCASE_ROOT/readonly/cache-dir/db/temp
   can be created
 
 Likewise, this should also happen if the location is set via XDG variables.

test/blackbox-tests/test-cases/dune-cache/repro-check.t

@@ -76,10 +76,10 @@ Set 'cache-check-probability' to 1.0, which should trigger the check
 
 Check that the reported digests make sense
 
-  $ dune_cmd cat $DUNE_CACHE_ROOT/files/v4/73/7378fb2d7d80dc4468d6558d864f0897
+  $ dune_cmd cat $DUNE_CACHE_ROOT/db/files/v4/73/7378fb2d7d80dc4468d6558d864f0897
   old-content
-  $ dune_cmd cat $DUNE_CACHE_ROOT/files/v4/074/074ebdc1c3853f27c68566d8d183032c
-  Fatal error: exception Unix.Unix_error(Unix.ENOENT, "open", "$TESTCASE_ROOT/.cache/files/v4/074/074ebdc1c3853f27c68566d8d183032c")
+  $ dune_cmd cat $DUNE_CACHE_ROOT/db/files/v4/074/074ebdc1c3853f27c68566d8d183032c
+  Fatal error: exception Unix.Unix_error(Unix.ENOENT, "open", "$TESTCASE_ROOT/.cache/db/files/v4/074/074ebdc1c3853f27c68566d8d183032c")
   [2]
 
 Check that probability values less than zero and greater than one are rejected