From 07328070819785f8b88ea2b26a2d9a753d76e788 Mon Sep 17 00:00:00 2001 From: Vesa Karvonen Date: Mon, 9 Sep 2024 10:23:31 +0300 Subject: [PATCH] Attempt to work around `Unix.socketpair` issue on Win32 `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. --- lib/picos_io/picos_io.ml | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/lib/picos_io/picos_io.ml b/lib/picos_io/picos_io.ml index 56c06728..ba663162 100644 --- 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 =