feat: block signals in workers if asked to

src/core/fifo_pool.ml

@@ -165,7 +165,9 @@ let create ?on_init_thread ?on_exit_thread ?on_exn ?around_task ?num_threads
        create the thread and push it into [receive_threads] *)
     let create_thread_in_domain () =
       let st = { idx = i; dom_idx; st = pool } in
-      let thread = Thread.create (WL.worker_loop ~ops:worker_ops) st in
+      let thread =
+        Thread.create (WL.worker_loop ~block_signals:true ~ops:worker_ops) st
+      in
       (* send the thread from the domain back to us *)
       Bb_queue.push receive_threads (i, thread)
     in

src/core/worker_loop_.ml

@@ -102,7 +102,22 @@ let with_handler ~ops:_ self f = f ()
 
 [@@@endif]
 
-let worker_loop (type st) ~(ops : st ops) (self : st) : unit =
+let worker_loop (type st) ~block_signals ~(ops : st ops) (self : st) : unit =
+  if block_signals then
+    List.iter
+      (fun signal -> Sys.set_signal signal Sys.Signal_ignore)
+      [
+        Sys.sigterm;
+        Sys.sigpipe;
+        Sys.sigint;
+        Sys.sigchld;
+        Sys.sigalrm;
+        Sys.sigusr1;
+        Sys.sigusr2;
+        Sys.sigvtalrm;
+        Sys.sigstop;
+      ];
+
   let cur_fiber : fiber ref = ref _dummy_fiber in
   let runner = ops.runner self in
   TLS.set Runner.For_runner_implementors.k_cur_runner runner;

src/core/ws_pool.ml

@@ -310,7 +310,9 @@ let create ?(on_init_thread = default_thread_init_exit_)
     (* function called in domain with index [i], to
        create the thread and push it into [receive_threads] *)
     let create_thread_in_domain () =
-      let thread = Thread.create (WL.worker_loop ~ops:worker_ops) st in
+      let thread =
+        Thread.create (WL.worker_loop ~block_signals:true ~ops:worker_ops) st
+      in
       (* send the thread from the domain back to us *)
       Bb_queue.push receive_threads (idx, thread)
     in

src/fib/main.ml

@@ -1,6 +1,6 @@
 exception Oh_no of Exn_bt.t
 
-let main (f : Runner.t -> 'a) : 'a =
+let main' ?(block_signals = false) () (f : Runner.t -> 'a) : 'a =
   let worker_st =
     Fifo_pool.Private_.create_single_threaded_state ~thread:(Thread.self ())
       ~on_exn:(fun e bt -> raise (Oh_no (Exn_bt.make e bt)))
@@ -13,6 +13,7 @@ let main (f : Runner.t -> 'a) : 'a =
 
     (* run the main thread *)
     Moonpool.Private.Worker_loop_.worker_loop worker_st
+      ~block_signals (* do not disturb existing thread *)
       ~ops:Fifo_pool.Private_.worker_ops;
 
     match Fiber.peek fiber with
@@ -20,3 +21,6 @@ let main (f : Runner.t -> 'a) : 'a =
     | Some (Error ebt) -> Exn_bt.raise ebt
     | None -> assert false
   with Oh_no ebt -> Exn_bt.raise ebt
+
+let main f =
+  main' () f ~block_signals:false (* do not disturb existing thread *)

src/fib/main.mli

@@ -23,3 +23,7 @@ val main : (Moonpool.Runner.t -> 'a) -> 'a
 (** [main f] runs [f()] in a scope that handles effects, including {!Fiber.await}.
 
     This scope can run background tasks as well, in a cooperative fashion. *)
+
+val main' : ?block_signals:bool -> unit -> (Moonpool.Runner.t -> 'a) -> 'a
+(** Same as {!main} but with room for optional arguments.
+    @since NEXT_RELEASE *)