diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml
index eb9a94a10d..7fa399cde8 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml
@@ -434,24 +434,35 @@ let proxy (a : Unix.file_descr) (b : Unix.file_descr) =
   let a' = CBuf.empty size and b' = CBuf.empty size in
   Unix.set_nonblock a ;
   Unix.set_nonblock b ;
+  with_polly @@ fun polly ->
   try
     while true do
-      let r =
-        (if CBuf.should_read a' then [a] else [])
-        @ if CBuf.should_read b' then [b] else []
-      in
-      let w =
-        (if CBuf.should_write a' then [b] else [])
-        @ if CBuf.should_write b' then [a] else []
-      in
+      let any = ref false in
+      if CBuf.should_read a' then (
+        Polly.add polly a Polly.Events.(inp lor oneshot) ;
+        any := true
+      ) ;
+      if CBuf.should_read b' then (
+        Polly.add polly b Polly.Events.(inp lor oneshot) ;
+        any := true
+      ) ;
+      if CBuf.should_write a' then (
+        Polly.add polly b Polly.Events.(out lor oneshot) ;
+        any := true
+      ) ;
+      if CBuf.should_write b' then (
+        Polly.add polly a Polly.Events.(out lor oneshot) ;
+        any := true
+      ) ;
       (* If we can't make any progress (because fds have been closed), then stop *)
-      if r = [] && w = [] then raise End_of_file ;
-      let r, w, _ = Unix.select r w [] (-1.0) in
-      (* Do the writing before the reading *)
-      List.iter
-        (fun fd -> if a = fd then CBuf.write b' a else CBuf.write a' b)
-        w ;
-      List.iter (fun fd -> if a = fd then CBuf.read a' a else CBuf.read b' b) r ;
+      if not !any then raise End_of_file ;
+      Polly.wait_fold polly 4 (-1) () (fun _polly fd events () ->
+          (* Do the writing before the reading *)
+          if Polly.Events.(test out events) then
+            if a = fd then CBuf.write b' a else CBuf.write a' b ;
+          if Polly.Events.(test inp events) then
+            if a = fd then CBuf.read a' a else CBuf.read b' b
+      ) ;
       (* If there's nothing else to read or write then signal the other end *)
       List.iter
         (fun (buf, fd) ->