Merge pull request #603 from talex5/native-path

Add Eio.Path.native

Author: talex5

lib_eio/fs.ml

@@ -9,6 +9,7 @@ type error =
   | Not_found of Exn.Backend.t
   | Permission_denied of Exn.Backend.t
   | File_too_large
+  | Not_native of string          (** Raised by {!Path.native_exn}. *)
 
 type Exn.err += E of error
 
@@ -24,6 +25,7 @@ let () =
           | Not_found e -> Fmt.pf f "Not_found %a" Exn.Backend.pp e
           | Permission_denied e -> Fmt.pf f "Permission_denied %a" Exn.Backend.pp e
           | File_too_large -> Fmt.pf f "File_too_large"
+          | Not_native m -> Fmt.pf f "Not_native %S" m
         end;
         true
       | _ -> false
@@ -62,6 +64,7 @@ module Pi = struct
     val rmdir : t -> path -> unit
     val rename : t -> path -> _ dir -> path -> unit
     val pp : t Fmt.t
+    val native : t -> string -> string option
   end
 
   type (_, _, _) Resource.pi +=

lib_eio/path.ml

@@ -12,6 +12,15 @@ let pp f (Resource.T (t, ops), p) =
   if p = "" then Fmt.pf f "<%a>" X.pp t
   else Fmt.pf f "<%a:%s>" X.pp t (String.escaped p)
 
+let native (Resource.T (t, ops), p) =
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  X.native t p
+
+let native_exn t =
+  match native t with
+  | Some p -> p
+  | None -> raise (Fs.err (Not_native (Fmt.str "%a" pp t)))
+
 let open_in ~sw t =
   let (Resource.T (dir, ops), path) = t in
   let module X = (val (Resource.get ops Fs.Pi.Dir)) in

lib_eio/path.mli

@@ -23,6 +23,9 @@
     {[
       Eio.Path.load (fs / "/etc/passwd")
     ]}
+
+    In Eio, the directory separator is always "/", even on Windows.
+    Use {!native} to convert to a native path.
 *)
 
 open Std
@@ -41,6 +44,23 @@ val ( / ) : 'a t -> string -> 'a t
 val pp : _ t Fmt.t
 (** [pp] formats a [_ t] as "<label:path>", suitable for logging. *)
 
+val native : _ t -> string option
+(** [native t] returns a path that can be used to refer to [t] with the host
+    platform's native string-based file-system APIs, if available.
+    This is intended for interoperability with non-Eio libraries.
+
+    This does not check for confinement (the resulting path might not be accessible
+    via [t] itself). Also, if a directory was opened with {!open_dir} and later
+    renamed, this might use the old name.
+
+    Using strings as paths is not secure if components in the path can be
+    replaced by symlinks while the path is being used. For example, if you
+    try to write to "/home/mal/output.txt" just as mal replaces "output.txt"
+    with a symlink to "/etc/passwd". *)
+
+val native_exn : _ t -> string
+(** Like {!native}, but raise a suitable exception if the path is not a native path. *)
+
 (** {1 Reading files} *)
 
 val load : _ t -> string

lib_eio_linux/eio_linux.ml

@@ -424,7 +424,7 @@ end
 module rec Dir : sig
   include Eio.Fs.Pi.DIR
 
-  val v : label:string -> Low_level.dir_fd -> t
+  val v : label:string -> path:string -> Low_level.dir_fd -> t
 
   val close : t -> unit
 
@@ -433,9 +433,10 @@ end = struct
   type t = {
     fd : Low_level.dir_fd;
     label : string;
+    path : string;
   }
 
-  let v ~label fd = { fd; label }
+  let v ~label ~path fd = { fd; label; path }
 
   let open_in t ~sw path =
     let fd = Low_level.openat ~sw t.fd path
@@ -461,14 +462,23 @@ end = struct
     in
     (flow fd :> Eio.File.rw_ty r)
 
+  let native_internal t path =
+    if Filename.is_relative path then (
+      let p = Filename.concat t.path path in
+      if p = "" then "."
+      else if p = "." then p
+      else if Filename.is_implicit p then "./" ^ p
+      else p
+    ) else path
+
   let open_dir t ~sw path =
     let fd = Low_level.openat ~sw ~seekable:false t.fd (if path = "" then "." else path)
         ~access:`R
         ~flags:Uring.Open_flags.(cloexec + path + directory)
         ~perm:0
     in
     let label = Filename.basename path in
-    let d = v ~label (Low_level.FD fd) in
+    let d = v ~label ~path:(native_internal t path) (Low_level.FD fd) in
     Eio.Resource.T (d, Dir_handler.v)
 
   let mkdir t ~perm path = Low_level.mkdir_beneath ~perm t.fd path
@@ -494,6 +504,9 @@ end = struct
   let pp f t = Fmt.string f (String.escaped t.label)
 
   let fd t = t.fd
+
+  let native t path =
+    Some (native_internal t path)
 end
 and Dir_handler : sig
   val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler
@@ -505,7 +518,7 @@ end = struct
     ]
 end
 
-let dir ~label fd = Eio.Resource.T (Dir.v ~label fd, Dir_handler.v)
+let dir ~label ~path fd = Eio.Resource.T (Dir.v ~label ~path fd, Dir_handler.v)
 
 module Secure_random = struct
   type t = unit
@@ -521,8 +534,8 @@ let stdenv ~run_event_loop =
   let stdin = source Eio_unix.Fd.stdin in
   let stdout = sink Eio_unix.Fd.stdout in
   let stderr = sink Eio_unix.Fd.stderr in
-  let fs = (dir ~label:"fs" Fs, "") in
-  let cwd = (dir ~label:"cwd" Cwd, "") in
+  let fs = (dir ~label:"fs" ~path:"" Fs, "") in
+  let cwd = (dir ~label:"cwd" ~path:"" Cwd, "") in
   object (_ : stdenv)
     method stdin  = stdin
     method stdout = stdout

lib_eio_posix/fs.ml

@@ -161,6 +161,21 @@ end = struct
     Eio.Resource.T (d, Handler.v)
 
   let pp f t = Fmt.string f (String.escaped t.label)
+
+  let native_internal t path =
+    if Filename.is_relative path then (
+      let p =
+        if t.dir_path = "." then path
+        else Filename.concat t.dir_path path
+      in
+      if p = "" then "."
+      else if p = "." then p
+      else if Filename.is_implicit p then "./" ^ p
+      else p
+    ) else path
+
+  let native t path =
+    Some (native_internal t path)
 end
 and Handler : sig
   val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler

lib_eio_windows/fs.ml

@@ -169,6 +169,9 @@ end = struct
     Eio.Resource.T (d, Handler.v)
 
   let pp f t = Fmt.string f (String.escaped t.label)
+
+  let native _t _path =
+    failwith "TODO: Windows native"
 end
 and Handler : sig
   val v : (Dir.t, [`Dir | `Close]) Eio.Resource.handler

tests/fs.md

@@ -588,3 +588,48 @@ Ensure reads can be cancelled promptly, even if there is no need to wait:
      (fun () -> failwith "Simulated error");;
 Exception: Failure "Simulated error".
 ```
+
+# Native paths
+
+```ocaml
+# Eio_main.run @@ fun env ->
+  let cwd = Sys.getcwd () ^ "/" in
+  let test x =
+    let native = Eio.Path.native x in
+    let result =
+      native |> Option.map @@ fun native ->
+      if String.starts_with ~prefix:cwd native then
+        "./" ^ String.sub native (String.length cwd) (String.length native - String.length cwd)
+      else native
+    in
+    traceln "%a -> %a" Eio.Path.pp x Fmt.(Dump.option string) result
+  in
+  test env#fs;
+  test (env#fs / "/");
+  test (env#fs / "/etc/hosts");
+  test (env#fs / ".");
+  test (env#fs / "foo/bar");
+  test env#cwd;
+  test (env#cwd / "..");
+  let sub = env#cwd / "native-sub" in
+  Eio.Path.mkdir sub ~perm:0o700;
+  Eio.Path.with_open_dir sub @@ fun sub ->
+  test sub;
+  test (sub / "foo.txt");
+  test (sub / ".");
+  test (sub / "..");
+  test (sub / "/etc/passwd");
++<fs> -> Some .
++<fs:/> -> Some /
++<fs:/etc/hosts> -> Some /etc/hosts
++<fs:.> -> Some .
++<fs:foo/bar> -> Some ./foo/bar
++<cwd> -> Some .
++<cwd:..> -> Some ./..
++<native-sub> -> Some ./native-sub/
++<native-sub:foo.txt> -> Some ./native-sub/foo.txt
++<native-sub:.> -> Some ./native-sub/.
++<native-sub:..> -> Some ./native-sub/..
++<native-sub:/etc/passwd> -> Some /etc/passwd
+- : unit = ()
+```