win32unix: use WSADuplicateSocket in bindings of dup and dup2

The WinAPI documentation of [DuplicateHandle][] gives a list of types
of objects on which it is safe to call DuplicateHandle. In particular,
the doc reads:

> You should not use DuplicateHandle to duplicate handles to the
> following objects:
>
> - Sockets. No error is returned, but the duplicate handle may not be
>   recognized by Winsock at the target process. Also, using
>   DuplicateHandle interferes with internal reference counting on the
>   underlying object. To duplicate a socket handle, use the
>   WSADuplicateSocket function.

Rework the code to use DuplicateHandle for handles and
[WSADuplicateSocket][] for sockets.

WSADuplicateSocket returns an info structure that we give to WSASocket
to create the duplicated handle. However, there seem to be no way of
explicitely preserving the set of flags to give to WSASocket.
Considering that as of now, OCaml uses the socket function instead of
WSASocket, and that socket only sets WSA_FLAG_OVERLAPPED, re-set that
flag and hope for the best (that's also the current behavior of
libuv).

This commit also fixes a little bug. In the error path of
DuplicateHandle there was:

    win32_maperr(GetLastError());
    return -1;

but the function returns a value, and from the OCaml code above it's
better to raise an exception instead.

[DuplicateHandle]: https://docs.microsoft.com/en-us/windows/win32/api/handleapi/nf-handleapi-duplicatehandle
[WSADuplicateSocket]: https://docs.microsoft.com/en-us/windows/win32/api/winsock2/nf-winsock2-wsaduplicatesocketw

Changes

@@ -86,6 +86,10 @@ Working version
   Thread.default_uncaught_exception_handler.
   (Enguerrand Decorne, review by David Allsopp)
 
+- #10697: Bindings of dup and dup2 in win32unix now call
+  WSADuplicateSocket on sockets instead of DuplicateHandle. (Antonin
+  Décimo, review by ??)
+
 ### Tools:
 
 - #3959, #7202, #10476: ocaml, in script mode, directive errors

otherlibs/win32unix/dup.c

@@ -14,22 +14,54 @@
 /**************************************************************************/
 
 #include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
 #include "unixsupport.h"
 
+#define _WIN32_LEAN_AND_MEAN
+#include <winsock2.h>
+
 CAMLprim value unix_dup(value cloexec, value fd)
 {
-  HANDLE newh;
-  value newfd;
-  int kind = Descr_kind_val(fd);
-  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
-                        GetCurrentProcess(), &newh,
-                        0L,
-                        unix_cloexec_p(cloexec) ? FALSE : TRUE,
-                        DUPLICATE_SAME_ACCESS)) {
-    win32_maperr(GetLastError());
-    return -1;
+  CAMLparam2(cloexec, fd);
+  CAMLlocal1(newfd);
+
+  switch (Descr_kind_val(fd)) {
+  case KIND_HANDLE: {
+    HANDLE newh;
+    if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
+                          GetCurrentProcess(), &newh,
+                          0L,
+                          unix_cloexec_p(cloexec) ? FALSE : TRUE,
+                          DUPLICATE_SAME_ACCESS)) {
+      win32_maperr(GetLastError());
+      uerror("dup", Nothing);
+    }
+    newfd = win_alloc_handle(newh);
+    CAMLreturn(newfd);
+  }
+  case KIND_SOCKET: {
+    WSAPROTOCOL_INFO info;
+    SOCKET newsock;
+
+    if (SOCKET_ERROR == WSADuplicateSocket(Socket_val(fd),
+                                           GetCurrentProcessId(),
+                                           &info)) {
+      win32_maperr(WSAGetLastError());
+      uerror("dup", Nothing);
+    }
+
+    newsock = WSASocket(info.iAddressFamily, info.iSocketType, info.iProtocol,
+                        &info, 0, WSA_FLAG_OVERLAPPED);
+    if (INVALID_SOCKET == newsock) {
+      win32_maperr(WSAGetLastError());
+      uerror("dup2", Nothing);
+    }
+
+    newfd = win_alloc_socket(newsock);
+    CAMLreturn(newfd);
+  }
+  default:
+    caml_invalid_argument("Invalid file descriptor type");
   }
-  newfd = win_alloc_handle(newh);
-  Descr_kind_val(newfd) = kind;
-  return newfd;
 }

otherlibs/win32unix/dup2.c

@@ -14,29 +14,67 @@
 /**************************************************************************/
 
 #include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
 #include "unixsupport.h"
 
+#define _WIN32_LEAN_AND_MEAN
+#include <winsock2.h>
+
 CAMLprim value unix_dup2(value cloexec, value fd1, value fd2)
 {
-  HANDLE oldh, newh;
-
-  oldh = Handle_val(fd2);
-  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1),
-                        GetCurrentProcess(), &newh,
-                        0L,
-                        unix_cloexec_p(cloexec) ? FALSE : TRUE,
-                        DUPLICATE_SAME_ACCESS)) {
-    win32_maperr(GetLastError());
-    return -1;
-  }
-  Handle_val(fd2) = newh;
-  if (Descr_kind_val(fd2) == KIND_SOCKET)
-    closesocket((SOCKET) oldh);
-  else
+  CAMLparam3(cloexec, fd1, fd2);
+
+  if (Descr_kind_val(fd1) != Descr_kind_val(fd2))
+    caml_invalid_argument("Expected either two file handles or two sockets");
+
+  switch (Descr_kind_val(fd1)) {
+  case KIND_HANDLE: {
+    HANDLE oldh, newh;
+
+    oldh = Handle_val(fd2);
+    if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1),
+                          GetCurrentProcess(), &newh,
+                          0L,
+                          unix_cloexec_p(cloexec) ? FALSE : TRUE,
+                          DUPLICATE_SAME_ACCESS)) {
+      win32_maperr(GetLastError());
+      uerror("dup2", Nothing);
+    }
+    Handle_val(fd2) = newh;
     CloseHandle(oldh);
-  Descr_kind_val(fd2) = Descr_kind_val(fd1);
+    break;
+  }
+
+  case KIND_SOCKET: {
+    WSAPROTOCOL_INFO info;
+    SOCKET oldsock, newsock;
+
+    oldsock = Socket_val(fd2);
+    if (SOCKET_ERROR == WSADuplicateSocket(Socket_val(fd1),
+                                           GetCurrentProcessId(),
+                                           &info)) {
+      win32_maperr(WSAGetLastError());
+      uerror("dup2", Nothing);
+    }
+
+    newsock = WSASocket(info.iAddressFamily, info.iSocketType, info.iProtocol,
+                        &info, 0, WSA_FLAG_OVERLAPPED);
+    if (INVALID_SOCKET == newsock) {
+      win32_maperr(WSAGetLastError());
+      uerror("dup2", Nothing);
+    }
+
+    Socket_val(fd2) = newsock;
+    closesocket(oldsock);
+    break;
+  }
+  default:
+    caml_invalid_argument("Invalid file descriptor type");
+  }
+
   /* Reflect the dup2 on the CRT fds, if any */
   if (CRT_fd_val(fd1) != NO_CRT_FD || CRT_fd_val(fd2) != NO_CRT_FD)
     _dup2(win_CRT_fd_of_filedescr(fd1), win_CRT_fd_of_filedescr(fd2));
-  return Val_unit;
+  CAMLreturn(Val_unit);
 }