Support chmod in Eio_linux and Eio_posix

lib_eio/fs.ml

@@ -71,6 +71,7 @@ module Pi = struct
     val rename : t -> path -> _ dir -> path -> unit
     val read_link : t -> path -> string
     val symlink : link_to:path -> t -> path -> unit
+    val chmod : t -> follow:bool -> perm:File.Unix_perm.t -> path -> unit
     val pp : t Fmt.t
     val native : t -> string -> string option
   end

lib_eio/path.ml

@@ -218,6 +218,14 @@ let symlink ~link_to source =
     let bt = Printexc.get_raw_backtrace () in
     Exn.reraise_with_context ex bt "creating symlink %a -> %s" pp source link_to
 
+let chmod ~follow ~perm t =
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.chmod dir ~follow ~perm path
+  with Exn.Io _ as ex ->
+    let bt = Printexc.get_raw_backtrace () in
+    Exn.reraise_with_context ex bt "chmoding file %a" pp t
+
 let rec mkdirs ?(exists_ok=false) ~perm t =
   (* Check parent exists first. *)
   split t |> Option.iter (fun (parent, _) ->

lib_eio/path.mli

@@ -217,3 +217,8 @@ val symlink : link_to:string -> _ t -> unit
     {[
       Eio.Path.symlink (dir / "current") ~link_to:"version-1.0"
     ]} *)
+
+val chmod : follow:bool -> perm:int -> _ t -> unit
+(** [chmod ~follow ~perm t] allows you to change the file mode bits.
+
+    @param follow If [true] and [t] is a symlink then change the file mode bits target. *)

lib_eio/unix/eio_unix.mli

@@ -107,6 +107,8 @@ module Private : sig
 
   val read_link : Fd.t option -> string -> string
   val read_link_unix : Unix.file_descr option -> string -> string
+  val chmod : Fd.t -> string -> flags:int -> mode:int -> unit
+  val chmod_unix : Unix.file_descr -> string -> flags:int -> mode:int -> unit
 end
 
 module Pi = Pi

lib_eio/unix/primitives.h

@@ -9,4 +9,5 @@ CAMLprim value eio_unix_fork_fchdir(value);
 CAMLprim value eio_unix_fork_dups(value);
 CAMLprim value eio_unix_cap_enter(value);
 CAMLprim value eio_unix_readlinkat(value, value, value);
+CAMLprim value eio_unix_fchmodat(value, value, value, value);
 CAMLprim value eio_unix_is_blocking(value);

lib_eio/unix/private.ml

@@ -33,3 +33,10 @@ let read_link_unix fd path =
     aux 1024
 
 let read_link fd path = Fd.use_exn_opt "readlink" fd (fun fd -> read_link_unix fd path)
+
+external eio_fchmodat : Unix.file_descr -> string -> int -> int -> unit = "eio_unix_fchmodat"
+
+let chmod_unix fd path ~flags ~mode = eio_fchmodat fd path mode flags
+
+let chmod fd path ~flags ~mode =
+  Fd.use_exn "chmod" fd (fun fd -> chmod_unix ~flags ~mode fd path)

lib_eio/unix/stubs.c

@@ -3,6 +3,7 @@
 #include <unistd.h>
 #include <fcntl.h>
 #include <errno.h>
+#include <sys/stat.h>
 
 #include <caml/mlvalues.h>
 #include <caml/unixsupport.h>
@@ -52,3 +53,21 @@ CAMLprim value eio_unix_readlinkat(value v_fd, value v_path, value v_cs) {
   CAMLreturn(Val_int(ret));
   #endif
 }
+
+CAMLprim value eio_unix_fchmodat(value v_fd, value v_path, value v_mode, value v_flags) {
+  #ifdef _WIN32
+  caml_unix_error(EOPNOTSUPP, "fchmodat not supported on Windows", v_path);
+  #else
+  CAMLparam1(v_path);
+  char *path;
+  int ret;
+  caml_unix_check_path(v_path, "fchmodat");
+  path = caml_stat_strdup(String_val(v_path));
+  caml_enter_blocking_section();
+  ret = fchmodat(Int_val(v_fd), path, Int_val(v_mode), Int_val(v_flags));
+  caml_leave_blocking_section();
+  caml_stat_free_preserving_errno(path);
+  if (ret == -1) uerror("fchmodat", v_path);
+  CAMLreturn(Val_unit);
+  #endif
+}

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

lib_eio_linux/eio_linux.ml

@@ -455,6 +455,9 @@ end = struct
   let symlink ~link_to t path =
     Low_level.symlink ~link_to t.fd path
 
+  let chmod t ~follow ~perm path =
+    Low_level.chmod t.fd ~follow ~mode:perm path
+
   let pp f t = Fmt.string f (String.escaped t.label)
 
   let fd t = t.fd

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

lib_eio_linux/include/dune

@@ -0,0 +1,4 @@
+(executable
+ (name discover)
+ (modules discover)
+ (libraries dune-configurator))

lib_eio_linux/low_level.ml

@@ -524,6 +524,15 @@ let read_link fd path =
     Eio_unix.run_in_systhread ~label:"read_link" (fun () -> Eio_unix.Private.read_link (Some parent) leaf)
   with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap_fs code name arg
 
+let chmod ~follow ~mode dir path =
+  let module X = Uring.Statx 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 ->
+    Eio_unix.run_in_systhread ~label:"chmod" (fun () -> Eio_unix.Private.chmod parent leaf ~mode ~flags)
+  with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap_fs code name arg
+
 (* https://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml *)
 let getaddrinfo ~service node =
   let to_eio_sockaddr_t {Unix.ai_family; ai_addr; ai_socktype; ai_protocol; _ } =

lib_eio_linux/low_level.mli

@@ -153,6 +153,9 @@ val rename : dir_fd -> string -> dir_fd -> string -> unit
 val symlink : link_to:string -> dir_fd -> string -> unit
 (** [symlink ~link_to dir path] creates a new symlink at [dir / path] pointing to [link_to]. *)
 
+val chmod : follow:bool -> mode:int -> dir_fd -> string -> unit
+(** [chmod ~follow ~mode dir path] changes the file mode bits of [dir / path]. *)
+
 val pipe : sw:Switch.t -> fd * fd
 (** [pipe ~sw] returns a pair [r, w] with the readable and writeable ends of a new pipe. *)
 

lib_eio_posix/fs.ml

@@ -97,6 +97,9 @@ end = struct
   let symlink ~link_to t path =
     Err.run (Low_level.symlink ~link_to t.fd) path
 
+  let chmod t ~follow ~perm path =
+    Err.run (Low_level.chmod ~follow ~mode:perm t.fd) path
+
   let open_dir t ~sw path =
     let flags = Low_level.Open_flags.(rdonly + directory +? path) in
     let fd = Err.run (Low_level.openat ~sw ~mode:0 t.fd path) flags in

lib_eio_posix/low_level.ml

@@ -423,6 +423,13 @@ let symlink ~link_to new_dir new_path =
   let new_dir = Option.value new_dir ~default:at_fdcwd in
   eio_symlinkat link_to new_dir new_path
 
+let chmod ~follow ~mode dir path =
+  in_worker_thread "chmod" @@ fun () ->
+  let flags = if follow then 0 else Config.at_symlink_nofollow in
+  Resolve.with_parent "chmod" dir path @@ fun dir path ->
+  let new_dir = Option.value dir ~default:at_fdcwd in
+  Eio_unix.Private.chmod_unix new_dir path ~mode ~flags
+
 let read_link dirfd path =
   in_worker_thread "read_link" @@ fun () ->
   Resolve.with_parent "read_link" dirfd path @@ fun dirfd path ->

lib_eio_posix/low_level.mli

@@ -82,6 +82,8 @@ val symlink : link_to:string -> dir_fd -> string -> unit
 (** [symlink ~link_to dir path] will create a new symlink at [dir / path]
     linking to [link_to]. *)
 
+val chmod : follow:bool -> mode:int -> dir_fd -> string -> unit
+
 val readdir : dir_fd -> string -> string array
 
 val readv : fd -> Cstruct.t array -> int

lib_eio_windows/fs.ml

@@ -185,6 +185,10 @@ end = struct
     Switch.on_release sw (fun () -> close d);
     Eio.Resource.T (d, Handler.v)
 
+  let chmod t ~follow:_ ~perm path =
+    with_parent_dir t path @@ fun dirfd path ->
+    Low_level.chmod ~mode:perm dirfd path
+
   let pp f t = Fmt.string f (String.escaped t.label)
 
   let native _t _path =

lib_eio_windows/low_level.ml

@@ -211,7 +211,7 @@ external eio_openat : Unix.file_descr option -> bool -> string -> Flags.Open.t -
 let openat ?dirfd ?(nofollow=false) ~sw path flags dis create =
   with_dirfd "openat" dirfd @@ fun dirfd ->
   Switch.check sw;
-  in_worker_thread (fun () -> eio_openat dirfd nofollow path Flags.Open.(flags + cloexec (* + nonblock *)) dis create)
+  in_worker_thread ~label:"openat" (fun () -> eio_openat dirfd nofollow path Flags.Open.(flags + cloexec (* + nonblock *)) dis create)
   |> Fd.of_unix ~sw ~blocking:false ~close_unix:true
 
 let mkdir ?dirfd ?(nofollow=false) ~mode:_ path =
@@ -223,25 +223,33 @@ external eio_unlinkat : Unix.file_descr option -> string -> bool -> unit = "caml
 
 let unlink ?dirfd ~dir path =
   with_dirfd "unlink" dirfd @@ fun dirfd ->
-  in_worker_thread @@ fun () ->
+  in_worker_thread ~label:"unlink" @@ fun () ->
   eio_unlinkat dirfd path dir
 
 external eio_renameat : Unix.file_descr option -> string -> Unix.file_descr option -> string -> unit = "caml_eio_windows_renameat"
 
 let rename ?old_dir old_path ?new_dir new_path =
   with_dirfd "rename-old" old_dir @@ fun old_dir ->
   with_dirfd "rename-new" new_dir @@ fun new_dir ->
-  in_worker_thread @@ fun () ->
+  in_worker_thread ~label:"rename" @@ fun () ->
   eio_renameat old_dir old_path new_dir new_path
 
 
 external eio_symlinkat : string -> Unix.file_descr option -> string -> unit = "caml_eio_windows_symlinkat"
 
 let symlink ~link_to new_dir new_path =
   with_dirfd "symlink-new" new_dir @@ fun new_dir ->
-  in_worker_thread @@ fun () ->
+  in_worker_thread ~label:"symlink" @@ fun () ->
   eio_symlinkat link_to new_dir new_path
 
+let chmod ~mode new_dir new_path =
+  with_dirfd "chmod" new_dir @@ fun new_dir ->
+  match new_dir with
+  | Some _ -> failwith "chmod not supported on Windows"
+  | None ->
+    in_worker_thread ~label:"chmod" @@ fun () ->
+    Unix.chmod new_path mode
+
 let lseek fd off cmd =
   Fd.use_exn "lseek" fd @@ fun fd ->
   let cmd =

lib_eio_windows/low_level.mli

@@ -52,6 +52,10 @@ val symlink : link_to:string -> fd option -> string -> unit
 (** [symlink ~link_to dir path] will create a new symlink at [dir / path]
     linking to [link_to]. *)
 
+val chmod : mode:int -> fd option -> string -> unit
+(** [chmod ~mode path] is just a non-blocking call to {! Unix.chmod} when
+    [fd = None], otherwise it is unsupported. *)
+
 val readdir : string -> string array
 
 val readv : fd -> Cstruct.t array -> int

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: