Merge pull request #11541 from ocaml/digest-no-perm

Cache: only store executable permission bit

Author: ElectreAAS

doc/changes/11541.md

@@ -0,0 +1 @@
+- Cache: we now only store the executable permission bit for files (#11541, fixes #11533, @ElectreAAS)

src/dune_digest/digest.ml

@@ -91,11 +91,13 @@ let file_with_executable_bit ~executable path =
 module Stats_for_digest = struct
   type t =
     { st_kind : Unix.file_kind
-    ; st_perm : Unix.file_perm
+    ; executable : bool
     }
 
   let of_unix_stats (stats : Unix.stats) =
-    { st_kind = stats.st_kind; st_perm = stats.st_perm }
+    (* Check if any of the +x bits are set, ignore read and write *)
+    let executable = 0o111 land stats.st_perm <> 0 in
+    { st_kind = stats.st_kind; executable }
   ;;
 end
 
@@ -113,17 +115,15 @@ let path_with_stats ~allow_dirs path (stats : Stats_for_digest.t) =
   let rec loop path (stats : Stats_for_digest.t) =
     match stats.st_kind with
     | S_LNK ->
-      let executable = Path.Permissions.test Path.Permissions.execute stats.st_perm in
       Dune_filesystem_stubs.Unix_error.Detailed.catch
         (fun path ->
            let contents = Unix.readlink (Path.to_string path) in
-           path_with_executable_bit ~executable ~content_digest:contents)
+           path_with_executable_bit ~executable:stats.executable ~content_digest:contents)
         path
       |> Result.map_error ~f:(fun x -> Path_digest_error.Unix_error x)
     | S_REG ->
-      let executable = Path.Permissions.test Path.Permissions.execute stats.st_perm in
       Dune_filesystem_stubs.Unix_error.Detailed.catch
-        (file_with_executable_bit ~executable)
+        (file_with_executable_bit ~executable:stats.executable)
         path
       |> Result.map_error ~f:(fun x -> Path_digest_error.Unix_error x)
     | S_DIR when allow_dirs ->
@@ -150,7 +150,8 @@ let path_with_stats ~allow_dirs path (stats : Stats_for_digest.t) =
             |> List.sort ~compare:(fun (x, _) (y, _) -> String.compare x y)
           with
           | exception E e -> Error e
-          | contents -> Ok (generic (directory_digest_version, contents, stats.st_perm))))
+          | contents ->
+            Ok (generic (directory_digest_version, contents, stats.executable))))
     | S_DIR | S_BLK | S_CHR | S_FIFO | S_SOCK -> Error Unexpected_kind
   in
   match stats.st_kind with

src/dune_digest/digest.mli

@@ -24,7 +24,7 @@ val generic : 'a -> t
 module Stats_for_digest : sig
   type t =
     { st_kind : Unix.file_kind
-    ; st_perm : Unix.file_perm
+    ; executable : bool
     }
 
   val of_unix_stats : Unix.stats -> t

test/blackbox-tests/test-cases/directory-targets/cache-permissions.t

@@ -37,20 +37,16 @@ First build: `d` (with mode 755) and `other` are stored in cache
   $ dune build other
   building d
   building other
+
+The chmod command was run, so this is expected
   $ dune_cmd stat permissions _build/default/d
   755
 
-Second build: `d` is restored but the cached `other` depends on a version of
-`d` that does not correspond to what's in `_build`, so `other` gets rebuilt.
-Both versions are stored.
+Second build: `d` is restored and `other` can use it, so no rebuild happens.
 
   $ dune clean
   $ dune build other
-  building other
+
+We'll note that the permissions are still set to the umask
   $ dune_cmd stat permissions _build/default/d
   775
-
-Third build: `d` is restored and `other` can use it, so no rebuild happens.
-
-  $ dune clean
-  $ dune build other

test/expect-tests/digest/digest_tests.ml

@@ -2,14 +2,14 @@ open Stdune
 module Digest = Dune_digest
 
 let%expect_test "directory digest version" =
-  (* If this test fails with a new digest value, make sure to update to update
+  (* If this test fails with a new digest value, make sure to update
      [directory_digest_version] in digest.ml.
 
      The expected value is kept outside of the expect block on purpose so that it
      must be modified manually. *)
   let expected = "a743ec66ce913ff6587a3816a8acc6ea" in
   let dir = Temp.create Dir ~prefix:"digest-tests" ~suffix:"" in
-  let stats = { Digest.Stats_for_digest.st_kind = S_DIR; st_perm = 1 } in
+  let stats = { Digest.Stats_for_digest.st_kind = S_DIR; executable = true } in
   (match Digest.path_with_stats ~allow_dirs:true dir stats with
    | Ok digest ->
      let digest = Digest.to_string digest in
@@ -26,7 +26,7 @@ let%expect_test "directory digest version" =
 
 let%expect_test "directories with symlinks" =
   let dir = Temp.create Dir ~prefix:"digest-tests" ~suffix:"" in
-  let stats = { Digest.Stats_for_digest.st_kind = S_DIR; st_perm = 1 } in
+  let stats = { Digest.Stats_for_digest.st_kind = S_DIR; executable = true } in
   let sub = Path.relative dir "sub" in
   Path.mkdir_p sub;
   Unix.symlink "bar" (Path.to_string (Path.relative dir "foo"));