Merge PR #9881: Protect some I/O routines from SIGALRM

Ack-by: SkySkimmer
Reviewed-by: ejgallego
Ack-by: maximedenes

1 files changed, 4 insertions, 2 deletions

diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index 73b9ef7da0..d1bd3692ab 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -329,10 +329,12 @@ module Make(T : Task) () = struct
   let main_loop () =
     (* We pass feedback to master *)
     let slave_feeder oc fb =
-      Marshal.to_channel oc (RespFeedback (debug_with_pid fb)) []; flush oc in
+      Control.protect_sigalrm (fun () ->
+          Marshal.to_channel oc (RespFeedback (debug_with_pid fb)) []; flush oc) ()
+    in
     ignore (Feedback.add_feeder (fun x -> slave_feeder (Option.get !slave_oc) x));
     (* We ask master to allocate universe identifiers *)
-    UnivGen.set_remote_new_univ_id (bufferize (fun () ->
+    UnivGen.set_remote_new_univ_id (bufferize @@ Control.protect_sigalrm (fun () ->
       marshal_response (Option.get !slave_oc) RespGetCounterNewUnivLevel;
       match unmarshal_more_data (Option.get !slave_ic) with
       | MoreDataUnivLevel l -> l));