diff --git a/.gitignore b/.gitignore index 5f1f7472..4fb256da 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ _opam .ocamlformat .*.swp *.install +.vscode diff --git a/lib_eio/fs.ml b/lib_eio/fs.ml index 34505c9f..791f9566 100644 --- a/lib_eio/fs.ml +++ b/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 diff --git a/lib_eio/path.ml b/lib_eio/path.ml index 37cd5ff0..d428a64c 100644 --- a/lib_eio/path.ml +++ b/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, _) -> diff --git a/lib_eio/path.mli b/lib_eio/path.mli index d147f545..a4603fb2 100644 --- a/lib_eio/path.mli +++ b/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. *) \ No newline at end of file diff --git a/lib_eio_linux/eio_linux.ml b/lib_eio_linux/eio_linux.ml index ec9c8eb0..3af48540 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/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) diff --git a/lib_eio_linux/eio_stubs.c b/lib_eio_linux/eio_stubs.c index 4e405410..88d757fa 100644 --- a/lib_eio_linux/eio_stubs.c +++ b/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; diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml index 42e72bfa..4ca81a18 100644 --- a/lib_eio_linux/low_level.ml +++ b/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 -> diff --git a/lib_eio_linux/low_level.mli b/lib_eio_linux/low_level.mli index a3736e16..12339e3e 100644 --- a/lib_eio_linux/low_level.mli +++ b/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. *) diff --git a/lib_eio_posix/eio_posix_stubs.c b/lib_eio_posix/eio_posix_stubs.c index a3895f48..4f691330 100644 --- a/lib_eio_posix/eio_posix_stubs.c +++ b/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; diff --git a/lib_eio_posix/fs.ml b/lib_eio_posix/fs.ml index 1a20523a..c5544757 100644 --- a/lib_eio_posix/fs.ml +++ b/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 diff --git a/lib_eio_posix/low_level.ml b/lib_eio_posix/low_level.ml index 6026993d..0f76e99b 100644 --- a/lib_eio_posix/low_level.ml +++ b/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 -> diff --git a/lib_eio_posix/low_level.mli b/lib_eio_posix/low_level.mli index 69efe720..3d172a36 100644 --- a/lib_eio_posix/low_level.mli +++ b/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 diff --git a/lib_eio_windows/eio_windows_stubs.c b/lib_eio_windows/eio_windows_stubs.c index 4e26e21c..ffd2deb2 100755 --- a/lib_eio_windows/eio_windows_stubs.c +++ b/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); diff --git a/lib_eio_windows/fs.ml b/lib_eio_windows/fs.ml index d877b6fb..18c2e6cf 100755 --- a/lib_eio_windows/fs.ml +++ b/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. *) diff --git a/tests/fs.md b/tests/fs.md index 446874ad..4c369b6b 100644 --- a/tests/fs.md +++ b/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 "@[%a@]" Eio.File.Stat.pp_kind info.kind - | exception Eio.Io (e, _) -> Fmt.str "@[%a@]" Eio.Exn.pp_err e - in + match Eio.Path.stat ~follow path, info_type with + | info, `Perm -> Fmt.str "@[%o@]" info.perm + | info, `Kind -> Fmt.str "@[%a@]" Eio.File.Stat.pp_kind info.kind + | exception Eio.Io (e, _) -> Fmt.str "@[%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 "@[%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 "@[%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 with permissions 0o644 -> ok"; + + let initial_perm = (Path.stat ~follow:true file_path).perm in + traceln "+ 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 -> ok"; + () +++create with permissions 0o644 -> ok +++ initial permissions = 644 ++chmod to 400 -> ok ++ -> 400 ++chmod to 600 -> ok ++ -> 600 +++unlink -> ok +- : unit = () +```