CP-32622: PR fixes

Signed-off-by: Steven Woods <[email protected]>

ocaml/database/block_device_io.ml

@@ -326,13 +326,21 @@ let accept_conn s latest_response_time =
   let now = Unix.gettimeofday () in
   let timeout = latest_response_time -. now in
   (* Await an incoming connection... *)
-  Fun.protect
-    ~finally:(fun () -> Unix.setsockopt_float s Unix.SO_RCVTIMEO 0.)
-    (fun () ->
-      Unix.setsockopt_float s Unix.SO_RCVTIMEO timeout ;
-      try fst (Unix.accept s)
-      with Unix.Unix_error (Unix.EAGAIN, _, _) -> raise Unixext.Timeout
-    )
+  let epoll = Polly.create () in
+  Polly.add epoll s Polly.Events.inp ;
+  let fds =
+    Fun.protect
+      ~finally:(fun () -> Polly.close epoll)
+      (fun () ->
+        Polly.wait_fold epoll 1 (int_of_float timeout) [] (fun _ fd _ fds ->
+            fst (Unix.accept fd) :: fds
+        )
+      )
+  in
+  if fds = [] then (* We must have timed out *)
+    raise Unixext.Timeout
+  else
+    fds
 
 (* Listen on a given socket. Accept a single connection and transfer all the data from it to dest_fd, or raise Timeout if target_response_time happens first. *)
 (* Raises NotEnoughSpace if the next write would exceed the available_space. *)

ocaml/networkd/lib/jsonrpc_client.ml

@@ -60,16 +60,13 @@ let timeout_read fd timeout =
     match Unix.read fd bytes 0 4096 with
     | 0 ->
         Buffer.contents buf (* EOF *)
+    | n when n > max_bytes ->
+        debug "exceeding maximum read limit %d, clear buffer" !json_rpc_max_len ;
+        Buffer.clear buf ;
+        raise Read_error
     | n ->
-        if n > max_bytes then (
-          debug "exceeding maximum read limit %d, clear buffer"
-            !json_rpc_max_len ;
-          Buffer.clear buf ;
-          raise Read_error
-        ) else (
-          Buffer.add_subbytes buf bytes 0 n ;
-          inner remain_time (max_bytes - n)
-        )
+        Buffer.add_subbytes buf bytes 0 n ;
+        inner remain_time (max_bytes - n)
     | exception
         Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) ->
         inner remain_time max_bytes

ocaml/xapi-idl/lib/posix_channel.ml

@@ -88,14 +88,15 @@ let proxy (a : Unix.file_descr) (b : Unix.file_descr) =
         (fun () ->
           ignore
           @@ Polly.wait epoll 4 (-1) (fun _ fd event ->
-                 if event = Polly.Events.inp then
+                 (* Note: only one fd is handled *)
+                 if event = Polly.Events.inp then (
                    if a = fd then
                      CBuf.read a' a
-                   else
+                   else if b = fd then
                      CBuf.read b' b
-                 else if a = fd then
+                 ) else if a = fd then
                    CBuf.write b' a
-                 else
+                 else if b = fd then
                    CBuf.write a' b
              ) ;
           (* If there's nothing else to read or write then signal the other end *)
@@ -176,6 +177,7 @@ let send proxy_socket =
                   (fun () ->
                     ignore
                     @@ Polly.wait epoll 2 (-1) (fun _ fd _ ->
+                           (* Note: only one fd is handled *)
                            if s_unix = fd then (
                              let fd, _peer = Unix.accept s_unix in
                              to_close := fd :: !to_close ;
@@ -198,7 +200,8 @@ let send proxy_socket =
                              to_close := fd :: !to_close ;
                              proxy fd proxy_socket
                            ) else
-                             assert false (* can never happen *)
+                             Printf.fprintf stderr
+                               "Unexpected file descriptor returned by epoll"
                        )
                   )
               )

ocaml/xsh/xsh.ml

@@ -68,6 +68,7 @@ let proxy (ain : Unix.file_descr) (aout : Unix.file_descr) (bin : Unixfd.t)
         (fun () ->
           ignore
           @@ Polly.wait epoll 4 (-1) (fun _ fd _ ->
+                 (* Note: only one fd is handled *)
                  if aout = fd then
                    write_from b' a'
                  else if bout = fd then