Reduce the number of system calls for accept

src/unix/config/discover.ml

@@ -808,6 +808,24 @@ struct
         }
       |}
   }
+
+  let () = feature {
+    pretty_name = "accept4";
+    macro_name = "HAVE_ACCEPT4";
+    detect = fun context ->
+      skip_if_windows context @@ fun () ->
+      compiles context {|
+        #define _GNU_SOURCE
+        #include <sys/socket.h>
+        #include <stddef.h>
+
+        int main()
+        {
+            accept4(0, NULL, 0, 0);
+            return 0;
+        }
+      |}
+  }
 end
 
 

src/unix/dune

@@ -154,6 +154,7 @@
   unix_unlink_job
   unix_somaxconn
   windows_somaxconn
+  unix_accept4
  )
  (install_c_headers lwt_features lwt_config lwt_unix)
  (c_flags -I. (:include unix_c_flags.sexp))

src/unix/lwt_unix.cppo.ml

@@ -1643,8 +1643,20 @@ let socketpair dom typ proto =
   let (s1, s2) = do_socketpair dom typ proto in
   (mk_ch ~blocking:false s1, mk_ch ~blocking:false s2)
 
+external accept4 :
+  close_on_exec:bool -> nonblock:bool -> Unix.file_descr ->
+    Unix.file_descr * Unix.sockaddr = "lwt_unix_accept4"
+
+let accept_and_set_nonblock ch_fd =
+  if Lwt_config._HAVE_ACCEPT4 then
+    let (fd, addr) = accept4 ~close_on_exec:false ~nonblock:true ch_fd in
+    (mk_ch ~blocking:false ~set_flags:false fd, addr)
+  else
+    let (fd, addr) = Unix.accept ch_fd in
+    (mk_ch ~blocking:false fd, addr)
+
 let accept ch =
-  wrap_syscall Read ch (fun _ -> let (fd, addr) = Unix.accept ch.fd in (mk_ch ~blocking:false fd, addr))
+  wrap_syscall Read ch (fun _ -> accept_and_set_nonblock ch.fd)
 
 let accept_n ch n =
   let l = ref [] in
@@ -1656,8 +1668,7 @@ let accept_n ch n =
            try
              for _i = 1 to n do
                if blocking && not (unix_readable ch.fd) then raise Retry;
-               let fd, addr = Unix.accept ch.fd in
-               l := (mk_ch ~blocking:false fd, addr) :: !l
+               l := accept_and_set_nonblock ch.fd :: !l
              done
            with
            | (Unix.Unix_error((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) | Retry) when !l <> [] ->

src/unix/unix_c/unix_accept4.c

@@ -0,0 +1,45 @@
+/* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. */
+
+
+
+#include "lwt_config.h"
+
+#ifdef HAVE_ACCEPT4
+
+#define _GNU_SOURCE
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/unixsupport.h>
+#include <caml/socketaddr.h>
+
+CAMLprim value lwt_unix_accept4(value vcloexec, value vnonblock, value vsock)
+{
+    CAMLparam3(vcloexec, vnonblock, vsock);
+    CAMLlocal2(vaddr, res);
+
+    union sock_addr_union addr;
+    socklen_param_type addr_len;
+    int cloexec = Int_val(vcloexec) ? SOCK_CLOEXEC : 0;
+    int nonblock = Int_val(vnonblock) ? SOCK_NONBLOCK : 0;
+    addr_len = sizeof(addr);
+
+    int fd =
+        accept4(Int_val(vsock), &addr.s_gen, &addr_len, cloexec | nonblock);
+    if (fd == -1)
+        uerror("accept", Nothing);
+
+    vaddr = alloc_sockaddr(&addr, addr_len, fd);
+    res = caml_alloc_small(2, 0);
+    Field(res, 0) = Val_int(fd);
+    Field(res, 1) = vaddr;
+
+    CAMLreturn(res);
+}
+
+#else
+
+#include "lwt_unix.h"
+LWT_NOT_AVAILABLE3(unix_accept4)
+
+#endif