Fixing bug #3858 and #3817 in one stroke.

1 files changed, 9 insertions, 2 deletions

diff --git a/lib/cThread.ml b/lib/cThread.ml
index 76e975d2d..19f14637d 100644
--- a/lib/cThread.ml
+++ b/lib/cThread.ml
@@ -9,11 +9,18 @@
 let prepare_in_channel_for_thread_friendly_io ic =
   Unix.set_nonblock (Unix.descr_of_in_channel ic)
 
+let safe_wait_timed_read fd time =
+  try Thread.wait_timed_read fd time
+  with Unix.Unix_error (Unix.EINTR, _, _) ->
+    (** On Unix, the above function may raise this exception when it is
+        interrupted by a signal. (It uses Unix.select internally.) *)
+    false
+
 let thread_friendly_read_fd fd s ~off ~len =
   let rec loop () =
     try Unix.read fd s off len
-    with Unix.Unix_error((Unix.EWOULDBLOCK|Unix.EAGAIN),_,_) ->
-      while not (Thread.wait_timed_read fd 1.0) do Thread.yield () done;
+    with Unix.Unix_error((Unix.EWOULDBLOCK|Unix.EAGAIN|Unix.EINTR),_,_) ->
+      while not (safe_wait_timed_read fd 1.0) do Thread.yield () done;
       loop ()
   in 
     loop ()