From e4e1f5b5baa22201d7946c4ace3d2cbf38b01751 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Mon, 22 Jul 2024 13:53:14 +0100 Subject: [PATCH] CP-32622: Replace: Unix.select and Thread.wait_timed_* with Unixext equivalents MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also add xapi-stdext-unix or xapi-stext-threads as needed to dune. Signed-off-by: Edwin Török --- ocaml/database/block_device_io.ml | 2 +- ocaml/database/master_connection.ml | 6 +++++- ocaml/forkexecd/src/child.ml | 8 ++++++-- ocaml/libs/ezxenstore/core/dune | 1 + ocaml/libs/ezxenstore/core/watch.ml | 2 +- ocaml/libs/http-lib/buf_io.ml | 2 +- ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli | 2 +- ocaml/message-switch/unix/dune | 1 + ocaml/networkd/lib/jsonrpc_client.ml | 4 ++-- ocaml/xapi-idl/lib/dune | 1 + ocaml/xapi-idl/lib_test/dune | 2 ++ ocaml/xapi-idl/lib_test/scheduler_test.ml | 2 +- ocaml/xe-cli/newcli.ml | 3 ++- ocaml/xenopsd/cli/dune | 1 + ocaml/xenopsd/cli/xn.ml | 4 +++- ocaml/xsh/dune | 1 + ocaml/xsh/xsh.ml | 2 +- 17 files changed, 31 insertions(+), 13 deletions(-) diff --git a/ocaml/database/block_device_io.ml b/ocaml/database/block_device_io.ml index 7587a34d5d5..3081ae3ffde 100644 --- a/ocaml/database/block_device_io.ml +++ b/ocaml/database/block_device_io.ml @@ -328,7 +328,7 @@ let accept_conn s latest_response_time = let now = Unix.gettimeofday () in let timeout = latest_response_time -. now in (* Await an incoming connection... *) - let ready_to_read, _, _ = Unix.select [s] [] [] timeout in + let ready_to_read, _, _ = Xapi_stdext_unix.Unixext.select [s] [] [] timeout in R.info "Finished selecting" ; if List.mem s ready_to_read then (* We've received a connection. Accept it and return the socket. *) diff --git a/ocaml/database/master_connection.ml b/ocaml/database/master_connection.ml index 346773303e8..e10658d48c0 100644 --- a/ocaml/database/master_connection.ml +++ b/ocaml/database/master_connection.ml @@ -171,7 +171,11 @@ let open_secure_connection () = ~write_to_log:(fun x -> debug "stunnel: %s\n" x) ~verify_cert host port @@ fun st_proc -> - let fd_closed = Thread.wait_timed_read Unixfd.(!(st_proc.Stunnel.fd)) 5. in + let fd_closed = + Xapi_stdext_threads.Threadext.wait_timed_read + Unixfd.(!(st_proc.Stunnel.fd)) + 5. + in let proc_quit = try Unix.kill (Stunnel.getpid st_proc.Stunnel.pid) 0 ; diff --git a/ocaml/forkexecd/src/child.ml b/ocaml/forkexecd/src/child.ml index e800e8bf95f..1512e3af851 100644 --- a/ocaml/forkexecd/src/child.ml +++ b/ocaml/forkexecd/src/child.ml @@ -61,7 +61,9 @@ let handle_comms_sock comms_sock state = let handle_comms_no_fd_sock2 comms_sock fd_sock state = debug "Selecting in handle_comms_no_fd_sock2" ; - let ready, _, _ = Unix.select [comms_sock; fd_sock] [] [] (-1.0) in + let ready, _, _ = + Xapi_stdext_unix.Unixext.select [comms_sock; fd_sock] [] [] (-1.0) + in debug "Done" ; if List.mem fd_sock ready then ( debug "fd sock" ; @@ -74,7 +76,9 @@ let handle_comms_no_fd_sock2 comms_sock fd_sock state = let handle_comms_with_fd_sock2 comms_sock _fd_sock fd_sock2 state = debug "Selecting in handle_comms_with_fd_sock2" ; - let ready, _, _ = Unix.select [comms_sock; fd_sock2] [] [] (-1.0) in + let ready, _, _ = + Xapi_stdext_unix.Unixext.select [comms_sock; fd_sock2] [] [] (-1.0) + in debug "Done" ; if List.mem fd_sock2 ready then ( debug "fd sock2" ; diff --git a/ocaml/libs/ezxenstore/core/dune b/ocaml/libs/ezxenstore/core/dune index 53e812032f7..c7f5f636bca 100644 --- a/ocaml/libs/ezxenstore/core/dune +++ b/ocaml/libs/ezxenstore/core/dune @@ -9,5 +9,6 @@ (re_export xenstore) (re_export xenstore_transport) threads.posix + xapi-stdext-unix (re_export xenstore.unix)) ) diff --git a/ocaml/libs/ezxenstore/core/watch.ml b/ocaml/libs/ezxenstore/core/watch.ml index 35f3aee0b5e..1736f8f3c21 100644 --- a/ocaml/libs/ezxenstore/core/watch.ml +++ b/ocaml/libs/ezxenstore/core/watch.ml @@ -50,7 +50,7 @@ let wait_for ~xs ?(timeout = 300.) (x : 'a t) = let thread = Thread.create (fun () -> - let r, _, _ = Unix.select [p1] [] [] timeout in + let r, _, _ = Xapi_stdext_unix.Unixext.select [p1] [] [] timeout in if r <> [] then () else diff --git a/ocaml/libs/http-lib/buf_io.ml b/ocaml/libs/http-lib/buf_io.ml index 7073cf76a05..c4a63a8af67 100644 --- a/ocaml/libs/http-lib/buf_io.ml +++ b/ocaml/libs/http-lib/buf_io.ml @@ -74,7 +74,7 @@ let is_full ic = ic.cur = 0 && ic.max = Bytes.length ic.buf let fill_buf ~buffered ic timeout = let buf_size = Bytes.length ic.buf in let fill_no_exc timeout len = - let l, _, _ = Unix.select [ic.fd] [] [] timeout in + let l, _, _ = Xapi_stdext_unix.Unixext.select [ic.fd] [] [] timeout in if l <> [] then ( let n = Unix.read ic.fd ic.buf ic.max len in ic.max <- n + ic.max ; diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli index 0d3bc48abc9..dc74793da5d 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli @@ -257,7 +257,7 @@ val domain_of_addr : string -> Unix.socket_domain option val test_open : int -> unit (** [test_open n] opens n file descriptors. This is useful for testing that the application makes no calls - to [Unix.select] that use file descriptors, because such calls will then immediately fail. + to [Xapi_stdext_unix.Unixext.select] that use file descriptors, because such calls will then immediately fail. This assumes that [ulimit -n] has been suitably increased in the test environment. diff --git a/ocaml/message-switch/unix/dune b/ocaml/message-switch/unix/dune index be953217f4e..4e792493866 100644 --- a/ocaml/message-switch/unix/dune +++ b/ocaml/message-switch/unix/dune @@ -12,6 +12,7 @@ rpclib.json threads.posix xapi-stdext-threads + xapi-stdext-unix ) (preprocess (per_module ((pps ppx_deriving_rpc) Protocol_unix_scheduler))) ) diff --git a/ocaml/networkd/lib/jsonrpc_client.ml b/ocaml/networkd/lib/jsonrpc_client.ml index d43e8774547..4ad85622e58 100644 --- a/ocaml/networkd/lib/jsonrpc_client.ml +++ b/ocaml/networkd/lib/jsonrpc_client.ml @@ -43,7 +43,7 @@ let timeout_read fd timeout = in let rec inner max_time max_bytes = let ready_to_read, _, _ = - try Unix.select [fd] [] [] (to_s max_time) + try Xapi_stdext_unix.Unixext.select [fd] [] [] (to_s max_time) with (* in case the unix.select call fails in situation like interrupt *) | Unix.Unix_error (Unix.EINTR, _, _) -> @@ -96,7 +96,7 @@ let timeout_write filedesc total_length data response_time = in let rec inner_write offset max_time = let _, ready_to_write, _ = - try Unix.select [] [filedesc] [] (to_s max_time) + try Xapi_stdext_unix.Unixext.select [] [filedesc] [] (to_s max_time) with (* in case the unix.select call fails in situation like interrupt *) | Unix.Unix_error (Unix.EINTR, _, _) -> diff --git a/ocaml/xapi-idl/lib/dune b/ocaml/xapi-idl/lib/dune index ab2f7ab6a0c..fed65ab1257 100644 --- a/ocaml/xapi-idl/lib/dune +++ b/ocaml/xapi-idl/lib/dune @@ -32,6 +32,7 @@ xapi-open-uri xapi-stdext-pervasives xapi-stdext-threads + xapi-stdext-unix xapi-inventory xmlm ) diff --git a/ocaml/xapi-idl/lib_test/dune b/ocaml/xapi-idl/lib_test/dune index 1b1e8193ca7..e2a9ae23da5 100644 --- a/ocaml/xapi-idl/lib_test/dune +++ b/ocaml/xapi-idl/lib_test/dune @@ -59,5 +59,7 @@ xapi-idl.xen xapi-idl.xen.interface xapi-log + xapi-stdext-unix + xapi-stdext-threads ) (preprocess (per_module ((pps ppx_deriving_rpc) Task_server_test Updates_test)))) diff --git a/ocaml/xapi-idl/lib_test/scheduler_test.ml b/ocaml/xapi-idl/lib_test/scheduler_test.ml index 640ae938862..1cc223e65ce 100644 --- a/ocaml/xapi-idl/lib_test/scheduler_test.ml +++ b/ocaml/xapi-idl/lib_test/scheduler_test.ml @@ -37,7 +37,7 @@ let timed_wait_callback ~msg ?(time_min = 0.) ?(eps = 0.1) ?(time_max = 60.) f = () in f callback ; - let ready = Thread.wait_timed_read rd time_max in + let ready = Xapi_stdext_threads.Threadext.wait_timed_read rd time_max in match (ready, !after) with | true, None -> Alcotest.fail "pipe ready to read, but after is not set" diff --git a/ocaml/xe-cli/newcli.ml b/ocaml/xe-cli/newcli.ml index 520d43e0061..56279d6a324 100644 --- a/ocaml/xe-cli/newcli.ml +++ b/ocaml/xe-cli/newcli.ml @@ -594,7 +594,8 @@ let main_loop ifd ofd permitted_filenames = finished := true else let r, _, _ = - Unix.select [Unix.stdin; fd] [] [] heartbeat_interval + Xapi_stdext_unix.Unixext.select [Unix.stdin; fd] [] [] + heartbeat_interval in let now = Unix.time () in if now -. !last_heartbeat >= heartbeat_interval then ( diff --git a/ocaml/xenopsd/cli/dune b/ocaml/xenopsd/cli/dune index 0b2e0f0c2cf..6fbcbb54b68 100644 --- a/ocaml/xenopsd/cli/dune +++ b/ocaml/xenopsd/cli/dune @@ -22,6 +22,7 @@ xapi-idl.xen.interface xapi-idl.xen.interface.types xapi-stdext-pervasives + xapi-stdext-unix ) (preprocess (per_module ((pps ppx_deriving_rpc) Common Xn_cfg_types))) ) diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml index 9658650699f..72e70897997 100644 --- a/ocaml/xenopsd/cli/xn.ml +++ b/ocaml/xenopsd/cli/xn.ml @@ -1019,7 +1019,9 @@ let raw_console_proxy sockaddr = ) else if !final then finished := true else - let r, _, _ = Unix.select [Unix.stdin; fd] [] [] (-1.) in + let r, _, _ = + Xapi_stdext_unix.Unixext.select [Unix.stdin; fd] [] [] (-1.) + in if List.mem Unix.stdin r then ( let b = Unix.read Unix.stdin buf_remote !buf_remote_end diff --git a/ocaml/xsh/dune b/ocaml/xsh/dune index 121c95186e6..c908cd4fdaa 100644 --- a/ocaml/xsh/dune +++ b/ocaml/xsh/dune @@ -9,6 +9,7 @@ safe-resources xapi-consts xapi-log + xapi-stdext-unix ) ) diff --git a/ocaml/xsh/xsh.ml b/ocaml/xsh/xsh.ml index 51de04f257a..7b8aefb07d7 100644 --- a/ocaml/xsh/xsh.ml +++ b/ocaml/xsh/xsh.ml @@ -60,7 +60,7 @@ let proxy (ain : Unix.file_descr) (aout : Unix.file_descr) (bin : Unixfd.t) (if can_write a' then [bout] else []) @ if can_write b' then [aout] else [] in - let r, w, _ = Unix.select r w [] (-1.0) in + let r, w, _ = Xapi_stdext_unix.Unixext.select r w [] (-1.0) in (* Do the writing before the reading *) List.iter (fun fd -> if aout = fd then write_from b' a' else write_from a' b')