win32unix: use WSADuplicateSocket in bindings of dup and dup2

Changes

@@ -110,6 +110,10 @@ Working version
   Thread.default_uncaught_exception_handler.
   (Enguerrand Decorne, review by David Allsopp)
 
+- #10697: Bindings of dup and dup2 in win32unix now correctly call
+  WSADuplicateSocket on sockets instead of DuplicateHandle.
+  (Antonin Décimo, review by Xavier Leroy and Nicolás Ojeda Bär)
+
 ### Tools:
 
 - #3959, #7202, #10476: ocaml, in script mode, directive errors

otherlibs/win32unix/Makefile

@@ -19,7 +19,7 @@
 
 # Files in this directory
 WIN_FILES = accept.c bind.c channels.c close.c \
-  close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c envir.c \
+  close_on.c connect.c createprocess.c dup.c errmsg.c envir.c \
   getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
   link.c listen.c lockf.c lseek.c nonblock.c \
   mmap.c open.c pipe.c read.c readlink.c rename.c \

otherlibs/win32unix/dup.c

@@ -14,22 +14,107 @@
 /**************************************************************************/
 
 #include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
 #include "unixsupport.h"
 
-CAMLprim value unix_dup(value cloexec, value fd)
+#define _WIN32_LEAN_AND_MEAN
+#include <winsock2.h>
+
+static HANDLE duplicate_handle(BOOL inherit, HANDLE oldh)
 {
-  HANDLE newh;
-  value newfd;
-  int kind = Descr_kind_val(fd);
-  if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
-                        GetCurrentProcess(), &newh,
+  HANDLE newh, proc = GetCurrentProcess();
+  if (! DuplicateHandle(proc, oldh, proc, &newh,
                         0L,
-                        unix_cloexec_p(cloexec) ? FALSE : TRUE,
+                        inherit,
                         DUPLICATE_SAME_ACCESS)) {
     win32_maperr(GetLastError());
-    return -1;
+    return INVALID_HANDLE_VALUE;
+  }
+  return newh;
+}
+
+static SOCKET duplicate_socket(BOOL inherit, SOCKET oldsock)
+{
+  WSAPROTOCOL_INFO info;
+  SOCKET newsock;
+  if (SOCKET_ERROR == WSADuplicateSocket(oldsock,
+                                         GetCurrentProcessId(),
+                                         &info)) {
+    win32_maperr(WSAGetLastError());
+    return INVALID_SOCKET;
+  }
+
+  newsock = WSASocket(info.iAddressFamily, info.iSocketType, info.iProtocol,
+                      &info, 0, WSA_FLAG_OVERLAPPED);
+  if (INVALID_SOCKET == newsock)
+    win32_maperr(WSAGetLastError());
+  else
+    win_set_inherit((HANDLE) newsock, inherit);
+  return newsock;
+}
+
+CAMLprim value unix_dup(value cloexec, value fd)
+{
+  CAMLparam2(cloexec, fd);
+  CAMLlocal1(newfd);
+
+  switch (Descr_kind_val(fd)) {
+  case KIND_HANDLE: {
+    HANDLE newh = duplicate_handle(! unix_cloexec_p(cloexec),
+                                   Handle_val(fd));
+    if (newh == INVALID_HANDLE_VALUE)
+      uerror("dup", Nothing);
+    newfd = win_alloc_handle(newh);
+    CAMLreturn(newfd);
+  }
+  case KIND_SOCKET: {
+    SOCKET newsock = duplicate_socket(! unix_cloexec_p(cloexec),
+                                      Socket_val(fd));
+    if (newsock == INVALID_SOCKET)
+      uerror("dup", Nothing);
+    newfd = win_alloc_socket(newsock);
+    CAMLreturn(newfd);
+  }
+  default:
+    caml_invalid_argument("Invalid file descriptor type");
+  }
+}
+
+CAMLprim value unix_dup2(value cloexec, value fd1, value fd2)
+{
+  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 = Handle_val(fd2),
+      newh = duplicate_handle(! unix_cloexec_p(cloexec),
+                              Handle_val(fd1));
+    if (newh == INVALID_HANDLE_VALUE)
+      uerror("dup2", Nothing);
+    Handle_val(fd2) = newh;
+    CloseHandle(oldh);
+    break;
   }
-  newfd = win_alloc_handle(newh);
-  Descr_kind_val(newfd) = kind;
-  return newfd;
+  case KIND_SOCKET: {
+    SOCKET oldsock = Socket_val(fd2),
+      newsock = duplicate_socket(! unix_cloexec_p(cloexec),
+                                 Socket_val(fd1));
+    if (newsock == INVALID_SOCKET)
+      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));
+  CAMLreturn(Val_unit);
 }