Lwt_engine: allow external signal handlers

Before installing a signal handler, Lwt now checks first with the
engine, which may now prevent Lwt from installing its handler and
instead forward signals from some external handler.

This allows e.g. sharing the SIGCHLD handler with Eio.

Author: talex5

src/unix/lwt_engine.ml

@@ -108,6 +108,8 @@ class virtual abstract = object(self)
   method timer_count = Lwt_sequence.length timers
 
   method fork = ()
+
+  method forwards_signal (_signum:int) = false
 end
 
 class type t = object
@@ -433,6 +435,7 @@ let readable_count () = !current#readable_count
 let writable_count () = !current#writable_count
 let timer_count () = !current#timer_count
 let fork () = !current#fork
+let forwards_signal n = !current#forwards_signal n
 
 module Versioned =
 struct

src/unix/lwt_engine.mli

@@ -53,6 +53,13 @@ val fake_io : Unix.file_descr -> unit
 val fork : unit -> unit
   (** Called internally by Lwt_unix.fork to make sure we don't get strange behaviour *)
 
+val forwards_signal : int -> bool
+(** [forwards_signal signum] is [true] if the engine will call {!Lwt_unix.handle_signal}
+    when signal [signum] occurs. In this case, Lwt will not install its own signal handler.
+
+    Normally, this just returns [false], but when Lwt is used in combination
+    with other IO libraries, this allows sharing e.g. the SIGCHLD handler. *)
+
 (** {2 Engines} *)
 
 (** An engine represents a set of functions used to register different
@@ -82,6 +89,7 @@ class virtual abstract : object
   method readable_count : int
   method writable_count : int
   method timer_count : int
+  method forwards_signal : int -> bool
 
   (** {2 Backend methods} *)
 

src/unix/lwt_unix.cppo.ml

@@ -2227,12 +2227,19 @@ let event_notifications = ref (Lwt_engine.on_readable (init_notification ()) han
    | Signals                                                         |
    +-----------------------------------------------------------------+ *)
 
-external set_signal : int -> int -> unit = "lwt_unix_set_signal"
-external remove_signal : int -> unit = "lwt_unix_remove_signal"
+external set_signal : int -> int -> bool -> unit = "lwt_unix_set_signal"
+external remove_signal : int -> bool -> unit = "lwt_unix_remove_signal"
 external init_signals : unit -> unit = "lwt_unix_init_signals"
+external handle_signal : int -> unit = "lwt_unix_handle_signal"
 
 let () = init_signals ()
 
+let set_signal signum notification =
+  set_signal signum notification (Lwt_engine.forwards_signal signum)
+
+let remove_signal signum =
+  remove_signal signum (Lwt_engine.forwards_signal signum)
+
 module Signal_map = Map.Make(struct type t = int let compare a b = a - b end)
 
 type signal_handler = {

src/unix/lwt_unix.cppo.mli

@@ -854,6 +854,14 @@ val reinstall_signal_handler : int -> unit
       signal handler (with [Sys.set_signal]). This is useful in case
       another part of the program install another signal handler. *)
 
+val handle_signal : int -> unit
+  (** [handle_signal signum] acts as if Lwt had received the [signum] signal.
+      This allows another IO library to install the handler, perform its own
+      handling, but still notify Lwt. It is particularly useful for SIGCHLD,
+      where several IO libraries may be spawning sub-processes.
+
+      This function is thread-safe. *)
+
 (** {2 Sockets} *)
 
 type inet_addr = Unix.inet_addr

src/unix/lwt_unix_stubs.c

@@ -801,6 +801,11 @@ static void handle_signal(int signum) {
   }
 }
 
+CAMLprim value lwt_unix_handle_signal(value val_signum) {
+  handle_signal(caml_convert_signal_number(Int_val(val_signum)));
+  return Val_unit;
+}
+
 #if defined(LWT_ON_WINDOWS)
 /* Handle Ctrl+C on windows. */
 static BOOL WINAPI handle_break(DWORD event) {
@@ -813,7 +818,7 @@ static BOOL WINAPI handle_break(DWORD event) {
 #endif
 
 /* Install a signal handler. */
-CAMLprim value lwt_unix_set_signal(value val_signum, value val_notification) {
+CAMLprim value lwt_unix_set_signal(value val_signum, value val_notification, value val_forwarded) {
 #if !defined(LWT_ON_WINDOWS)
   struct sigaction sa;
 #endif
@@ -825,6 +830,8 @@ CAMLprim value lwt_unix_set_signal(value val_signum, value val_notification) {
 
   signal_notifications[signum] = notification;
 
+  if (Bool_val(val_forwarded)) return Val_unit;
+
 #if defined(LWT_ON_WINDOWS)
   if (signum == SIGINT) {
     if (!SetConsoleCtrlHandler(handle_break, TRUE)) {
@@ -855,14 +862,17 @@ CAMLprim value lwt_unix_set_signal(value val_signum, value val_notification) {
 }
 
 /* Remove a signal handler. */
-CAMLprim value lwt_unix_remove_signal(value val_signum) {
+CAMLprim value lwt_unix_remove_signal(value val_signum, value val_forwarded) {
 #if !defined(LWT_ON_WINDOWS)
   struct sigaction sa;
 #endif
   /* The signal number is valid here since it was when we did the
      set_signal. */
   int signum = caml_convert_signal_number(Int_val(val_signum));
   signal_notifications[signum] = -1;
+
+  if (Bool_val(val_forwarded)) return Val_unit;
+
 #if defined(LWT_ON_WINDOWS)
   if (signum == SIGINT)
     SetConsoleCtrlHandler(NULL, FALSE);