Add Eio.Path.read_link

lib_eio/fs.ml

@@ -69,6 +69,7 @@ module Pi = struct
     val unlink : t -> path -> unit
     val rmdir : t -> path -> unit
     val rename : t -> path -> _ dir -> path -> unit
+    val read_link : t -> path -> string
     val pp : t Fmt.t
     val native : t -> string -> string option
   end

lib_eio/path.ml

@@ -211,3 +211,11 @@ let rec mkdirs ?(exists_ok=false) ~perm t =
     );
   try mkdir ~perm t
   with Exn.Io (Fs.E Already_exists _, _) when exists_ok && is_directory t -> ()
+
+let read_link t =
+  let (Resource.T (dir, ops), path) = t in
+  let module X = (val (Resource.get ops Fs.Pi.Dir)) in
+  try X.read_link dir path
+  with Exn.Io _ as ex ->
+    let bt = Printexc.get_raw_backtrace () in
+    Exn.reraise_with_context ex bt "reading target of symlink %a" pp t

lib_eio/path.mli

@@ -178,6 +178,9 @@ val is_directory : _ t -> bool
 
     [is_directory t] is [kind ~follow:true t = `Directory]. *)
 
+val read_link : _ t -> string
+(** [read_link t] is the target of symlink [t]. *)
+
 (** {1 Other} *)
 
 val unlink : _ t -> unit

lib_eio/unix/eio_unix.mli

@@ -97,6 +97,8 @@ module Private : sig
   module Rcfd = Rcfd
 
   module Fork_action = Fork_action
+
+  val read_link : Fd.t option -> string -> string
 end
 
 module Pi = Pi

lib_eio/unix/private.ml

@@ -21,3 +21,18 @@ let run_in_systhread ?(label="systhread") fn =
   Eio.Private.Suspend.enter label @@ fun _ctx enqueue ->
   let _t : Thread.t = Thread.create (fun () -> enqueue (try Ok (fn ()) with exn -> Error exn)) () in
   ()
+
+external eio_readlinkat : Unix.file_descr -> string -> Cstruct.t -> int = "eio_unix_readlinkat"
+
+let read_link 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

lib_eio/unix/stubs.c

@@ -2,20 +2,53 @@
 
 #include <unistd.h>
 #include <fcntl.h>
+#include <errno.h>
 
 #include <caml/mlvalues.h>
 #include <caml/unixsupport.h>
+#include <caml/memory.h>
+#include <caml/bigarray.h>
+
+static void caml_stat_free_preserving_errno(void *ptr) {
+  int saved = errno;
+  caml_stat_free(ptr);
+  errno = saved;
+}
 
 CAMLprim value eio_unix_is_blocking(value v_fd) {
   #ifdef _WIN32
   // We should not call this function from Windows
-  uerror("Unsupported blocking check on Windows", Nothing);
+  caml_unix_error(EOPNOTSUPP, "Unsupported blocking check on Windows", Nothing);
   #else
   int fd = Int_val(v_fd);
   int r = fcntl(fd, F_GETFL, 0);
   if (r == -1)
-    uerror("fcntl", Nothing);
+    caml_uerror("fcntl", Nothing);
 
   return Val_bool((r & O_NONBLOCK) == 0);
   #endif
 }
+
+CAMLprim value eio_unix_readlinkat(value v_fd, value v_path, value v_cs) {
+  #ifdef _WIN32
+  caml_unix_error(EOPNOTSUPP, "readlinkat not supported on Windows", v_path);
+  #else
+  CAMLparam2(v_path, v_cs);
+  char *path;
+  value v_ba = Field(v_cs, 0);
+  value v_off = Field(v_cs, 1);
+  value v_len = Field(v_cs, 2);
+  char *buf = (char *)Caml_ba_data_val(v_ba) + Long_val(v_off); 
+  size_t buf_size = Long_val(v_len);
+  int fd = Int_val(v_fd);
+  int ret;
+  caml_unix_check_path(v_path, "readlinkat");
+  path = caml_stat_strdup(String_val(v_path));
+  caml_enter_blocking_section();
+  ret = readlinkat(fd, path, buf, buf_size);
+  caml_leave_blocking_section();
+  caml_stat_free_preserving_errno(path);
+  if (ret == -1) caml_uerror("readlinkat", v_path);
+  CAMLreturn(Val_int(ret));
+  #endif
+}

lib_eio_linux/eio_linux.ml

@@ -539,6 +539,8 @@ end = struct
     let fd = Low_level.open_dir ~sw t.fd (if path = "" then "." else path) in
     Low_level.read_dir fd
 
+  let read_link t path = Low_level.read_link t.fd path
+
   let close t =
     match t.fd with
     | FD x -> Fd.close x

lib_eio_linux/low_level.ml

@@ -481,6 +481,12 @@ let read_dir fd =
   in
   Eio_unix.run_in_systhread ~label:"read_dir" (fun () -> read_all [] fd)
 
+let read_link fd path =
+  try
+    with_parent_dir_fd fd path @@ fun parent leaf ->
+    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
+
 (* 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; _ } =

lib_eio_posix/fs.ml

@@ -150,6 +150,10 @@ end = struct
     Err.run Low_level.readdir 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
+
   let rename t old_path new_dir new_path =
     match Handler.as_posix_dir new_dir with
     | None -> invalid_arg "Target is not an eio_posix directory!"

lib_eio_posix/low_level.ml

@@ -140,6 +140,10 @@ let readdir path =
     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"
 

lib_eio_posix/low_level.mli

@@ -67,6 +67,7 @@ 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 mkdir : ?dirfd:fd -> mode:int -> string -> unit
 val unlink : ?dirfd:fd -> dir:bool -> string -> unit

lib_eio_windows/fs.ml

@@ -160,6 +160,10 @@ end = struct
     Err.run Low_level.readdir 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
+
   let rename t old_path new_dir new_path =
     match Handler.as_posix_dir new_dir with
     | None -> invalid_arg "Target is not an eio_windows directory!"

lib_eio_windows/low_level.ml

@@ -135,6 +135,10 @@ let readdir path =
     let bt = Printexc.get_raw_backtrace () in
     Unix.closedir h; Printexc.raise_with_backtrace ex bt
 
+let read_link ?dirfd path =
+  in_worker_thread @@ fun () ->
+  Eio_unix.Private.read_link dirfd path
+
 external eio_readv : Unix.file_descr -> Cstruct.t array -> int = "caml_eio_windows_readv"
 
 external eio_preadv : Unix.file_descr -> Cstruct.t array -> Optint.Int63.t -> int = "caml_eio_windows_preadv"

lib_eio_windows/low_level.mli

@@ -42,6 +42,7 @@ val fstat : fd -> Unix.LargeFile.stats
 val lstat : string -> Unix.LargeFile.stats
 
 val realpath : string -> string
+val read_link : ?dirfd:fd -> string -> string
 
 val mkdir : ?dirfd:fd -> ?nofollow:bool -> mode:int -> string -> unit
 val unlink : ?dirfd:fd -> dir:bool -> string -> unit

tests/fs.md

@@ -53,6 +53,11 @@ let try_read_dir path =
   | names -> traceln "read_dir %a -> %a" Path.pp path Fmt.Dump.(list string) names
   | exception ex -> traceln "@[<h>%a@]" Eio.Exn.pp ex
 
+let try_read_link path =
+  match Path.read_link path with
+  | target -> traceln "read_link %a -> %S" Path.pp path target
+  | exception ex -> traceln "@[<h>%a@]" Eio.Exn.pp ex
+
 let try_unlink path =
   match Path.unlink path with
   | () -> traceln "unlink %a -> ok" Path.pp path
@@ -751,6 +756,27 @@ Unconfined:
 - : unit = ()
 ```
 
+# read_link
+
+```ocaml
+# run ~clear:["file"; "symlink"] @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
+  let cwd = Eio.Stdenv.cwd env in
+  Switch.run @@ fun sw ->
+  Unix.symlink "file" "symlink";
+  try_read_link (cwd / "symlink");
+  try_read_link (fs / "symlink");
+  try_write_file (cwd / "file") "data" ~create:(`Exclusive 0o600);
+  try_read_link (cwd / "file");
+  try_read_link (cwd / "../unknown");
++read_link <cwd:symlink> -> "file"
++read_link <fs:symlink> -> "file"
++write <cwd:file> -> ok
++Eio.Io _, reading target of symlink <cwd:file>
++Eio.Io Fs Permission_denied _, reading target of symlink <cwd:../unknown>
+- : unit = ()
+```
+
 # pread/pwrite
 
 Check reading and writing vectors at arbitrary offsets: