Attempt to work around Unix.socketpair issue on Win32

polytypic · polytypic · commit 376152c577a6 · 2024-09-09T12:37:07.000+03:00
`Unix.socketpair` occasionally fails on Windows:

```diff
--- a/_build/default/lib/picos_io/picos_io.mli
+++ b/_build/default/lib/picos_io/.mdx/picos_io.mli.corrected
@@ -753,7 +753,5 @@ end
           send_string "Hello, world!";
           send_string "POSIX with OCaml";
         end
-      Hello, world!
-      POSIX with OCaml
-      - : unit = ()
+      Exception: Unix.Unix_error(Unix.EADDRINUSE, "socketpair", "")
     ]} *)
```

This introduces a work around to retry `Unix.sockepair` a few times on Win32
when the `EADDRINUSE` error is raised.  We shuld remove the workaround once the
root issue is fixed.
diff --git a/lib/picos_io/picos_io.ml b/lib/picos_io/picos_io.ml
@@ -431,9 +431,29 @@ module Unix = struct
     Fd.create (Unix.socket ?cloexec socket_domain socket_type protocol)
 
   (* https://pubs.opengroup.org/onlinepubs/9699919799/functions/socketpair.html *)
-  let socketpair ?cloexec socket_domain socket_type mystery =
-    let fst, snd = Unix.socketpair ?cloexec socket_domain socket_type mystery in
-    (Fd.create fst, Fd.create snd)
+  let socketpair =
+    if Sys.win32 then
+      (* This is a workaround for [Unix.socketpair] on Win32 to avoid CI
+         failures.  We should be able to remove this once the root issue is
+         fixed. *)
+      let rec socketpair_win32 ?cloexec socket_domain socket_type mystery
+          retries =
+        match Unix.socketpair ?cloexec socket_domain socket_type mystery with
+        | sockets -> sockets
+        | exception Unix.Unix_error (EADDRINUSE, _, _) when 0 < retries ->
+            socketpair_win32 ?cloexec socket_domain socket_type mystery
+              (retries - 1)
+      in
+      fun ?cloexec socket_domain socket_type mystery ->
+        let fst, snd =
+          socketpair_win32 ?cloexec socket_domain socket_type mystery 5
+        in
+        (Fd.create fst, Fd.create snd)
+    else fun ?cloexec socket_domain socket_type mystery ->
+      let fst, snd =
+        Unix.socketpair ?cloexec socket_domain socket_type mystery
+      in
+      (Fd.create fst, Fd.create snd)
 
   (* https://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html *)
   let accept ?cloexec fd =
