Merge pull request #618 from talex5/fstatat

Add Eio_posix.Low_level.fstatat

lib_eio_posix/eio_posix_stubs.c

@@ -24,13 +24,16 @@
 #include <caml/unixsupport.h>
 #include <caml/bigarray.h>
 #include <caml/socketaddr.h>
+#include <caml/custom.h>
 
 #include "fork_action.h"
 
 #ifdef ARCH_SIXTYFOUR
 #define Int63_val(v) Long_val(v)
+#define caml_copy_int63(v) Val_long(v)
 #else
 #define Int63_val(v) (Int64_val(v)) >> 1
+#define caml_copy_int63(v) caml_copy_int64(v << 1)
 #endif
 
 static void caml_stat_free_preserving_errno(void *ptr) {
@@ -163,6 +166,167 @@ CAMLprim value caml_eio_posix_mkdirat(value v_fd, value v_path, value v_perm) {
   CAMLreturn(Val_unit);
 }
 
+#define Stat_val(v) (*((struct stat **) Data_custom_val(v)))
+
+static void finalize_stat(value v) {
+  caml_stat_free(Stat_val(v));
+  Stat_val(v) = NULL;
+}
+
+static struct custom_operations stat_ops = {
+  "eio_posix.stat",
+  finalize_stat,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default,
+  custom_compare_ext_default,
+  custom_fixed_length_default
+};
+
+value
+caml_eio_posix_make_stat(value v_unit) {
+  CAMLparam0();
+  CAMLlocal1(v);
+  struct stat *data;
+  v = caml_alloc_custom_mem(&stat_ops, sizeof(struct stat *), sizeof(struct stat));
+  Stat_val(v) = NULL;
+  data = (struct stat *) caml_stat_alloc(sizeof(struct stat));
+  Stat_val(v) = data;
+  CAMLreturn(v);
+}
+
+static value get_file_type_variant(struct stat *sb) {
+  int filetype = sb->st_mode & S_IFMT;
+  switch (filetype) {
+    case S_IFREG:
+      return caml_hash_variant("Regular_file");
+    case S_IFSOCK:
+      return caml_hash_variant("Socket");
+    case S_IFLNK:
+      return caml_hash_variant("Symbolic_link");
+    case S_IFBLK:
+      return caml_hash_variant("Block_device");
+    case S_IFDIR:
+      return caml_hash_variant("Directory");
+    case S_IFCHR:
+      return caml_hash_variant("Character_special");
+    case S_IFIFO:
+      return caml_hash_variant("Fifo");
+    default:
+      return caml_hash_variant("Unknown");
+  }
+}
+
+CAMLprim value caml_eio_posix_fstatat(value v_stat, value v_fd, value v_path, value v_flags) {
+  CAMLparam2(v_stat, v_path);
+  char *path;
+  int ret;
+  struct stat *statbuf = Stat_val(v_stat);
+  bzero(statbuf, sizeof(struct stat));
+  caml_unix_check_path(v_path, "fstatat");
+  path = caml_stat_strdup(String_val(v_path));
+  caml_enter_blocking_section();
+  ret = fstatat(Int_val(v_fd), path, statbuf, Int_val(v_flags));
+  caml_leave_blocking_section();
+  caml_stat_free_preserving_errno(path);
+  if (ret == -1) uerror("fstatat", v_path);
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value caml_eio_posix_fstat(value v_stat, value v_fd) {
+  CAMLparam1(v_stat);
+  int ret;
+  struct stat *statbuf = Stat_val(v_stat);
+  bzero(statbuf, sizeof(struct stat));
+  caml_enter_blocking_section();
+  ret = fstat(Int_val(v_fd), statbuf);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("fstat", Nothing);
+  CAMLreturn(Val_unit);
+}
+
+// Non-allocating (for native mode) accessors for struct stat
+#define STAT_GETTER(field, return_type, ocaml_value_maker) \
+return_type ocaml_eio_posix_stat_##field##_native(value v_stat) { \
+  struct stat *s = Stat_val(v_stat); \
+  return s->st_##field; \
+} \
+value ocaml_eio_posix_stat_ ## field ## _bytes(value v_stat) { \
+  return ocaml_value_maker(ocaml_eio_posix_stat_##field##_native(v_stat)); \
+}
+
+STAT_GETTER(blksize, int64_t, caml_copy_int64)
+STAT_GETTER(nlink, int64_t, caml_copy_int64)
+STAT_GETTER(uid, int64_t, caml_copy_int64)
+STAT_GETTER(gid, int64_t, caml_copy_int64)
+STAT_GETTER(ino, int64_t, caml_copy_int64)
+STAT_GETTER(size, int64_t, caml_copy_int64)
+STAT_GETTER(blocks, int64_t, caml_copy_int64)
+STAT_GETTER(mode, intnat, Val_int)
+
+#define STAT_TIME_GETTER(name,field) \
+int64_t ocaml_eio_posix_stat_##name##_sec_native(value v_stat) { \
+  struct stat *s = Stat_val(v_stat); \
+  return s->st_##field.tv_sec; \
+} \
+value ocaml_eio_posix_stat_##name##_sec_bytes(value v_stat) { \
+  return caml_copy_int64(ocaml_eio_posix_stat_##name##_sec_native(v_stat)); \
+} \
+value ocaml_eio_posix_stat_##name##_nsec(value v_stat) { \
+  struct stat *s = Stat_val(v_stat); \
+  return Val_int(s->st_##field.tv_nsec); \
+}
+
+#ifdef __APPLE__
+STAT_TIME_GETTER(atime,atimespec)
+STAT_TIME_GETTER(ctime,ctimespec)
+STAT_TIME_GETTER(mtime,mtimespec)
+#else
+STAT_TIME_GETTER(atime,atim)
+STAT_TIME_GETTER(ctime,ctim)
+STAT_TIME_GETTER(mtime,mtim)
+#endif
+
+intnat
+ocaml_eio_posix_stat_perm_native(value v_stat) {
+  struct stat *s = Stat_val(v_stat);
+  return (s->st_mode & ~S_IFMT);
+}
+
+value
+ocaml_eio_posix_stat_perm_bytes(value v_stat) {
+  return Val_int(ocaml_eio_posix_stat_perm_native(v_stat));
+}
+
+value
+ocaml_eio_posix_stat_kind(value v_stat) {
+  struct stat *s = Stat_val(v_stat);
+  return get_file_type_variant(s);
+}
+
+int64_t
+ocaml_eio_posix_stat_rdev_native(value v_stat) {
+  struct stat *s = Stat_val(v_stat);
+  return s->st_rdev;
+}
+
+value
+ocaml_eio_posix_stat_rdev_bytes(value v_stat) {
+  return caml_copy_int64(ocaml_eio_posix_stat_rdev_native(v_stat));
+}
+
+int64_t
+ocaml_eio_posix_stat_dev_native(value v_stat) {
+  struct stat *s = Stat_val(v_stat);
+  return s->st_dev;
+}
+
+value
+ocaml_eio_posix_stat_dev_bytes(value v_stat) {
+  return caml_copy_int64(ocaml_eio_posix_stat_dev_native(v_stat));
+}
+
 CAMLprim value caml_eio_posix_unlinkat(value v_fd, value v_path, value v_dir) {
   CAMLparam1(v_path);
   char *path;

lib_eio_posix/flow.ml

@@ -7,32 +7,32 @@ module Impl = struct
 
   type t = Eio_unix.Fd.t
 
+  let float_of_time s ns =
+    let s = Int64.to_float s in
+    let f = s +. (float ns /. 1e9) in
+    (* It's possible that we might round up to the next second.
+       Since some algorithms only care about the seconds part,
+       make sure the integer part is always [s]: *)
+    if floor f = s then f
+    else Float.pred f
+
   let stat t =
     try
-      let ust = Low_level.fstat t in
+      let x = Low_level.create_stat () in
-      let st_kind : Eio.File.Stat.kind =
+      Low_level.fstat ~buf:x t;
-        match ust.st_kind with
+      { Eio.File.Stat.
-        | Unix.S_REG  -> `Regular_file
+        dev    = Low_level.dev x;
-        | Unix.S_DIR  -> `Directory
+        ino    = Low_level.ino x;
-        | Unix.S_CHR  -> `Character_special
+        kind   = Low_level.kind x;
-        | Unix.S_BLK  -> `Block_device
+        perm   = Low_level.perm x;
-        | Unix.S_LNK  -> `Symbolic_link
+        nlink  = Low_level.nlink x;
-        | Unix.S_FIFO -> `Fifo
+        uid    = Low_level.uid x;
-        | Unix.S_SOCK -> `Socket
+        gid    = Low_level.gid x;
-      in
+        rdev   = Low_level.rdev x;
-      Eio.File.Stat.{
+        size   = Low_level.size x |> Optint.Int63.of_int64;
-        dev     = ust.st_dev   |> Int64.of_int;
+        atime  = float_of_time (Low_level.atime_sec x) (Low_level.atime_nsec x);
-        ino     = ust.st_ino   |> Int64.of_int;
+        mtime  = float_of_time (Low_level.mtime_sec x) (Low_level.mtime_nsec x);
-        kind    = st_kind;
+        ctime  = float_of_time (Low_level.ctime_sec x) (Low_level.ctime_nsec x);
-        perm    = ust.st_perm;
-        nlink   = ust.st_nlink |> Int64.of_int;
-        uid     = ust.st_uid   |> Int64.of_int;
-        gid     = ust.st_gid   |> Int64.of_int;
-        rdev    = ust.st_rdev  |> Int64.of_int;
-        size    = ust.st_size  |> Optint.Int63.of_int64;
-        atime   = ust.st_atime;
-        mtime   = ust.st_mtime;
-        ctime   = ust.st_ctime;
       }
     with Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg
 

lib_eio_posix/include/discover.ml

@@ -40,6 +40,7 @@ let () =
             "O_TRUNC", Int;
 
             "AT_FDCWD", Int;
+            "AT_SYMLINK_NOFOLLOW", Int;
           ])
         |> List.map (function
             | name, C.C_define.Value.Int v when List.mem name optional_flags ->

lib_eio_posix/low_level.ml

@@ -113,13 +113,6 @@ let getrandom { Cstruct.buffer; off; len } =
   in_worker_thread @@ fun () ->
   loop 0
 
-let fstat fd =
-  Fd.use_exn "fstat" fd Unix.LargeFile.fstat
-
-let lstat path =
-  in_worker_thread @@ fun () ->
-  Unix.LargeFile.lstat path
-
 let realpath path =
   in_worker_thread @@ fun () ->
   Unix.realpath path
@@ -228,6 +221,41 @@ let rename ?old_dir old_path ?new_dir new_path =
   in_worker_thread @@ fun () ->
   eio_renameat old_dir old_path new_dir new_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 @@ 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]
+external gid     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_gid_bytes" "ocaml_eio_posix_stat_gid_native" [@@noalloc]
+external ino     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_ino_bytes" "ocaml_eio_posix_stat_ino_native" [@@noalloc]
+external size    : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_size_bytes" "ocaml_eio_posix_stat_size_native" [@@noalloc]
+external rdev    : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_rdev_bytes" "ocaml_eio_posix_stat_rdev_native" [@@noalloc]
+external dev     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_dev_bytes" "ocaml_eio_posix_stat_dev_native" [@@noalloc]
+external perm    : stat -> (int [@untagged]) = "ocaml_eio_posix_stat_perm_bytes" "ocaml_eio_posix_stat_perm_native" [@@noalloc]
+external mode    : stat -> (int [@untagged]) = "ocaml_eio_posix_stat_mode_bytes" "ocaml_eio_posix_stat_mode_native" [@@noalloc]
+external kind    : stat -> Eio.File.Stat.kind = "ocaml_eio_posix_stat_kind"
+
+external atime_sec : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_atime_sec_bytes" "ocaml_eio_posix_stat_atime_sec_native" [@@noalloc]
+external ctime_sec : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_ctime_sec_bytes" "ocaml_eio_posix_stat_ctime_sec_native" [@@noalloc]
+external mtime_sec : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_mtime_sec_bytes" "ocaml_eio_posix_stat_mtime_sec_native" [@@noalloc]
+
+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 pipe ~sw =
   let unix_r, unix_w = Unix.pipe ~cloexec:true () in
   let r = Fd.of_unix ~sw ~blocking:false ~close_unix:true unix_r in

lib_eio_posix/low_level.mli

@@ -35,8 +35,32 @@ val send_msg : fd -> ?fds:fd list -> ?dst:Unix.sockaddr -> Cstruct.t array -> in
 
 val getrandom : Cstruct.t -> unit
 
-val fstat : fd -> Unix.LargeFile.stats
+type stat
-val lstat : string -> Unix.LargeFile.stats
+
+val create_stat : unit -> stat
+
+val fstat : buf:stat -> fd -> unit
+val fstatat : buf:stat -> ?dirfd:fd -> follow:bool -> 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]
+external uid     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_uid_bytes" "ocaml_eio_posix_stat_uid_native" [@@noalloc]
+external gid     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_gid_bytes" "ocaml_eio_posix_stat_gid_native" [@@noalloc]
+external ino     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_ino_bytes" "ocaml_eio_posix_stat_ino_native" [@@noalloc]
+external size    : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_size_bytes" "ocaml_eio_posix_stat_size_native" [@@noalloc]
+external rdev    : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_rdev_bytes" "ocaml_eio_posix_stat_rdev_native" [@@noalloc]
+external dev     : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_dev_bytes" "ocaml_eio_posix_stat_dev_native" [@@noalloc]
+external perm    : stat -> (int [@untagged]) = "ocaml_eio_posix_stat_perm_bytes" "ocaml_eio_posix_stat_perm_native" [@@noalloc]
+external mode    : stat -> (int [@untagged]) = "ocaml_eio_posix_stat_mode_bytes" "ocaml_eio_posix_stat_mode_native" [@@noalloc]
+external kind    : stat -> Eio.File.Stat.kind = "ocaml_eio_posix_stat_kind"
+
+external atime_sec : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_atime_sec_bytes" "ocaml_eio_posix_stat_atime_sec_native" [@@noalloc]
+external ctime_sec : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_ctime_sec_bytes" "ocaml_eio_posix_stat_ctime_sec_native" [@@noalloc]
+external mtime_sec : stat -> (int64 [@unboxed]) = "ocaml_eio_posix_stat_mtime_sec_bytes" "ocaml_eio_posix_stat_mtime_sec_native" [@@noalloc]
+
+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]
 
 val realpath : string -> string
 

lib_eio_posix/net.ml

@@ -104,9 +104,9 @@ let listen ~reuse_addr ~reuse_port ~backlog ~sw (listen_addr : Eio.Net.Sockaddr.
     match listen_addr with
     | `Unix path         ->
       if reuse_addr then (
-        match Low_level.lstat path with
+        let buf = Low_level.create_stat () in
-        | Unix.{ st_kind = S_SOCK; _ } -> Unix.unlink path
+        match Low_level.fstatat ~buf ~follow:false 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
       );

lib_eio_posix/primitives.h

@@ -13,4 +13,37 @@ CAMLprim value caml_eio_posix_openat(value, value, value, 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);
+CAMLprim value caml_eio_posix_make_stat(value);
+CAMLprim value caml_eio_posix_fstatat(value, value, value, value);
+CAMLprim value caml_eio_posix_fstat(value, value);
+CAMLprim int64_t ocaml_eio_posix_stat_blksize_native(value);
+CAMLprim value ocaml_eio_posix_stat_blksize_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_nlink_native(value);
+CAMLprim value ocaml_eio_posix_stat_nlink_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_uid_native(value);
+CAMLprim value ocaml_eio_posix_stat_uid_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_gid_native(value);
+CAMLprim value ocaml_eio_posix_stat_gid_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_ino_native(value);
+CAMLprim value ocaml_eio_posix_stat_ino_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_size_native(value);
+CAMLprim value ocaml_eio_posix_stat_size_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_rdev_native(value);
+CAMLprim value ocaml_eio_posix_stat_rdev_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_dev_native(value);
+CAMLprim value ocaml_eio_posix_stat_dev_bytes(value);
+CAMLprim intnat ocaml_eio_posix_stat_perm_native(value);
+CAMLprim value ocaml_eio_posix_stat_perm_bytes(value);
+CAMLprim intnat ocaml_eio_posix_stat_mode_native(value);
+CAMLprim value ocaml_eio_posix_stat_mode_bytes(value);
+CAMLprim value ocaml_eio_posix_stat_kind(value);
+CAMLprim int64_t ocaml_eio_posix_stat_atime_sec_native(value);
+CAMLprim value ocaml_eio_posix_stat_atime_sec_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_ctime_sec_native(value);
+CAMLprim value ocaml_eio_posix_stat_ctime_sec_bytes(value);
+CAMLprim int64_t ocaml_eio_posix_stat_mtime_sec_native(value);
+CAMLprim value ocaml_eio_posix_stat_mtime_sec_bytes(value);
+CAMLprim value ocaml_eio_posix_stat_atime_nsec(value);
+CAMLprim value ocaml_eio_posix_stat_ctime_nsec(value);
+CAMLprim value ocaml_eio_posix_stat_mtime_nsec(value);
 CAMLprim value caml_eio_posix_spawn(value, value);