Add dune cache clear command (#8975)

Signed-off-by: Nicolás Ojeda Bär <[email protected]>

Author: nojb

bin/cache.ml

@@ -80,18 +80,27 @@ let size =
     Cmd.info "size" ~doc ~man
   in
   Cmd.v info
-  @@ let+ machine_readble =
+  @@ let+ machine_readable =
        Arg.(
          value
          & flag
          & info [ "machine-readable" ] ~doc:"Outputs size as a plain number of bytes.")
      in
      let size = Dune_cache.Trimmer.overhead_size () in
-     if machine_readble
+     if machine_readable
      then User_message.print (User_message.make [ Pp.textf "%Ld" size ])
      else User_message.print (User_message.make [ Pp.textf "%s" (Bytes_unit.pp size) ])
 ;;
 
+let clear =
+  let info =
+    let doc = "Clear the Dune cache." in
+    let man = [ `P "Remove any traces of the Dune cache." ] in
+    Cmd.info "clear" ~doc ~man
+  in
+  Cmd.v info @@ Term.(const Dune_cache_storage.clear $ const ())
+;;
+
 let command =
   let info =
     let doc = "Manage Dune's shared cache of build artifacts." in
@@ -104,5 +113,5 @@ let command =
     in
     Cmd.info "cache" ~doc ~man
   in
-  Cmd.group info [ trim; size ]
+  Cmd.group info [ trim; size; clear ]
 ;;

doc/changes/8975.md

@@ -0,0 +1,2 @@
+- Add command `dune cache clear` to completely delete all traces of the Dune
+  cache. (#8975, @nojb)

src/dune_cache_storage/dune_cache_storage.ml

@@ -338,3 +338,24 @@ let with_temp_file ?(prefix = "dune") ~suffix f =
 let with_temp_dir ?(prefix = "dune") ~suffix f =
   Fiber_util.Temp.with_temp_dir ~parent_dir:Layout.temp_dir ~prefix ~suffix ~f
 ;;
+
+let clear () =
+  let rm_rf path = Path.rm_rf ~allow_external:true path in
+  let rmdir path =
+    try Path.rmdir path with
+    | Unix.Unix_error ((ENOENT | ENOTEMPTY), _, _) -> ()
+  in
+  let rm_rf_all versions dir =
+    List.iter versions ~f:(fun version ->
+      let dir = dir version in
+      rm_rf dir;
+      Option.iter ~f:rmdir (Path.parent dir))
+  in
+  rm_rf_all Version.Metadata.all Layout.Versioned.metadata_storage_dir;
+  rm_rf_all Version.File.all Layout.Versioned.file_storage_dir;
+  rm_rf_all Version.Value.all Layout.Versioned.value_storage_dir;
+  rm_rf Layout.temp_dir;
+  (* Do not catch errors when deleting the root directory so that they are
+     reported to the user. *)
+  Path.rmdir Layout.root_dir
+;;

src/dune_cache_storage/dune_cache_storage.mli

@@ -138,3 +138,5 @@ module Raw_value : sig
     -> content_digest:Digest.t
     -> Util.Write_result.t
 end
+
+val clear : unit -> unit

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

@@ -13,6 +13,9 @@ Here we observe the documentation for the dune cache commands.
          functionality soon.
   
   COMMANDS
+         clear [OPTION]…
+             Clear the Dune cache.
+  
          size [--machine-readable] [OPTION]…
              Query the size of the Dune cache.
   

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

@@ -0,0 +1,40 @@
+Test for the "dune cache clear" command.
+
+  $ export DUNE_CACHE=enabled
+  $ export DUNE_CACHE_ROOT=$PWD/dune-cache
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.10)
+  > EOF
+
+  $ cat >dune <<EOF
+  > (rule (with-stdout-to foo (progn)))
+  > EOF
+
+  $ dune build
+
+  $ ls $DUNE_CACHE_ROOT | sort -u
+  files
+  meta
+  temp
+  values
+
+  $ dune cache clear
+
+  $ ! test -d $DUNE_CACHE_ROOT
+
+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
+
+  $ dune cache clear
+  Error:
+  rmdir($TESTCASE_ROOT/dune-cache): Directory not empty
+  [1]
+
+  $ find $DUNE_CACHE_ROOT -type f | sort -u
+  $TESTCASE_ROOT/dune-cache/extra/extra2
+  $TESTCASE_ROOT/dune-cache/extra1