Merge pull request #993 from talex5/forward-signals

Make signal handling work on OCaml 5 and with Eio

Author: raphael-proust

CHANGES

@@ -23,12 +23,21 @@
 
   * Lwt_preemptive.run_in_main_dont_wait to run a function in the main preemptive thread but without waiting for the result. (Kate Deplaix, #960)
 
+  * Lwt_unix.handle_signal and Lwt_engine.forwards_signal to allow other IO libraries (such as Eio) to share signal handlers. (Thomas Leonard, #993, #991)
+
 ====== Build ======
 
   * Remove unused dependency in dune file. (#969, Kate Deplaix)
 
   * Fix some compilation warnings for C stubs with OCaml 5. (#976, Antonin Décimo)
 
+====== Fixes ======
+
+  * Use SA_ONSTACK on OCaml5 to avoid SIGSEGV. (Thomas Leonard, #993, #981)
+
+  * Fix race in worker loop. (Thomas Leonard, #993, #994)
+
+
 ===== 5.6.1 =====
 
 ====== Fixes ======

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

@@ -169,16 +169,25 @@ value lwt_unix_system_byte_order() {
 int lwt_unix_launch_thread(void *(*start)(void *), void *data) {
   pthread_t thread;
   pthread_attr_t attr;
+  sigset_t mask, old_mask;
 
   pthread_attr_init(&attr);
 
   /* The thread is created in detached state so we do not have to join
      it when it terminates: */
   pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
 
+  /* Block all signals, otherwise ocaml handlers defined with the
+     module Sys may be executed in the new thread, oops... */
+  sigfillset(&mask);
+  pthread_sigmask(SIG_SETMASK, &mask, &old_mask);
+
   int zero_if_created_otherwise_errno =
       pthread_create(&thread, &attr, start, data);
 
+  /* Restore the signal mask for the calling thread. */
+  pthread_sigmask(SIG_SETMASK, &old_mask, NULL);
+
   pthread_attr_destroy(&attr);
 
   return zero_if_created_otherwise_errno;
@@ -801,6 +810,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 +827,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 +839,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)) {
@@ -840,7 +856,11 @@ CAMLprim value lwt_unix_set_signal(value val_signum, value val_notification) {
   }
 #else
   sa.sa_handler = handle_signal;
+#if OCAML_VERSION >= 50000
+  sa.sa_flags = SA_ONSTACK;
+#else
   sa.sa_flags = 0;
+#endif
   sigemptyset(&sa.sa_mask);
   if (sigaction(signum, &sa, NULL) == -1) {
     signal_notifications[signum] = -1;
@@ -851,14 +871,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);
@@ -964,18 +987,11 @@ void initialize_threading() {
    | Worker loop                                                     |
    +-----------------------------------------------------------------+ */
 
-/* Function executed by threads of the pool. */
+/* Function executed by threads of the pool.
+ * Note: all signals are masked for this thread. */
 static void *worker_loop(void *data) {
   lwt_unix_job job = (lwt_unix_job)data;
 
-#if defined(HAVE_PTHREAD)
-  /* Block all signals, otherwise ocaml handlers defined with the
-     module Sys may be executed in this thread, oops... */
-  sigset_t mask;
-  sigfillset(&mask);
-  pthread_sigmask(SIG_SETMASK, &mask, NULL);
-#endif
-
   /* Execute the initial job if any. */
   if (job != NULL) execute_job(job);