diff --git a/src/unix/config/discover.ml b/src/unix/config/discover.ml index 2a9f1a904e..bb36a2f99f 100644 --- a/src/unix/config/discover.ml +++ b/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 + #include + + int main() + { + accept4(0, NULL, 0, 0); + return 0; + } + |} + } end diff --git a/src/unix/dune b/src/unix/dune index 15308961b6..5b9d4106ba 100644 --- a/src/unix/dune +++ b/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)) diff --git a/src/unix/lwt_unix.cppo.ml b/src/unix/lwt_unix.cppo.ml index 4845317a34..5e41473633 100644 --- a/src/unix/lwt_unix.cppo.ml +++ b/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 <> [] -> diff --git a/src/unix/unix_c/unix_accept4.c b/src/unix/unix_c/unix_accept4.c new file mode 100644 index 0000000000..d582f24741 --- /dev/null +++ b/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 +#include +#include +#include + +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