Fix eio_linux fchmodat and add tests

patricoferris · webbunivAdmin · patricoferris · commit 5068db1f9162 · 2024-11-30T12:44:14.000Z
Co-Authored-By: Daniel Ntege &lt;itsupport@bugemauniv.ac.ug&gt;
diff --git a/lib_eio_linux/dune b/lib_eio_linux/dune
@@ -13,6 +13,15 @@
   (names eio_stubs))
  (libraries eio eio.utils eio.unix uring fmt))
 
+(rule
+ (targets config.ml)
+ (enabled_if ; See https://github.com/ocaml/dune/issues/4895
+   (or (= %{system} "linux")          ; Historically, just Linux-x86
+       (= %{system} "linux_eabihf")   ; Historically, Linux-arm32
+       (= %{system} "linux_elf")      ; Historically, Linux-x86_32
+       (= %{system} "elf")))          ; Historically, Linux-ppc64
+ (action (run ./include/discover.exe)))
+
 (rule
  (enabled_if
    (and
diff --git a/lib_eio_linux/include/discover.ml b/lib_eio_linux/include/discover.ml
@@ -0,0 +1,20 @@
+module C = Configurator.V1
+
+let () =
+  C.main ~name:"discover" (fun c ->
+      let c_flags = ["-D_LARGEFILE64_SOURCE"; "-D_XOPEN_SOURCE=700"; "-D_GNU_SOURCE";] in
+      let present_defs =
+        C.C_define.import c ~c_flags
+          ~includes:["fcntl.h"]
+          C.C_define.Type.[
+            "AT_SYMLINK_NOFOLLOW", Int;
+          ]
+        |> List.map (function
+            | name, C.C_define.Value.Int v ->
+              Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v
+            | _ -> assert false
+          )
+      in
+      let defs = present_defs in
+      C.Flags.write_lines "config.ml" defs
+    )
diff --git a/lib_eio_linux/include/dune b/lib_eio_linux/include/dune
@@ -0,0 +1,4 @@
+(executable
+ (name discover)
+ (modules discover)
+ (libraries dune-configurator))
diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml
@@ -526,7 +526,7 @@ let read_link fd path =
 
 let chmod ~follow ~mode dir path =
   let module X = Uring.Statx in
-  let flags = if follow then X.Flags.empty_path else X.Flags.(empty_path + symlink_nofollow) in
+  let flags = if follow then 0 else Config.at_symlink_nofollow in
   let flags = (flags :> int) in
   try
     with_parent_dir_fd dir path @@ fun parent leaf ->
diff --git a/tests/fs.md b/tests/fs.md
@@ -77,10 +77,11 @@ let chdir path =
   traceln "chdir %S" path;
   Unix.chdir path
 
-let try_stat path =
+let try_stat ?(info_type=`Kind) path =
   let stat ~follow =
-    match Eio.Path.stat ~follow path with
-    | info -> Fmt.str "@[<h>%a@]" Eio.File.Stat.pp_kind info.kind
+    match Eio.Path.stat ~follow path, info_type with
+    | info, `Perm -> Fmt.str "@[<h>%o@]" info.perm
+    | info, `Kind -> Fmt.str "@[<h>%a@]" Eio.File.Stat.pp_kind info.kind
     | exception Eio.Io (e, _) -> Fmt.str "@[<h>%a@]" Eio.Exn.pp_err e
   in
   let a = stat ~follow:false in
@@ -94,6 +95,11 @@ let try_symlink ~link_to path =
   match Path.symlink ~link_to path with
   | s -> traceln "symlink %a -> %S" Path.pp path link_to
   | exception ex -> traceln "@[<h>%a@]" Eio.Exn.pp ex
+
+let try_chmod path ~follow ~perm =
+  match Eio.Path.chmod ~follow path ~perm with
+  | () -> traceln "chmod %a to %o -> ok" Path.pp path perm
+  | exception ex -> traceln "@[<h>%a@]" Eio.Exn.pp ex
 ```
 
 # Basic test cases
@@ -865,6 +871,27 @@ Unconfined:
 - : unit = ()
 ```
 
+# chmod
+
+Chmod works.
+
+```ocaml
+# run ~clear:["test-file"] @@ fun env ->
+  let cwd = Eio.Stdenv.cwd env in
+  let file_path = cwd / "test-file" in
+  Path.save ~create:(`Exclusive 0o644) file_path "test data";
+  try_chmod ~follow:false ~perm:0o400 file_path;
+  try_stat ~info_type:`Perm file_path;
+  try_chmod ~follow:false ~perm:0o600 file_path;
+  try_stat ~info_type:`Perm file_path
++chmod <cwd:test-file> to 400 -> ok
++<cwd:test-file> -> 400
++chmod <cwd:test-file> to 600 -> ok
++<cwd:test-file> -> 600
+- : unit = ()
+```
+
+
 # pread/pwrite
 
 Check reading and writing vectors at arbitrary offsets:
