Ajout de Unix.async_socket (a tester)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2303 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 35 insertions, 15 deletions

diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c
index 10b0f7b1a..b55693ffa 100644
--- a/otherlibs/win32unix/accept.c
+++ b/otherlibs/win32unix/accept.c
@@ -23,17 +23,25 @@ value unix_accept(sock)          /* ML */
   SOCKET sconn = (SOCKET) Handle_val(sock);
   SOCKET snew;
   value fd = Val_unit, adr = Val_unit, res;
-  int optionValue;
-
-  /* Set sockets to synchronous mode  */
-  optionValue = SO_SYNCHRONOUS_NONALERT;
-  setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
-             (char *)&optionValue, sizeof(optionValue));
+  int oldvalue, newvalue, retcode;
 
+  retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+                       (char *) &oldvalue, sizeof(oldvalue));
+  if (retcode == 0) {
+    /* Set sockets to synchronous mode  */
+    newvalue = SO_SYNCHRONOUS_NONALERT;
+    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
+               (char *) &newvalue, sizeof(newvalue));
+  }
   sock_addr_len = sizeof(sock_addr);
   enter_blocking_section();
   snew = accept(sconn, &sock_addr.s_gen, &sock_addr_len);
   leave_blocking_section();
+  if (retcode == 0) {
+    /* Restore initial mode */
+    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
+               (char *) &oldvalue, sizeof(oldvalue));
+  }
   if (snew == INVALID_SOCKET)
     unix_error(WSAGetLastError(), "accept", Nothing);
   Begin_roots2 (fd, adr)
diff --git a/otherlibs/win32unix/socket.c b/otherlibs/win32unix/socket.c
index cdcd34a6d..c543bcf88 100644
--- a/otherlibs/win32unix/socket.c
+++ b/otherlibs/win32unix/socket.c
@@ -24,20 +24,28 @@ int socket_type_table[] = {
   SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET
 };
 
-value unix_socket(domain, type, proto) /* ML */
+value unix_socket(domain, type, proto, synchronous) /* ML */
      value domain, type, proto;
 {
   SOCKET s;
-  int optionValue;
-
-  /* Set sockets to synchronous mode  */
-  optionValue = SO_SYNCHRONOUS_NONALERT;
-  setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
-             (char *)&optionValue, sizeof(optionValue));
+  int oldvalue, newvalue, retcode;
 
+  retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
+                       (char *) &oldvalue, sizeof(oldvalue));
+  if (retcode == 0) {
+    /* Set sockets to synchronous or asnychronous mode, as requested */
+    newvalue = Bool_val(synchronous) ? SO_SYNCHRONOUS_NONALERT : 0;
+    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
+               (char *) &newvalue, sizeof(newvalue));
+  }
   s = socket(socket_domain_table[Int_val(domain)],
                    socket_type_table[Int_val(type)],
                    Int_val(proto));
+  if (retcode == 0) {
+    /* Restore initial mode */
+    setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, 
+               (char *) &oldvalue, sizeof(oldvalue));
+  }
   if (s == INVALID_SOCKET) unix_error(WSAGetLastError(), "socket", Nothing);
   return win_alloc_handle((HANDLE) s);
 }
diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml
index 17eecb0d8..188d95d89 100644
--- a/otherlibs/win32unix/unix.ml
+++ b/otherlibs/win32unix/unix.ml
@@ -476,8 +476,12 @@ type socket_option =
   | SO_DONTROUTE
   | SO_OOBINLINE
 
-external socket : socket_domain -> socket_type -> int -> file_descr
-                                  = "unix_socket"
+external socket_internal :
+  socket_domain -> socket_type -> int -> bool -> file_descr
+  = "unix_socket"
+
+let socket dom typ proto = socket_internal dom typ proto true
+let async_socket dom typ proto = socket_internal dom typ proto false
 let socketpair dom ty proto = invalid_arg "Unix.socketpair not implemented"
 external accept : file_descr -> file_descr * sockaddr = "unix_accept"
 external bind : file_descr -> sockaddr -> unit = "unix_bind"