Implementing the chmod support

.gitignore

@@ -3,3 +3,4 @@ _opam
 .ocamlformat
 .*.swp
 *.install
+.vscode

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,15 @@ 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,9 @@ 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] changes the permissions of [t] to [perm].
+
+    If [follow = true], the permissions of the target of a symlink are changed.
+    Otherwise, the permissions of the symlink itself are changed. *)

lib_eio_linux/eio_linux.ml

@@ -454,6 +454,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 ~perm path
 
   let pp f t = Fmt.string f (String.escaped t.label)
 

lib_eio_linux/eio_stubs.c

@@ -115,6 +115,20 @@ CAMLprim value caml_eio_symlinkat(value v_old_path, value v_new_fd, value v_new_
   CAMLreturn(Val_unit);
 }
 
+CAMLprim value caml_eio_fchmodat(value v_fd, value v_path, value v_mode, value v_flags) {
+  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(path);
+  if (ret == -1) uerror("fchmodat", v_path);
+  CAMLreturn(Val_unit);
+}
+
 CAMLprim value caml_eio_getrandom(value v_ba, value v_off, value v_len) {
   CAMLparam1(v_ba);
   ssize_t ret;

lib_eio_linux/low_level.ml

@@ -360,6 +360,8 @@ external eio_renameat : Unix.file_descr -> string -> Unix.file_descr -> string -
 
 external eio_symlinkat : string -> Unix.file_descr -> string -> unit = "caml_eio_symlinkat"
 
+external eio_fchmodat : Unix.file_descr -> string -> int -> int -> unit = "caml_eio_fchmodat"
+
 external eio_getrandom : Cstruct.buffer -> int -> int -> int = "caml_eio_getrandom"
 
 external eio_getdents : Unix.file_descr -> string list = "caml_eio_getdents"
@@ -486,6 +488,14 @@ let symlink ~link_to dir path =
     eio_symlinkat link_to parent leaf
   with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap_fs code name arg
 
+  let chmod ~follow ~perm dir path =
+    let module X = Uring.Statx in
+    with_parent_dir "chmodat" dir path @@ fun parent leaf ->
+    let flags = if follow then 0 else  0x100 in
+    try
+      eio_fchmodat parent leaf perm flags
+      with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap_fs code name arg
+
 let shutdown socket command =
   try
     Fd.use_exn "shutdown" socket @@ fun fd ->

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 -> perm:int -> dir_fd -> string -> unit
+(** [chmod ~follow ~perm dir path] sets the permissions 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/eio_posix_stubs.c

@@ -405,6 +405,20 @@ CAMLprim value caml_eio_posix_symlinkat(value v_old_path, value v_new_fd, value
   CAMLreturn(Val_unit);
 }
 
+CAMLprim value caml_eio_posix_fchmodat(value v_fd, value v_path, value v_mode, value v_flags) {
+  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);
+}
+
 CAMLprim value caml_eio_posix_spawn(value v_errors, value v_actions) {
   CAMLparam1(v_actions);
   pid_t child_pid;

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,15 @@ 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
 
+external eio_fchmodat : Unix.file_descr -> string -> int -> int -> unit = "caml_eio_posix_fchmodat"
+
+let chmod ~follow ~mode dir path =
+  in_worker_thread "chmod" @@ fun () ->
+  Resolve.with_parent "chmod" dir path @@ fun dir path ->
+  let new_dir = Option.value dir ~default:at_fdcwd in
+  let flags = if follow then 0 else Config.at_symlink_nofollow in
+  eio_fchmodat 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

@@ -81,6 +81,8 @@ val rename : dir_fd -> string -> dir_fd -> string -> unit
 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
 

lib_eio_windows/eio_windows_stubs.c

@@ -257,6 +257,10 @@ CAMLprim value caml_eio_windows_symlinkat(value v_old_path, value v_new_fd, valu
   uerror("symlinkat is not supported on windows yet", Nothing);
 }
 
+CAMLprim value eio_windows_chmod(value path, value perm) {
+    caml_failwith("chmod is not implemented on Windows");
+}
+
 CAMLprim value caml_eio_windows_spawn(value v_errors, value v_actions)
 {
   uerror("processes are not supported on windows yet", Nothing);

lib_eio_windows/fs.ml

@@ -89,6 +89,11 @@ end = struct
 
   let v ~label ~sandbox dir_path = { dir_path; sandbox; label; closed = false }
 
+  let chmod (_t : t) ~(follow : bool) ~(perm : int) (_path : string) : unit =
+    ignore (follow);
+    ignore (perm);
+    failwith "chmod not implemented on Windows yet"
+
   (* Sandboxes use [O_NOFOLLOW] when opening files ([resolve] already removed any symlinks).
      This avoids a race where symlink might be added after [realpath] returns.
      TODO: Emulate [O_NOFOLLOW] here. *)

tests/fs.md

@@ -14,6 +14,7 @@ module Path = Eio.Path
 let () = Eio.Exn.Backend.show := false
 
 open Eio.Std
+open Eio.Exn
 
 let ( / ) = Path.( / )
 
@@ -77,12 +78,13 @@ 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
-    | exception Eio.Io (e, _) -> Fmt.str "@[<h>%a@]" Eio.Exn.pp_err e
-  in
+    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
   let b = stat ~follow:true in
   if a = b then
@@ -94,6 +96,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
@@ -829,6 +836,7 @@ Unconfined:
   try_stat cwd;
   try_stat (cwd / "..");
   try_stat (cwd / "stat_subdir2/..");
+
   Path.symlink ~link_to:".." (cwd / "parent-symlink");
   try_stat (cwd / "parent-symlink");
   try_stat (cwd / "missing1" / "missing2");
@@ -1011,3 +1019,36 @@ Exception: Failure "Simulated error".
 +"/" / "" = "/"
 - : unit = ()
 ```
+
+```ocaml
+# run ~clear:["test-file"] @@ fun env ->
+  let cwd = Eio.Stdenv.cwd env in
+  Switch.run @@ fun sw ->
+
+  let file_path = cwd / "test-file" in
+  Path.save ~create:(`Exclusive 0o644) file_path "test data";
+  traceln "+create <cwd:test-file> with permissions 0o644 -> ok";
+
+  let initial_perm = (Path.stat ~follow:true file_path).perm in
+  traceln "+<cwd:test-file> initial permissions = %o" initial_perm;
+  assert (initial_perm = 0o644);
+
+  try_chmod ~follow:true ~perm:0o400 file_path;
+
+  try_stat ~info_type:`Perm file_path;
+
+  try_chmod ~follow:true ~perm:0o600 file_path;
+  try_stat ~info_type:`Perm file_path;
+
+  Eio.Path.unlink file_path;
+  traceln "+unlink <cwd:test-file> -> ok";
+  ()
+++create <cwd:test-file> with permissions 0o644 -> ok
+++<cwd:test-file> initial permissions = 644
++chmod <cwd:test-file> to 400 -> ok
++<cwd:test-file> -> 400
++chmod <cwd:test-file> to 600 -> ok
++<cwd:test-file> -> 600
+++unlink <cwd:test-file> -> ok
+- : unit = ()
+```