Expose uv_pipe_bind2 and UV_PIPE_NO_TRUNCATE

src/c/luv_c_function_descriptions.ml

@@ -32,12 +32,19 @@ struct
         (ptr Types.Loop.t @-> Types.Loop.Run_mode.t @-> returning bool)
   end
 
-  (* See https://github.com/ocsigen/lwt/issues/230. *)
+  (* bind is potentially a blocking call, because the filesystem may block the
+     calling process indefinitely when creating a file for Unix domain socket or
+     similar. *)
   module Pipe =
   struct
     let bind =
       foreign "uv_pipe_bind"
         (ptr Types.Pipe.t @-> string @-> returning error_code)
+
+    let bind2 =
+      foreign "uv_pipe_bind2"
+        (ptr Types.Pipe.t @-> string @-> size_t @-> int @->
+          returning error_code)
   end
 
   (* Synchronous (callback = NULL) calls to these functions are blocking, so we

src/c/luv_c_type_descriptions.ml

@@ -564,6 +564,8 @@ struct
 
     let t : ([ `Pipe ] Stream.t) typ = typedef (structure "`Pipe") "uv_pipe_t"
     let () = seal t
+
+    let no_truncate = constant "UV_PIPE_NO_TRUNCATE" int
   end
 
   module TTY =

src/c/shims.h

@@ -724,4 +724,12 @@
     {
         return ENOSYS;
     }
+
+    #define UV_PIPE_NO_TRUNCATE 0
+
+    static int uv_pipe_bind2(
+        uv_pipe_t *pipe, const char *name, size_t namelen, unsigned int flags)
+    {
+        return ENOSYS;
+    }
 #endif

src/feature/detect_features.ml

@@ -276,6 +276,7 @@ let () =
   needs 25 "os_uname" "See {!Luv.System_info.uname}.";
   needs 21 "overlapped_pipe" "See {!Luv.Process.to_parent_pipe}.";
   needs 41 "pipe" "See {!Luv.Pipe.pipe}";
+  needs 46 "pipe_bind2" "See {!Luv.Pipe.bind}.";
   needs 16 "pipe_chmod" "See {!Luv.Pipe.chmod}.";
   needs 14 "prioritized" "See [`PRIORITIZED] in {!Luv.Poll.Event.t}.";
   needs 24 "process_windows_hide_console" "See {!Luv.Process.spawn}.";

src/pipe.ml

@@ -39,8 +39,19 @@ let open_ pipe file =
   C.Functions.Pipe.open_ pipe (File.to_int file)
   |> Error.to_result ()
 
-let bind pipe name =
-  C.Blocking.Pipe.bind pipe name
+let bind ?(no_truncate = false) pipe name =
+  let use_bind2 =
+    match name.[0] with
+    | '\x00' -> true
+    | _ | exception Invalid_argument _ -> no_truncate
+  in
+  begin if use_bind2 then
+    let length = String.length name |> Unsigned.Size_t.of_int in
+    let no_truncate = if no_truncate then C.Types.Pipe.no_truncate else 0 in
+    C.Blocking.Pipe.bind2 pipe name length no_truncate
+  else
+    C.Blocking.Pipe.bind pipe name
+  end
   |> Error.to_result ()
 
 let connect pipe name_or_path callback =

src/pipe.mli

@@ -57,12 +57,20 @@ val pipe :
 
     {{!Luv.Require} Feature check}: [Luv.Require.(has pipe)] *)
 
-val bind : t -> string -> (unit, Error.t) result
+val bind : ?no_truncate:bool -> t -> string -> (unit, Error.t) result
 (** Assigns a pipe a name or an address.
 
-    Binds {{:http://docs.libuv.org/en/v1.x/pipe.html#c.uv_pipe_bind}
-    [uv_pipe_bind]}. See {{:http://man7.org/linux/man-pages/man3/bind.3p.html}
-    [bind(3p)]}. *)
+    Binds {{:http://docs.libuv.org/en/v1.x/pipe.html#c.uv_pipe_bind2}
+    [uv_pipe_bind2]}. See {{:http://man7.org/linux/man-pages/man3/bind.3p.html}
+    [bind(3p)]}.
+
+    [?no_truncate] binds [UV_PIPE_NO_TRUNCATE], which causes this function to
+    return [EINVAL] rather than truncating the path, if the path is too long.
+
+    [?no_truncate] and Linux abstract namespace sockets require Luv 0.5.13 and
+    libuv 1.46.0.
+
+    {{!Luv.Require} Feature check}: [Luv.Require.(has pipe_bind2)] *)
 
 val connect : t -> string -> ((unit, Error.t) result -> unit) -> unit
 (** Connects to the pipe at the given name or address.