From 3453561045c12ccffbf25ad6f78bf1f4d257aa73 Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Tue, 13 Feb 2024 11:30:06 +0000 Subject: [PATCH] eio_posix: use directory FDs instead of realpath realpath was an old hack from the libuv days. --- lib_eio_posix/eio_posix_stubs.c | 11 ++ lib_eio_posix/fs.ml | 159 ++++++------------- lib_eio_posix/low_level.ml | 244 ++++++++++++++++++++++++----- lib_eio_posix/low_level.mli | 25 ++- lib_eio_posix/net.ml | 2 +- lib_eio_posix/path.ml | 67 ++++++++ lib_eio_posix/path.mli | 22 +++ lib_eio_posix/primitives.h | 1 + lib_eio_posix/process.ml | 7 +- lib_eio_posix/test/dune | 6 + lib_eio_posix/test/open_beneath.ml | 81 ++++++++++ lib_eio_posix/test/path.md | 55 +++++++ lib_eio_posix/test/spawn.md | 2 +- 13 files changed, 516 insertions(+), 166 deletions(-) create mode 100644 lib_eio_posix/path.ml create mode 100644 lib_eio_posix/path.mli create mode 100644 lib_eio_posix/test/open_beneath.ml create mode 100644 lib_eio_posix/test/path.md diff --git a/lib_eio_posix/eio_posix_stubs.c b/lib_eio_posix/eio_posix_stubs.c index 21b862805..199b714c3 100644 --- a/lib_eio_posix/eio_posix_stubs.c +++ b/lib_eio_posix/eio_posix_stubs.c @@ -17,6 +17,7 @@ #include #include #include +#include #include #include @@ -527,3 +528,13 @@ CAMLprim value caml_eio_posix_recv_msg(value v_fd, value v_max_fds, value v_bufs CAMLreturn(v_result); } + +CAMLprim value caml_eio_posix_fdopendir(value v_fd) { + DIR *d = fdopendir(Int_val(v_fd)); + if (!d) + caml_uerror("fdopendir", Nothing); + + value v_result = caml_alloc_small(1, Abstract_tag); + DIR_Val(v_result) = d; + return v_result; +} diff --git a/lib_eio_posix/fs.ml b/lib_eio_posix/fs.ml index e41baba2a..45b105509 100644 --- a/lib_eio_posix/fs.ml +++ b/lib_eio_posix/fs.ml @@ -16,84 +16,50 @@ (* This module provides (optional) sandboxing, allowing operations to be restricted to a subtree. - For now, sandboxed directories use realpath and [O_NOFOLLOW], which is probably quite slow, - and requires duplicating a load of path lookup logic from the kernel. - It might be better to hold a directory FD rather than a path. - On FreeBSD we could use O_RESOLVE_BENEATH and let the OS handle everything for us. - On other systems we would have to resolve one path component at a time. *) + On FreeBSD we use O_RESOLVE_BENEATH and let the OS handle everything for us. + On other systems we resolve one path component at a time. *) open Eio.Std module Fd = Eio_unix.Fd +let openat ~sw ~mode fd path flags = + try + Low_level.openat ~sw ~mode fd path flags + with Unix.Unix_error (code, name, arg) -> + raise (Err.wrap code name arg) + +(* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check + that the new location is within its sandbox. *) +type (_, _, _) Eio.Resource.pi += Posix_dir : ('t, 't -> Low_level.dir_fd, [> `Posix_dir]) Eio.Resource.pi + +let as_posix_dir (Eio.Resource.T (t, ops)) = + match Eio.Resource.get_opt ops Posix_dir with + | None -> None + | Some fn -> Some (fn t) + module rec Dir : sig include Eio.Fs.Pi.DIR - val v : label:string -> sandbox:bool -> string -> t - - val resolve : t -> string -> string - (** [resolve t path] returns the real path that should be used to access [path]. - For sandboxes, this is [realpath path] (and it checks that it is within the sandbox). - For unrestricted access, this returns [path] unchanged. - @raise Eio.Fs.Permission_denied if sandboxed and [path] is outside of [dir_path]. *) + val v : label:string -> path:string -> Low_level.dir_fd -> t - val with_parent_dir : t -> string -> (Fd.t option -> string -> 'a) -> 'a - (** [with_parent_dir t path fn] runs [fn dir_fd rel_path], - where [rel_path] accessed relative to [dir_fd] gives access to [path]. - For unrestricted access, this just runs [fn None path]. - For sandboxes, it opens the parent of [path] as [dir_fd] and runs [fn (Some dir_fd) (basename path)]. *) + val fd : t -> Low_level.dir_fd end = struct type t = { + fd : Low_level.dir_fd; dir_path : string; - sandbox : bool; label : string; - mutable closed : bool; } - let resolve t path = - if t.sandbox then ( - if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path; - if Filename.is_relative path then ( - let dir_path = Err.run Low_level.realpath t.dir_path in - let full = Err.run Low_level.realpath (Filename.concat dir_path path) in - let prefix_len = String.length dir_path + 1 in - if String.length full >= prefix_len && String.sub full 0 prefix_len = dir_path ^ Filename.dir_sep then - full - else if full = dir_path then - full - else - raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox (full, dir_path))) - ) else ( - raise @@ Eio.Fs.err (Permission_denied Err.Absolute_path) - ) - ) else path - - let with_parent_dir t path fn = - if t.sandbox then ( - if t.closed then Fmt.invalid_arg "Attempt to use closed directory %S" t.dir_path; - let dir, leaf = Filename.dirname path, Filename.basename path in - let dir, leaf = - if leaf = ".." then path, "." - else dir, leaf - in - let dir = resolve t dir in - Switch.run ~name:"with_parent_dir" @@ fun sw -> - let dirfd = Low_level.openat ~sw ~mode:0 dir Low_level.Open_flags.(directory + rdonly + nofollow) in - fn (Some dirfd) leaf - ) else fn None path - - let v ~label ~sandbox dir_path = { dir_path; sandbox; label; closed = false } + let fd t = t.fd - (* Sandboxes use [O_NOFOLLOW] when opening files ([resolve] already removed any symlinks). - This avoids a race where symlink might be added after [realpath] returns. *) - let opt_nofollow t = - if t.sandbox then Low_level.Open_flags.nofollow else Low_level.Open_flags.empty + let v ~label ~path:dir_path fd = { fd; dir_path; label } let open_in t ~sw path = - let fd = Err.run (Low_level.openat ~mode:0 ~sw (resolve t path)) Low_level.Open_flags.(opt_nofollow t + rdonly) in + let fd = openat ~mode:0 ~sw t.fd path Low_level.Open_flags.rdonly in (Flow.of_fd fd :> Eio.File.ro_ty Eio.Resource.t) - let rec open_out t ~sw ~append ~create path = + let open_out t ~sw ~append ~create path = let mode, flags = match create with | `Never -> 0, Low_level.Open_flags.empty @@ -102,73 +68,47 @@ end = struct | `Exclusive perm -> perm, Low_level.Open_flags.(creat + excl) in let flags = if append then Low_level.Open_flags.(flags + append) else flags in - let flags = Low_level.Open_flags.(flags + rdwr + opt_nofollow t) in - match - with_parent_dir t path @@ fun dirfd path -> - Low_level.openat ?dirfd ~sw ~mode path flags - with + let flags = Low_level.Open_flags.(flags + rdwr) in + match Low_level.openat ~sw ~mode t.fd path flags with | fd -> (Flow.of_fd fd :> Eio.File.rw_ty r) - | exception Unix.Unix_error (ELOOP, _, _) -> - (* The leaf was a symlink (or we're unconfined and the main path changed, but ignore that). - A leaf symlink might be OK, but we need to check it's still in the sandbox. - todo: possibly we should limit the number of redirections here, like the kernel does. *) - let target = Unix.readlink path in - let full_target = - if Filename.is_relative target then - Filename.concat (Filename.dirname path) target - else target - in - open_out t ~sw ~append ~create full_target | exception Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg) let mkdir t ~perm path = - with_parent_dir t path @@ fun dirfd path -> - Err.run (Low_level.mkdir ?dirfd ~mode:perm) path + Err.run (Low_level.mkdir ~mode:perm t.fd) path let unlink t path = - with_parent_dir t path @@ fun dirfd path -> - Err.run (Low_level.unlink ?dirfd ~dir:false) path + Err.run (Low_level.unlink ~dir:false t.fd) path let rmdir t path = - with_parent_dir t path @@ fun dirfd path -> - Err.run (Low_level.unlink ?dirfd ~dir:true) path + Err.run (Low_level.unlink ~dir:true t.fd) path let stat t ~follow path = let buf = Low_level.create_stat () in - if follow then ( - Err.run (Low_level.fstatat ~buf ~follow:true) (resolve t path); - ) else ( - with_parent_dir t path @@ fun dirfd path -> - Err.run (Low_level.fstatat ~buf ?dirfd ~follow:false) path; - ); + Err.run (Low_level.fstatat ~buf ~follow t.fd) path; Flow.eio_of_stat buf let read_dir t path = - (* todo: need fdopendir here to avoid races *) - let path = resolve t path in - Err.run Low_level.readdir path + Err.run (Low_level.readdir t.fd) path |> Array.to_list let read_link t path = - with_parent_dir t path @@ fun dirfd path -> - Err.run (Low_level.read_link ?dirfd) path + Err.run (Low_level.read_link t.fd) path let rename t old_path new_dir new_path = - match Handler.as_posix_dir new_dir with + match as_posix_dir new_dir with | None -> invalid_arg "Target is not an eio_posix directory!" - | Some new_dir -> - with_parent_dir t old_path @@ fun old_dir old_path -> - with_parent_dir new_dir new_path @@ fun new_dir new_path -> - Err.run (Low_level.rename ?old_dir old_path ?new_dir) new_path - - let close t = t.closed <- true + | Some new_dir -> Err.run (Low_level.rename t.fd old_path new_dir) new_path let open_dir t ~sw path = - Switch.check sw; + let path = if path = "" then "." else path in + let flags = Low_level.Open_flags.(directory +? path) in + let fd = Low_level.openat ~sw ~mode:0 t.fd path flags in let label = Filename.basename path in - let d = v ~label (resolve t path) ~sandbox:true in - Switch.on_release sw (fun () -> close d); + let full_path = + if Filename.is_relative path then Filename.concat t.dir_path path else path + in + let d = v ~label ~path:full_path (Fd fd) in Eio.Resource.T (d, Handler.v) let pp f t = Fmt.string f (String.escaped t.label) @@ -190,24 +130,13 @@ end = struct end and Handler : sig val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler - - val as_posix_dir : [> `Dir] r -> Dir.t option end = struct - (* When renaming, we get a plain [Eio.Fs.dir]. We need extra access to check - that the new location is within its sandbox. *) - type (_, _, _) Eio.Resource.pi += Posix_dir : ('t, 't -> Dir.t, [> `Posix_dir]) Eio.Resource.pi - - let as_posix_dir (Eio.Resource.T (t, ops)) = - match Eio.Resource.get_opt ops Posix_dir with - | None -> None - | Some fn -> Some (fn t) - let v = Eio.Resource.handler [ H (Eio.Fs.Pi.Dir, (module Dir)); - H (Posix_dir, Fun.id); + H (Posix_dir, (fun t -> Dir.fd t)); ] end (* Full access to the filesystem. *) -let fs = Eio.Resource.T (Dir.v ~label:"fs" ~sandbox:false ".", Handler.v) -let cwd = Eio.Resource.T (Dir.v ~label:"cwd" ~sandbox:true ".", Handler.v) +let fs = Eio.Resource.T (Dir.v ~label:"fs" ~path:"." Fs, Handler.v) +let cwd = Eio.Resource.T (Dir.v ~label:"cwd" ~path:"." Cwd, Handler.v) diff --git a/lib_eio_posix/low_level.ml b/lib_eio_posix/low_level.ml index ec237d9ce..f4239c704 100644 --- a/lib_eio_posix/low_level.ml +++ b/lib_eio_posix/low_level.ml @@ -15,6 +15,11 @@ module Fd = Eio_unix.Fd module Trace = Eio.Private.Trace module Fiber_context = Eio.Private.Fiber_context +type dir_fd = + | Fd of Fd.t + | Cwd (* Confined to "." *) + | Fs (* Unconfined "."; also allows absolute paths *) + let in_worker_thread label = Eio_unix.run_in_systhread ~label let await_readable op fd = @@ -130,19 +135,6 @@ let read_entries h = in aux [] -let readdir path = - in_worker_thread "readdir" @@ fun () -> - let h = Unix.opendir path in - match read_entries h with - | r -> Unix.closedir h; r - | exception ex -> - let bt = Printexc.get_raw_backtrace () in - Unix.closedir h; Printexc.raise_with_backtrace ex bt - -let read_link ?dirfd path = - in_worker_thread "read_link" @@ fun () -> - Eio_unix.Private.read_link dirfd path - external eio_readv : Unix.file_descr -> Cstruct.t array -> int = "caml_eio_posix_readv" external eio_writev : Unix.file_descr -> Cstruct.t array -> int = "caml_eio_posix_writev" @@ -191,59 +183,214 @@ module Open_flags = struct let empty = 0 let ( + ) = ( lor ) + + let ( +? ) x = function + | None -> x + | Some y -> x + y end +let at_fdcwd : Unix.file_descr = Obj.magic Config.at_fdcwd + let rec with_dirfd op dirfd fn = match dirfd with - | None -> fn (Obj.magic Config.at_fdcwd : Unix.file_descr) + | None -> fn at_fdcwd | Some dirfd -> Fd.use_exn op dirfd fn | exception Unix.Unix_error(Unix.EINTR, _, "") -> with_dirfd op dirfd fn external eio_openat : Unix.file_descr -> string -> Open_flags.t -> int -> Unix.file_descr = "caml_eio_posix_openat" -let openat ?dirfd ~sw ~mode path flags = +let openat_raw ~sw ~mode dirfd path flags = with_dirfd "openat" dirfd @@ fun dirfd -> - Switch.check sw; - in_worker_thread "openat" (fun () -> eio_openat dirfd path Open_flags.(flags + cloexec + nonblock) mode) + eio_openat dirfd path Open_flags.(flags + cloexec + nonblock) mode |> Fd.of_unix ~sw ~blocking:false ~close_unix:true +module Resolve = struct + type dir_stack = + | Base of Fd.t option (* None if cwd *) + | Tmp of Fd.t * dir_stack + + type resolve_state = { + sw : Switch.t; (* Temporary switch for [dir_stack] *) + mutable path : Path.Rel.t; (* Components still to process *) + mutable dir_stack : dir_stack; (* Directories already opened, for ".." *) + mutable max_follows : int; + } + + let current_base state = + match state.dir_stack with + | Base b -> b + | Tmp (x, _) -> Some x + + let parse_rel s = + match Path.parse s with + | Relative r -> r + | Absolute _ -> raise @@ Eio.Fs.err (Eio.Fs.Permission_denied (Err.Absolute_path)) + + (* Fallback for systems without O_RESOLVE_BENEATH: *) + let rec resolve state = + let path = state.path in + (* traceln "Consider %a" Path.Rel.dump path; *) + match path with + | Leaf { basename; trailing_slash } -> if trailing_slash then basename ^ "/" else basename + | Self -> "." + | Parent xs -> + begin match state.dir_stack with + | Base _ -> raise @@ Eio.Fs.err (Permission_denied (Err.Outside_sandbox ("XXX", "XXX"))) + | Tmp (p, ps) -> + Fd.close p; + state.dir_stack <- ps; + state.path <- xs; + resolve state + end + | Child (x, xs) -> + state.path <- xs; + let base = current_base state in + match openat_raw ~sw:state.sw base x ~mode:0 Open_flags.(nofollow + directory) with + | new_base -> + state.dir_stack <- Tmp (new_base, state.dir_stack); + resolve state + | exception (Unix.Unix_error (Unix.ENOTDIR, _, _) as e) when state.max_follows > 0 -> + state.max_follows <- state.max_follows - 1; + match Eio_unix.Private.read_link base x with + | target -> + state.path <- Path.Rel.concat (parse_rel target) state.path; + resolve state + | exception Unix.Unix_error _ -> raise e + + let close_tmp state = + let rec aux = function + | Base _ -> () + | Tmp (x, xs) -> Fd.close x; aux xs + in + aux state.dir_stack + + let with_state ~sw base path fn = + let state = { sw; path; dir_stack = Base base; max_follows = 8 } in + match fn state with + | x -> close_tmp state; x + | exception ex -> + let bt = Printexc.get_raw_backtrace () in + close_tmp state; + Printexc.raise_with_backtrace ex bt + + let open_beneath_fallback ?dirfd:base ~sw ~mode path flags = + let path = parse_rel path in + with_state ~sw base path @@ fun state -> + let rec aux leaf = + let base = current_base state in + match openat_raw ~sw base leaf ~mode Open_flags.(flags + nofollow) with + | fd -> fd + | exception (Unix.Unix_error ((ELOOP | ENOTDIR), _, _) as e) + when state.max_follows > 0 -> + state.max_follows <- state.max_follows - 1; + match Eio_unix.Private.read_link base leaf with + | target -> + state.path <- parse_rel target; + aux (resolve state) + | exception Unix.Unix_error _ -> raise e + in + aux (resolve state) + + let with_parent ?dirfd:base ~sw path fn = + let path = parse_rel path in + with_state ~sw base path @@ fun state -> + let rec aux leaf = + let base = current_base state in + match fn base leaf with + | Ok x -> x + | Error `Symlink -> + state.max_follows <- state.max_follows - 1; + match Eio_unix.Private.read_link base leaf with + | target -> + state.path <- parse_rel target; + aux (resolve state) + in + aux (resolve state) +end + +let open_beneath_fallback = Resolve.open_beneath_fallback (* For tests *) + +let openat ?dirfd ~sw ~mode path flags = + Switch.check sw; + in_worker_thread "openat" (fun () -> openat_raw ~sw dirfd path flags ~mode) + +let open_beneath = + match Open_flags.resolve_beneath with + | None -> Resolve.open_beneath_fallback + | Some o_resolve_beneath -> + fun ?dirfd ~sw ~mode path flags -> + let path = if path = "" then "." else path in + openat ?dirfd ~sw ~mode path Open_flags.(flags + o_resolve_beneath) + +let openat ~sw ~mode fd path flags = + match fd with + | Fs -> openat ~sw ~mode path flags + | Cwd -> open_beneath ~sw ~mode ?dirfd:None path flags + | Fd dirfd -> open_beneath ~sw ~mode ~dirfd path flags + +(* Note: called in worker thread *) +let with_parent_worker ~sw fd path fn = (* todo: use o_resolve_beneath if available *) + match fd with + | Fs -> fn None path + | Cwd -> Resolve.with_parent ~sw path (fun x y -> Ok (fn x y)) + | Fd dirfd -> Resolve.with_parent ~sw ~dirfd path (fun x y -> Ok (fn x y)) + +let with_parent fd path fn = + Switch.run @@ fun sw -> + with_parent_worker ~sw fd path fn + +external eio_fdopendir : Unix.file_descr -> Unix.dir_handle = "caml_eio_posix_fdopendir" + +let readdir dirfd path = + Switch.run @@ fun sw -> + let fd = openat ~sw ~mode:0 dirfd path Open_flags.(directory + rdonly) in + match Fd.remove fd with + | None -> assert false + | Some fd -> + let h = eio_fdopendir fd in + in_worker_thread "readdir" @@ fun () -> + match read_entries h with + | r -> Unix.closedir h; r + | exception ex -> + let bt = Printexc.get_raw_backtrace () in + Unix.closedir h; Printexc.raise_with_backtrace ex bt + external eio_mkdirat : Unix.file_descr -> string -> Unix.file_perm -> unit = "caml_eio_posix_mkdirat" -let mkdir ?dirfd ~mode path = +let mkdir ~mode dirfd path = + with_parent dirfd path @@ fun dirfd path -> with_dirfd "mkdirat" dirfd @@ fun dirfd -> in_worker_thread "mkdir" @@ fun () -> eio_mkdirat dirfd path mode external eio_unlinkat : Unix.file_descr -> string -> bool -> unit = "caml_eio_posix_unlinkat" -let unlink ?dirfd ~dir path = +let unlink ~dir dirfd path = + with_parent dirfd path @@ fun dirfd path -> with_dirfd "unlink" dirfd @@ fun dirfd -> in_worker_thread "unlink" @@ fun () -> eio_unlinkat dirfd path dir external eio_renameat : Unix.file_descr -> string -> Unix.file_descr -> string -> unit = "caml_eio_posix_renameat" -let rename ?old_dir old_path ?new_dir new_path = +let rename old_dir old_path new_dir new_path = + with_parent old_dir old_path @@ fun old_dir old_path -> + with_parent new_dir new_path @@ fun 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 "rename" @@ fun () -> eio_renameat old_dir old_path new_dir new_path +let read_link dirfd path = + with_parent dirfd path @@ fun dirfd path -> + in_worker_thread "read_link" @@ fun () -> + Eio_unix.Private.read_link dirfd path + type stat external create_stat : unit -> stat = "caml_eio_posix_make_stat" external eio_fstatat : stat -> Unix.file_descr -> string -> int -> unit = "caml_eio_posix_fstatat" external eio_fstat : stat -> Unix.file_descr -> unit = "caml_eio_posix_fstat" -let fstat ~buf fd = - Fd.use_exn "fstat" fd @@ fun fd -> - eio_fstat buf fd - -let fstatat ~buf ?dirfd ~follow path = - in_worker_thread "fstat" @@ fun () -> - let flags = if follow then 0 else Config.at_symlink_nofollow in - with_dirfd "fstatat" dirfd @@ fun dirfd -> - eio_fstatat buf dirfd path flags - external blksize : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_blksize_bytes" "ocaml_eio_posix_stat_blksize_native" [@@noalloc] external nlink : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_nlink_bytes" "ocaml_eio_posix_stat_nlink_native" [@@noalloc] external uid : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_uid_bytes" "ocaml_eio_posix_stat_uid_native" [@@noalloc] @@ -264,6 +411,27 @@ external atime_nsec : stat -> int = "ocaml_eio_posix_stat_atime_nsec" [@@noalloc external ctime_nsec : stat -> int = "ocaml_eio_posix_stat_ctime_nsec" [@@noalloc] external mtime_nsec : stat -> int = "ocaml_eio_posix_stat_mtime_nsec" [@@noalloc] +let fstat ~buf fd = + Fd.use_exn "fstat" fd @@ fun fd -> + eio_fstat buf fd + +let fstatat_confined ~buf ~follow dirfd path = + Switch.run @@ fun sw -> + in_worker_thread "fstat" @@ fun () -> + Resolve.with_parent ~sw ?dirfd path @@ fun dirfd path -> + with_dirfd "fstatat" dirfd @@ fun dirfd -> + eio_fstatat buf dirfd path Config.at_symlink_nofollow; + if follow && kind buf = `Symbolic_link then Error `Symlink else Ok () + +let fstatat ~buf ~follow dirfd path = + match dirfd with + | Fs -> + in_worker_thread "fstat" @@ fun () -> + let flags = if follow then 0 else Config.at_symlink_nofollow in + eio_fstatat buf at_fdcwd path flags + | Cwd -> fstatat_confined ~buf ~follow None path + | Fd dirfd -> fstatat_confined ~buf ~follow (Some dirfd) path + let lseek fd off cmd = Fd.use_exn "lseek" fd @@ fun fd -> let cmd = @@ -330,14 +498,14 @@ module Process = struct (* Wait for [pid] to exit and then resolve [exit_status] to its status. *) let reap t exit_status = Eio.Condition.loop_no_mutex Eio_unix.Process.sigchld (fun () -> - Mutex.lock t.lock; - match Unix.waitpid [WNOHANG] t.pid with - | 0, _ -> Mutex.unlock t.lock; None (* Not ready; wait for next SIGCHLD *) - | p, status -> - assert (p = t.pid); - Promise.resolve exit_status status; - Mutex.unlock t.lock; - Some () + Mutex.lock t.lock; + match Unix.waitpid [WNOHANG] t.pid with + | 0, _ -> Mutex.unlock t.lock; None (* Not ready; wait for next SIGCHLD *) + | p, status -> + assert (p = t.pid); + Promise.resolve exit_status status; + Mutex.unlock t.lock; + Some () ) let spawn ~sw actions = diff --git a/lib_eio_posix/low_level.mli b/lib_eio_posix/low_level.mli index 11716e0f0..9bc3b149a 100644 --- a/lib_eio_posix/low_level.mli +++ b/lib_eio_posix/low_level.mli @@ -14,6 +14,11 @@ open Eio.Std type fd := Eio_unix.Fd.t +type dir_fd = + | Fd of fd (** Confined to [fd]. *) + | Cwd (** Confined to "." *) + | Fs (** Unconfined "."; also allows absolute paths *) + val await_readable : string -> fd -> unit val await_writable : string -> fd -> unit @@ -44,7 +49,7 @@ type stat val create_stat : unit -> stat val fstat : buf:stat -> fd -> unit -val fstatat : buf:stat -> ?dirfd:fd -> follow:bool -> string -> unit +val fstatat : buf:stat -> follow:bool -> dir_fd -> string -> unit external blksize : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_blksize_bytes" "ocaml_eio_posix_stat_blksize_native" [@@noalloc] external nlink : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_nlink_bytes" "ocaml_eio_posix_stat_nlink_native" [@@noalloc] @@ -67,13 +72,13 @@ external ctime_nsec : stat -> int = "ocaml_eio_posix_stat_ctime_nsec" [@@noalloc external mtime_nsec : stat -> int = "ocaml_eio_posix_stat_mtime_nsec" [@@noalloc] val realpath : string -> string -val read_link : ?dirfd:fd -> string -> string +val read_link : dir_fd -> string -> string -val mkdir : ?dirfd:fd -> mode:int -> string -> unit -val unlink : ?dirfd:fd -> dir:bool -> string -> unit -val rename : ?old_dir:fd -> string -> ?new_dir:fd -> string -> unit +val mkdir : mode:int -> dir_fd -> string -> unit +val unlink : dir:bool -> dir_fd -> string -> unit +val rename : dir_fd -> string -> dir_fd -> string -> unit -val readdir : string -> string array +val readdir : dir_fd -> string -> string array val readv : fd -> Cstruct.t array -> int val writev : fd -> Cstruct.t array -> int @@ -103,9 +108,10 @@ module Open_flags : sig val empty : t val ( + ) : t -> t -> t + val ( +? ) : t -> t option -> t (** Add if available *) end -val openat : ?dirfd:fd -> sw:Switch.t -> mode:int -> string -> Open_flags.t -> fd +val openat : sw:Switch.t -> mode:int -> dir_fd -> string -> Open_flags.t -> fd (** Note: the returned FD is always non-blocking and close-on-exec. *) module Process : sig @@ -134,3 +140,8 @@ module Process : sig val exit_status : t -> Unix.process_status Promise.t (** [exit_status t] is a promise for the process's exit status. *) end + +(**/**) +val open_beneath_fallback : ?dirfd:fd -> sw:Switch.t -> mode:int -> string -> Open_flags.t -> fd +(* Exposed for testing only. *) +(**/**) diff --git a/lib_eio_posix/net.ml b/lib_eio_posix/net.ml index 676c2b608..7f9d25fc2 100644 --- a/lib_eio_posix/net.ml +++ b/lib_eio_posix/net.ml @@ -109,7 +109,7 @@ let listen ~reuse_addr ~reuse_port ~backlog ~sw (listen_addr : Eio.Net.Sockaddr. | `Unix path -> if reuse_addr then ( let buf = Low_level.create_stat () in - match Low_level.fstatat ~buf ~follow:false path with + match Low_level.fstatat ~buf ~follow:false Fs path with | () -> if Low_level.kind buf = `Socket then Unix.unlink path | exception Unix.Unix_error (Unix.ENOENT, _, _) -> () | exception Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg diff --git a/lib_eio_posix/path.ml b/lib_eio_posix/path.ml new file mode 100644 index 000000000..dba608218 --- /dev/null +++ b/lib_eio_posix/path.ml @@ -0,0 +1,67 @@ +type token = + | Empty + | DotDot + | String of string + +let rec tokenise = function + | [] -> [] + | ["."] -> [Empty] (* "path/." is the same as "path/" *) + | "." :: xs -> tokenise xs (* Skip dot if not at end *) + | "" :: xs -> Empty :: tokenise xs + | ".." :: xs -> DotDot :: tokenise xs + | x :: xs -> String x :: tokenise xs + +module Rel = struct + type t = + | Leaf of { basename : string; trailing_slash : bool } + | Self (* A final "." *) + | Child of string * t + | Parent of t + + let rec parse = function + | [] -> Self + | [String basename; Empty] -> Leaf { basename; trailing_slash = true } + | [String basename] -> Leaf { basename; trailing_slash = false } + | [DotDot] -> Parent Self + | DotDot :: xs -> Parent (parse xs) + | String s :: xs -> Child (s, parse xs) + | Empty :: [] -> Self + | Empty :: xs -> parse xs + + let parse s = parse (tokenise s) + + let rec concat a b = + match a with + | Leaf { basename; trailing_slash = _ } -> Child (basename, b) + | Child (name, xs) -> Child (name, concat xs b) + | Parent xs -> Parent (concat xs b) + | Self -> b + + let rec dump f = function + | Child (x, xs) -> Fmt.pf f "%S / %a" x dump xs + | Parent xs -> Fmt.pf f ".. / %a" dump xs + | Self -> Fmt.pf f "." + | Leaf { basename; trailing_slash } -> + Fmt.pf f "%S" basename; + if trailing_slash then Fmt.pf f " /" +end + +type t = + | Relative of Rel.t + | Absolute of Rel.t + +let rec parse_abs = function + | "" :: [] -> Absolute Self + | "" :: xs -> parse_abs xs + | xs -> Absolute (Rel.parse xs) + +let parse = function + | "" -> Relative Self + | s -> + match String.split_on_char '/' s with + | "" :: path -> parse_abs path + | path -> Relative (Rel.parse path) + +let dump f = function + | Relative r -> Rel.dump f r + | Absolute r -> Fmt.pf f "/ %a" Rel.dump r diff --git a/lib_eio_posix/path.mli b/lib_eio_posix/path.mli new file mode 100644 index 000000000..741535551 --- /dev/null +++ b/lib_eio_posix/path.mli @@ -0,0 +1,22 @@ +module Rel : sig + type t = + | Leaf of { basename : string; trailing_slash : bool } + | Self (* A final "." *) + | Child of string * t + | Parent of t + + val concat : t -> t -> t + + val dump : t Fmt.t +end + +type t = + | Relative of Rel.t + | Absolute of Rel.t + +val parse : string -> t +(** Note: + [parse "" = Relative Self] + [parse ".." = Relative (Parent Self)] *) + +val dump : t Fmt.t diff --git a/lib_eio_posix/primitives.h b/lib_eio_posix/primitives.h index 9c929c5c5..5a954f78d 100644 --- a/lib_eio_posix/primitives.h +++ b/lib_eio_posix/primitives.h @@ -10,6 +10,7 @@ CAMLprim value caml_eio_posix_writev(value, value); CAMLprim value caml_eio_posix_preadv(value, value, value); CAMLprim value caml_eio_posix_pwritev(value, value, value); CAMLprim value caml_eio_posix_openat(value, value, value, value); +CAMLprim value caml_eio_posix_fdopendir(value); CAMLprim value caml_eio_posix_mkdirat(value, value, value); CAMLprim value caml_eio_posix_unlinkat(value, value, value); CAMLprim value caml_eio_posix_renameat(value, value, value, value); diff --git a/lib_eio_posix/process.ml b/lib_eio_posix/process.ml index c795b104c..8461bb5a1 100644 --- a/lib_eio_posix/process.ml +++ b/lib_eio_posix/process.ml @@ -31,12 +31,11 @@ module Impl = struct let with_actions cwd fn = match cwd with | None -> fn actions | Some ((dir, path) : Eio.Fs.dir_ty Eio.Path.t) -> - match Fs.Handler.as_posix_dir dir with + match Fs.as_posix_dir dir with | None -> Fmt.invalid_arg "cwd is not an OS directory!" - | Some posix -> - Fs.Dir.with_parent_dir posix path @@ fun dirfd s -> + | Some dirfd -> Switch.run ~name:"spawn_unix" @@ fun launch_sw -> - let cwd = Low_level.openat ?dirfd ~sw:launch_sw ~mode:0 s Low_level.Open_flags.(rdonly + directory) in + let cwd = Low_level.openat ~sw:launch_sw ~mode:0 dirfd path Low_level.Open_flags.(rdonly + directory) in fn (Low_level.Process.Fork_action.fchdir cwd :: actions) in with_actions cwd @@ fun actions -> diff --git a/lib_eio_posix/test/dune b/lib_eio_posix/test/dune index 2b12d5166..e6bf775b3 100644 --- a/lib_eio_posix/test/dune +++ b/lib_eio_posix/test/dune @@ -2,3 +2,9 @@ (package eio_posix) (enabled_if (= %{os_type} "Unix")) (deps (package eio_posix))) + +(test + (name open_beneath) + (package eio_posix) + (build_if (= %{os_type} "Unix")) + (libraries eio_posix)) diff --git a/lib_eio_posix/test/open_beneath.ml b/lib_eio_posix/test/open_beneath.ml new file mode 100644 index 000000000..c67fcdc27 --- /dev/null +++ b/lib_eio_posix/test/open_beneath.ml @@ -0,0 +1,81 @@ +open Eio.Std + +module L = Eio_posix.Low_level + +let check ~mode dirfd path flags = + Switch.run @@ fun sw -> + (* traceln "check %S" path; *) + let x = try Ok (L.openat ~sw ~mode (Fd dirfd) path flags) with Unix.Unix_error _ as e -> Error e in + let y = try Ok (L.open_beneath_fallback ~sw ~dirfd ~mode path flags) with Unix.Unix_error _ as e -> Error e in + match x, y with + | Ok x, Ok y -> + let inode fd = + let buf = L.create_stat () in + L.fstat fd ~buf; + (L.dev buf, L.ino buf) + in + let x_info = inode x in + let y_info = inode y in + if x_info <> y_info then + Fmt.failwith "Got a different inode opening %S!" path + | Error (Unix.Unix_error (x, _, _) as e1), + Error (Unix.Unix_error (y, _, _) as e2) -> + if x <> y then ( + Fmt.failwith "Different errors: %a vs %a" Fmt.exn e1 Fmt.exn e2 + ) + | Error _, Error _ -> assert false + | Error e, Ok _ -> Fmt.failwith "Only OS open failed: %a" Fmt.exn e + | Ok _, Error e -> Fmt.failwith "Only open_beneath failed: %a" Fmt.exn e + +let test base path = + check ~mode:0 base path L.Open_flags.rdonly; + if path <> "" then ( + check ~mode:0 base (path ^ "/") L.Open_flags.rdonly; + check ~mode:0 base (path ^ "/.") L.Open_flags.rdonly + ) + +let test_denied base path = + match L.Open_flags.resolve_beneath with + | Some some_resolve_beneath -> + (* Check our behaviour matches the OS's *) + check ~mode:0 base path L.Open_flags.(rdonly + some_resolve_beneath) + | None -> + (* traceln "check-reject %S" path; *) + (* OS doesn't support resolve_beneath. Just check we reject it. *) + Switch.run @@ fun sw -> + match L.open_beneath_fallback ~sw ~dirfd:base ~mode:0 path L.Open_flags.rdonly with + | (_fd : Eio_unix.Fd.t) -> Fmt.failwith "%S should have been rejected!" path + | exception Eio.Io (Eio.Fs.E Permission_denied _, _) -> () + +let () = + try + Eio_posix.run @@ fun _env -> + Unix.mkdir "test_beneath" 0o700; + Unix.mkdir "test_beneath/subdir" 0o700; + Unix.symlink "subdir" "test_beneath/link_subdir"; + Unix.symlink ".." "test_beneath/link_subdir/parent"; + Unix.symlink ".." "test_beneath/parent"; + Unix.symlink "loop2" "test_beneath/loop1"; + Unix.symlink "loop1" "test_beneath/loop2"; + Unix.symlink "file" "test_beneath/to-file"; + Unix.symlink "file/" "test_beneath/to-file-slash"; + Unix.symlink "subdir/" "test_beneath/to-dir-slash"; + Switch.run @@ fun sw -> + let test_dir = L.open_beneath_fallback ~sw "test_beneath" L.Open_flags.directory ~mode:0 in + let f = L.openat ~sw (Fd test_dir) "file" L.Open_flags.(creat + rdwr) ~mode:0o600 in + Eio_unix.Fd.close f; + test test_dir "file"; + test test_dir "subdir"; + test test_dir "link_subdir"; + test test_dir "link_subdir/parent"; + test_denied test_dir "link_subdir/parent/parent"; + test test_dir ""; + test test_dir "."; + test_denied test_dir ".."; + test test_dir "loop1"; + test test_dir "to-file"; + test test_dir "to-file-slash"; + test test_dir "to-dir-slash/file"; + with Failure msg -> + Fmt.epr "Tests failed: %s" msg; + exit 1 diff --git a/lib_eio_posix/test/path.md b/lib_eio_posix/test/path.md new file mode 100644 index 000000000..de7dc7326 --- /dev/null +++ b/lib_eio_posix/test/path.md @@ -0,0 +1,55 @@ +```ocaml +# #require "eio_posix" +``` +```ocaml +module P = Eio_posix__Path +``` + +```ocaml +# #install_printer P.dump;; + +# P.parse "foo" +- : P.t = "foo" + +# P.parse "foo/bar" +- : P.t = "foo" / "bar" + +# P.parse "foo//bar/" +- : P.t = "foo" / "bar" / + +# P.parse "foo/." +- : P.t = "foo" / + +# P.parse "foo/./" +- : P.t = "foo" / + +# P.parse "" +- : P.t = . + +# P.parse "." +- : P.t = . + +# P.parse ".." +- : P.t = .. / . + +# P.parse "./../.././.." +- : P.t = .. / .. / .. / . + +# P.parse "/" +- : P.t = / . + +# P.parse "/etc" +- : P.t = / "etc" + +# P.parse "/etc/passwd" +- : P.t = / "etc" / "passwd" + +# P.parse "/." +- : P.t = / . + +# P.parse "/.." +- : P.t = / .. / . + +# P.parse "//../" +- : P.t = / .. / . +``` diff --git a/lib_eio_posix/test/spawn.md b/lib_eio_posix/test/spawn.md index a6f678820..dc41a114b 100644 --- a/lib_eio_posix/test/spawn.md +++ b/lib_eio_posix/test/spawn.md @@ -46,7 +46,7 @@ Changing directory using a file descriptor: ```ocaml # Eio_posix.run @@ fun _env -> Switch.run @@ fun sw -> - let root = Eio_posix.Low_level.openat ~sw ~mode:0 "/" Eio_posix.Low_level.Open_flags.(rdonly + directory) in + let root = Eio_posix.Low_level.openat ~sw ~mode:0 Fs "/" Eio_posix.Low_level.Open_flags.(rdonly + directory) in let child = Process.spawn ~sw Process.Fork_action.[ fchdir root; execve "/usr/bin/env"