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..d0ff0144 100644 --- a/lib_eio/path.ml +++ b/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, _) -> diff --git a/lib_eio/path.mli b/lib_eio/path.mli index d147f545..3df9380e 100644 --- a/lib_eio/path.mli +++ b/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. *) diff --git a/lib_eio/unix/eio_unix.mli b/lib_eio/unix/eio_unix.mli index 774ba5f6..2dc9b722 100644 --- a/lib_eio/unix/eio_unix.mli +++ b/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 diff --git a/lib_eio/unix/primitives.h b/lib_eio/unix/primitives.h index d43166a9..2fbf95af 100644 --- a/lib_eio/unix/primitives.h +++ b/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); diff --git a/lib_eio/unix/private.ml b/lib_eio/unix/private.ml index 96199076..da2a9b66 100644 --- a/lib_eio/unix/private.ml +++ b/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) diff --git a/lib_eio/unix/stubs.c b/lib_eio/unix/stubs.c index 78572bf4..19575456 100644 --- a/lib_eio/unix/stubs.c +++ b/lib_eio/unix/stubs.c @@ -3,6 +3,7 @@ #include #include #include +#include #include #include @@ -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 +} diff --git a/lib_eio_linux/dune b/lib_eio_linux/dune index 12b9921b..27aef68f 100644 --- 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/eio_linux.ml b/lib_eio_linux/eio_linux.ml index ec9c8eb0..f8f013c5 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/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 diff --git a/lib_eio_linux/include/discover.ml b/lib_eio_linux/include/discover.ml new file mode 100644 index 00000000..1709c0a0 --- /dev/null +++ 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 new file mode 100644 index 00000000..db98d61d --- /dev/null +++ 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 index 42e72bfa..4f9d4c94 100644 --- a/lib_eio_linux/low_level.ml +++ b/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; _ } = diff --git a/lib_eio_linux/low_level.mli b/lib_eio_linux/low_level.mli index a3736e16..d2796bbf 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 -> 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. *) diff --git a/lib_eio_posix/fs.ml b/lib_eio_posix/fs.ml index 1a20523a..1ef9eb93 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..05654d50 100644 --- a/lib_eio_posix/low_level.ml +++ b/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 -> diff --git a/lib_eio_posix/low_level.mli b/lib_eio_posix/low_level.mli index 69efe720..49ed8a7f 100644 --- a/lib_eio_posix/low_level.mli +++ b/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 diff --git a/lib_eio_windows/fs.ml b/lib_eio_windows/fs.ml index d877b6fb..51e09c8d 100755 --- a/lib_eio_windows/fs.ml +++ b/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 = diff --git a/lib_eio_windows/low_level.ml b/lib_eio_windows/low_level.ml index 85f25cd2..1e9dc11f 100755 --- a/lib_eio_windows/low_level.ml +++ b/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,7 +223,7 @@ 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" @@ -231,7 +231,7 @@ external eio_renameat : Unix.file_descr option -> string -> Unix.file_descr opti 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 @@ -239,9 +239,17 @@ external eio_symlinkat : string -> Unix.file_descr option -> string -> unit = "c 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 = diff --git a/lib_eio_windows/low_level.mli b/lib_eio_windows/low_level.mli index e2ec400b..a09a189f 100755 --- a/lib_eio_windows/low_level.mli +++ b/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 diff --git a/tests/fs.md b/tests/fs.md index 446874ad..0f420ac8 100644 --- 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 "@[%a@]" Eio.File.Stat.pp_kind info.kind + 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 @@ -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 "@[%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 @@ -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 to 400 -> ok ++ -> 400 ++chmod to 600 -> ok ++ -> 600 +- : unit = () +``` + + # pread/pwrite Check reading and writing vectors at arbitrary offsets: