Restore conversions between libuv and Unix fds

The conversions were originally removed in
705ec14. This commit restores them, but
puts them into a separate opam package luv_unix. The conversions can be
accessed as, for example, Luv_unix.Os_fd.Fd.from_unix. The main package
Luv also provides "neater" paths Luv.Unix.Os_fd.Fd.from_unix through a
module alias.

Resolves #90.

In the future, luv_unix needs a constraint to require the next release
of Luv (probably 0.5.7). The module also needs to be linked from the API
docs.

luv_unix.opam

@@ -0,0 +1,25 @@
+opam-version: "2.0"
+
+synopsis: "Helpers for interfacing Luv and Unix"
+
+version: "0.5.0"
+license: "MIT"
+homepage: "https://github.com/aantron/luv"
+doc: "https://aantron.github.io/luv"
+bug-reports: "https://github.com/aantron/luv/issues"
+
+authors: "Anton Bachin <[email protected]>"
+maintainer: "Anton Bachin <[email protected]>"
+dev-repo: "git+https://github.com/aantron/luv.git"
+
+depends: [
+  "base-unix"
+  "dune" {>= "2.0.0"}
+  "luv"
+  "ocaml" {>= "4.02.0"}
+  "result"
+]
+
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+]

src/c/helpers.c

@@ -650,3 +650,19 @@ int luv_spawn(
 
     return result;
 }
+
+int luv_is_invalid_handle_value(uv_os_fd_t handle)
+{
+    if (handle == -1)
+        return 1;
+    else
+        return 0;
+}
+
+int luv_is_invalid_socket_value(uv_os_sock_t socket)
+{
+    if (socket == -1)
+        return 1;
+    else
+        return 0;
+}

src/c/helpers.h

@@ -211,6 +211,15 @@ int luv_spawn(
     int uid,
     int gid);
 
+// File descriptor validity checks. These are used only by Luv.Unix. However,
+// because they are exposed in OCaml through Ctypes, it is convenient to have
+// them here. They don't introduce a dependency on Unix. THe rest of the file
+// descriptor C helpers, which do depend on Unix, are defined in Luv.Unix's own
+// C helper file. Conveniently, they are, and must be, exposed in OCaml through
+// the built-in FFI.
+int luv_is_invalid_handle_value(uv_os_fd_t handle);
+int luv_is_invalid_socket_value(uv_os_sock_t socket);
+
 
 
 #endif // #ifndef LUV_HELPERS_H_

src/c/luv_c_function_descriptions.ml

@@ -1363,6 +1363,14 @@ struct
     let open_osfhandle =
       foreign "uv_open_osfhandle"
         (Types.Os_fd.t @-> returning int)
+
+    let is_invalid_handle_value =
+      foreign "luv_is_invalid_handle_value"
+        (Types.Os_fd.t @-> returning bool)
+
+    let is_invalid_socket_value =
+      foreign "luv_is_invalid_socket_value"
+        (Types.Os_socket.t @-> returning bool)
   end
 
   module Bigstring =

src/dune

@@ -4,4 +4,5 @@
  (libraries luv.c result)
  (flags (:standard -w -49 -open Result)))
 
-(documentation)
+(documentation
+ (package luv))

src/luv.ml

@@ -64,3 +64,4 @@ module Env = Env
 module Time = Time
 module Random = Random
 module Metrics = Metrics
+module Unix = Luv_unix

src/unix/dune

@@ -0,0 +1,4 @@
+(library
+ (public_name luv_unix)
+ (libraries luv luv.c unix)
+ (foreign_stubs (language c) (names luv_unix)))

src/unix/luv_unix.c

@@ -0,0 +1,63 @@
+// This file is part of Luv, released under the MIT license. See LICENSE.md for
+// details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md.
+
+
+
+#include <caml/mlvalues.h>
+#include <uv.h>
+
+
+
+CAMLprim value luv_unix_fd_to_os_fd(value unix_fd, value os_fd_storage)
+{
+    uv_os_fd_t *os_fd = (uv_os_fd_t*)Nativeint_val(os_fd_storage);
+
+#ifndef _WIN32
+    *os_fd = Int_val(unix_fd);
+#else
+    if (Descr_kind_val(unix_fd) == KIND_HANDLE)
+        *os_fd = Handle_val(unix_fd);
+    else
+        *os_fd = -1;
+#endif
+
+    return Val_unit;
+}
+
+CAMLprim value luv_unix_fd_to_os_socket(value unix_fd, value os_socket_storage)
+{
+    uv_os_sock_t *os_socket = (uv_os_sock_t*)Nativeint_val(os_socket_storage);
+
+#ifndef _WIN32
+    *os_socket = Int_val(unix_fd);
+#else
+    if (Descr_kind_val(unix_fd) == KIND_SOCKET)
+        *os_socket = Handle_val(unix_fd);
+    else
+        *os_socket = -1;
+#endif
+
+    return Val_unit;
+}
+
+CAMLprim value luv_os_fd_to_unix_fd(value os_fd_storage)
+{
+    uv_os_fd_t *os_fd = (uv_os_fd_t*)Nativeint_val(os_fd_storage);
+
+#ifndef _WIN32
+    return Val_int(*os_fd);
+#else
+    return win_alloc_handle(*os_fd);
+#endif
+}
+
+CAMLprim value luv_os_socket_to_unix_fd(value os_socket_storage)
+{
+    uv_os_sock_t *os_socket = (uv_os_sock_t*)Nativeint_val(os_socket_storage);
+
+#ifndef _WIN32
+    return Val_int(*os_socket);
+#else
+    return win_alloc_socket(*os_socket);
+#endif
+}

src/unix/luv_unix.ml

@@ -0,0 +1,56 @@
+(* This file is part of Luv, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *)
+
+
+
+module C = Luv__C
+module Error = Luv.Error
+
+module Os_fd =
+struct
+  module Fd =
+  struct
+    include Luv.Os_fd.Fd
+
+    external from_unix_helper : Unix.file_descr -> nativeint -> unit =
+      "luv_unix_fd_to_os_fd"
+
+    let from_unix unix_fd =
+      let os_fd = Ctypes.make C.Types.Os_fd.t in
+      let storage = Ctypes.(raw_address_of_ptr (to_voidp (addr os_fd))) in
+      from_unix_helper unix_fd storage;
+      if C.Functions.Os_fd.is_invalid_handle_value os_fd then
+        Result.Error `EBADF
+      else
+        Result.Ok os_fd
+
+    external to_unix_helper : nativeint -> Unix.file_descr =
+      "luv_os_fd_to_unix_fd"
+
+    let to_unix os_fd =
+      to_unix_helper (Ctypes.(raw_address_of_ptr (to_voidp (addr os_fd))))
+  end
+
+  module Socket =
+  struct
+    include Luv.Os_fd.Socket
+
+    external from_unix_helper : Unix.file_descr -> nativeint -> unit =
+      "luv_unix_fd_to_os_socket"
+
+    let from_unix unix_fd =
+      let os_socket = Ctypes.make C.Types.Os_socket.t in
+      let storage = Ctypes.(raw_address_of_ptr (to_voidp (addr os_socket))) in
+      from_unix_helper unix_fd storage;
+      if C.Functions.Os_fd.is_invalid_socket_value os_socket then
+        Result.Error `EBADF
+      else
+        Result.Ok os_socket
+
+    external to_unix_helper : nativeint -> Unix.file_descr =
+      "luv_os_socket_to_unix_fd"
+
+    let to_unix os_socket =
+      to_unix_helper (Ctypes.(raw_address_of_ptr (to_voidp (addr os_socket))))
+  end
+end

src/unix/luv_unix.mli

@@ -0,0 +1,41 @@
+(* This file is part of Luv, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *)
+
+
+
+module Error = Luv.Error
+
+module Os_fd :
+sig
+  module Fd :
+  sig
+    include module type of Luv.Os_fd.Fd
+
+    val from_unix : Unix.file_descr -> (t, Error.t) result
+    (** Attempts to convert from a
+        {{:https://caml.inria.fr/pub/docs/manual-ocaml/libref/Unix.html#TYPEfile_descr}
+        [Unix.file_descr]} to a libuv [uv_os_fd_t]. Fails on Windows if the
+        descriptor is a [SOCKET] rather than a [HANDLE]. *)
+
+    val to_unix : t -> Unix.file_descr
+    (** Converts a [uv_os_fd_t] to a
+        {{:https://caml.inria.fr/pub/docs/manual-ocaml/libref/Unix.html#TYPEfile_descr}
+        [Unix.file_descr]}. *)
+  end
+
+  module Socket :
+  sig
+    include module type of Luv.Os_fd.Socket
+
+    val from_unix : Unix.file_descr -> (t, Error.t) result
+    (** Attempts to convert from a
+        {{:https://caml.inria.fr/pub/docs/manual-ocaml/libref/Unix.html#TYPEfile_descr}
+        [Unix.file_descr]} to a libuv [uv_os_sock_t]. Fails on Windows if the
+        descriptor is a [HANDLE] rather than a [SOCKET]. *)
+
+    val to_unix : t -> Unix.file_descr
+    (** Converts a [uv_os_sock_t] to a
+        {{:https://caml.inria.fr/pub/docs/manual-ocaml/libref/Unix.html#TYPEfile_descr}
+        [Unix.file_descr]}. *)
+  end
+end

test/dune

@@ -1,6 +1,6 @@
 (executable
  (name tester)
- (libraries alcotest luv threads))
+ (libraries alcotest luv luv_unix threads))
 
 (rule
  (alias runtest)

test/pipe.ml

@@ -53,10 +53,13 @@ let with_server_and_client ?for_handle_passing () ~server_logic ~client_logic =
 
   Alcotest.(check bool) "file deleted" false (Sys.file_exists filename)
 
-(* Until https://github.com/libuv/libuv/pull/1498. This implementation will not
-   work on Windows. One can be provided, but hopefully the PR lands first. *)
-let unix_fd_to_file : Unix.file_descr -> Luv.File.t =
-  Obj.magic
+(* Until https://github.com/libuv/libuv/pull/1498. Should be out in 1.41.0. *)
+let unix_fd_to_file unix_fd =
+  unix_fd
+  |> Luv.Unix.Os_fd.Fd.from_unix
+  |> check_success_result "from_unix"
+  |> Luv.File.open_osfhandle
+  |> check_success_result "get_osfhandle"
 
 let tests = [
   "pipe", [