1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #include <caml/mlvalues.h>
17 #include <caml/alloc.h>
18 #include <caml/memory.h>
19 #include <caml/signals.h>
20 #include "unixsupport.h"
21 #include "socketaddr.h"
22
unix_accept(value cloexec,value sock)23 CAMLprim value unix_accept(value cloexec, value sock)
24 {
25 SOCKET sconn = Socket_val(sock);
26 SOCKET snew;
27 value fd = Val_unit, adr = Val_unit, res;
28 union sock_addr_union addr;
29 socklen_param_type addr_len;
30 DWORD err = 0;
31
32 addr_len = sizeof(sock_addr);
33 caml_enter_blocking_section();
34 snew = accept(sconn, &addr.s_gen, &addr_len);
35 if (snew == INVALID_SOCKET) err = WSAGetLastError ();
36 caml_leave_blocking_section();
37 if (snew == INVALID_SOCKET) {
38 win32_maperr(err);
39 uerror("accept", Nothing);
40 }
41 /* This is a best effort, not guaranteed to work, so don't fail on error */
42 SetHandleInformation((HANDLE) snew,
43 HANDLE_FLAG_INHERIT,
44 unix_cloexec_p(cloexec) ? 0 : HANDLE_FLAG_INHERIT);
45 Begin_roots2 (fd, adr)
46 fd = win_alloc_socket(snew);
47 adr = alloc_sockaddr(&addr, addr_len, snew);
48 res = caml_alloc_small(2, 0);
49 Field(res, 0) = fd;
50 Field(res, 1) = adr;
51 End_roots();
52 return res;
53 }
54