eio_posix: use directory FDs instead of realpath

realpath was an old hack from the libuv days.

lib_eio/unix/eio_unix.mli

@@ -103,6 +103,7 @@ module Private : sig
   module Thread_pool = Thread_pool
 
   val read_link : Fd.t option -> string -> string
+  val read_link_unix : Unix.file_descr option -> string -> string
 end
 
 module Pi = Pi

lib_eio/unix/fd.ml

@@ -87,6 +87,11 @@ let rec use_exn_list op xs k =
     use_exn_list op xs @@ fun xs ->
     k (x :: xs)
 
+let use_exn_opt op x f =
+  match x with
+  | None -> f None
+  | Some x -> use_exn op x (fun x -> f (Some x))
+
 let stdin = of_unix_no_hook Unix.stdin
 let stdout = of_unix_no_hook Unix.stdout
 let stderr= of_unix_no_hook Unix.stderr

lib_eio/unix/fd.mli

@@ -35,6 +35,9 @@ val use_exn : string -> t -> (Unix.file_descr -> 'a) -> 'a
 val use_exn_list : string -> t list -> (Unix.file_descr list -> 'a) -> 'a
 (** [use_exn_list op fds fn] calls {!use_exn} on each FD in [fds], calling [fn wrapped_fds] on the results. *)
 
+val use_exn_opt : string -> t option -> (Unix.file_descr option -> 'a) -> 'a
+(** [use_exn_opt op fd fn] is like {!use_exn}, but if [fd = None] then it just calls [fn None]. *)
+
 (** {2 Closing} *)
 
 val close : t -> unit

lib_eio/unix/private.ml

@@ -20,15 +20,16 @@ module Thread_pool = Thread_pool
 
 external eio_readlinkat : Unix.file_descr -> string -> Cstruct.t -> int = "eio_unix_readlinkat"
 
-let read_link fd path =
+let read_link_unix fd path =
   match fd with
   | None -> Unix.readlink path
   | Some fd ->
-    Fd.use_exn "readlink" fd @@ fun fd ->
     let rec aux size =
       let buf = Cstruct.create_unsafe size in
       let len = eio_readlinkat fd path buf in
       if len < size then Cstruct.to_string ~len buf
       else aux (size * 4)
     in
     aux 1024
+
+let read_link fd path = Fd.use_exn_opt "readlink" fd (fun fd -> read_link_unix fd path)

lib_eio_posix/eio_posix_stubs.c

@@ -17,6 +17,7 @@
 #include <fcntl.h>
 #include <string.h>
 #include <stdlib.h>
+#include <dirent.h>
 
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
@@ -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;
+}

lib_eio_posix/err.ml

@@ -1,13 +1,13 @@
 type Eio.Exn.Backend.t +=
-  | Outside_sandbox of string * string
+  | Outside_sandbox of string
   | Absolute_path
   | Invalid_leaf of string
 
 let unclassified_error e = Eio.Exn.create (Eio.Exn.X e)
 
 let () =
   Eio.Exn.Backend.register_pp (fun f -> function
-      | Outside_sandbox (path, dir) -> Fmt.pf f "Outside_sandbox (%S, %S)" path dir; true
+      | Outside_sandbox path -> Fmt.pf f "Outside_sandbox (%S)" path; true
       | Absolute_path -> Fmt.pf f "Absolute_path"; true
       | Invalid_leaf x -> Fmt.pf f "Invalid_leaf %S" x; true
       | _ -> false

lib_eio_posix/fs.ml

@@ -16,84 +16,44 @@
 
 (* 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
 
+(* 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 = Err.run (Low_level.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 +62,44 @@ 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 flags = Low_level.Open_flags.(rdonly + directory +? path) in
+    let fd = Err.run (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 +121,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, Dir.fd);
     ]
 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)