CP-32622: Replace: Unix.select and Thread.wait_timed_* with Unixext e…

…quivalents

Also add xapi-stdext-unix or xapi-stext-threads as needed to dune.

Signed-off-by: Edwin Török <[email protected]>

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. *)

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 ;

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" ;

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))
 )

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

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 ;

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.
   

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)))
 )

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, _, _) ->

ocaml/xapi-idl/lib/dune

@@ -32,6 +32,7 @@
    xapi-open-uri
    xapi-stdext-pervasives
    xapi-stdext-threads
+   xapi-stdext-unix
    xapi-inventory
    xmlm
  )

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))))

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"

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 (

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)))
 )

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

ocaml/xsh/dune

@@ -9,6 +9,7 @@
     safe-resources
     xapi-consts
     xapi-log
+    xapi-stdext-unix
   )
 )
 

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')