Subject: [PATCH] Stop signal thread before forking, restart it afterwards.

From: Ludovic Courtès <[email-masked]>
Date: Fri, 5 Jan 2024 19:14:04 +0100

Fixes <https://bugs.gnu.org/68087>.

* libguile/scmsigs.h (scm_i_signals_pre_fork, scm_i_signals_post_fork):
New declarations.
(scm_i_signal_delivery_thread): Change type to SCM..
* libguile/threads.c (scm_all_threads): Adjust accordingly and exclude
threads that have ‘t->exited’.  Access ‘thread_count’ after grabbing
‘thread_admin_mutex’.
* libguile/posix.c (scm_fork): Add calls to ‘scm_i_signals_pre_fork’ and
‘scm_i_signals_post_fork’.
* libguile/scmsigs.c (signal_delivery_thread): Close signal_pipe[0] upon
exit and set it to -1.
(once): New file-global variable, moved from…
(scm_i_ensure_signal_delivery_thread): … here.
(stop_signal_delivery_thread, scm_i_signals_pre_fork)
(scm_i_signals_post_fork): New functions.
* test-suite/standalone/test-sigaction-fork: New file.
* test-suite/standalone/Makefile.am (check_SCRIPTS, TESTS): Add it.
---
 libguile/posix.c                          |  6 ++
 libguile/scmsigs.c                        | 62 ++++++++++++++++-
 libguile/scmsigs.h                        |  6 +-
 libguile/threads.c                        | 17 +++--
 test-suite/standalone/Makefile.am         |  6 +-
 test-suite/standalone/test-sigaction-fork | 85 +++++++++++++++++++++++
 6 files changed, 168 insertions(+), 14 deletions(-)
 create mode 100755 test-suite/standalone/test-sigaction-fork

Hello!

Here’s a fix I’ve come up with: just like for the finalizer thread, stop
the signal thread before forking, and in this case start it again after
fork if needed.

It fixes the immediate problem, but the test also shows the perils with
all this asynchronous signal handling.  I’d like to investigate ways to
make signal handling somewhat more predictable (pselect(2), as suggested
on Mastodon by Sergey Bugaev, is probably part of the solution).

Thoughts?

Ludo’.

diff --git a/libguile/posix.c b/libguile/posix.c
index 6ce78ee18..f7d68200b 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1295,7 +1295,10 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
 #define FUNC_NAME s_scm_fork
 {
   int pid;
+
   scm_i_finalizer_pre_fork ();
+  scm_i_signals_pre_fork ();
+
   if (scm_ilength (scm_all_threads ()) != 1)
     /* Other threads may be holding on to resources that Guile needs --
        it is not safe to permit one thread to fork while others are
@@ -1317,6 +1320,9 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
 
   if (pid == -1)
     SCM_SYSERROR;
+
+  scm_i_signals_post_fork ();
+
   return scm_from_int (pid);
 }
 #undef FUNC_NAME
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index f7c3d7fbd..3d4e72a2b 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -86,7 +86,7 @@ static SCM signal_handler_asyncs;
 static SCM signal_handler_threads;
 
 /* The signal delivery thread.  */
-scm_thread *scm_i_signal_delivery_thread = NULL;
+SCM scm_i_signal_delivery_thread = SCM_BOOL_F;
 
 /* The mutex held when launching the signal delivery thread.  */
 static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
@@ -196,6 +196,9 @@ signal_delivery_thread (void *data)
 	perror ("error in signal delivery thread");
     }
 
+  close (signal_pipe[0]);
+  signal_pipe[0] = -1;
+
   return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
 }
 
@@ -211,18 +214,35 @@ start_signal_delivery_thread (void)
   signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
 				    scm_handle_by_message,
 				    "signal delivery thread");
-  scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_thread);
+  scm_i_signal_delivery_thread = signal_thread;
 
   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
 }
 
+static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+
 void
 scm_i_ensure_signal_delivery_thread ()
 {
-  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
   scm_i_pthread_once (&once, start_signal_delivery_thread);
 }
 
+static void
+stop_signal_delivery_thread ()
+{
+  scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+
+  if (scm_is_true (scm_i_signal_delivery_thread))
+    {
+      close (signal_pipe[1]);
+      signal_pipe[1] = -1;
+      scm_join_thread (scm_i_signal_delivery_thread);
+      scm_i_signal_delivery_thread = SCM_BOOL_F;
+    }
+
+  scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
+}
+
 #else /* !SCM_USE_PTHREAD_THREADS */
 
 static void
@@ -248,8 +268,44 @@ scm_i_ensure_signal_delivery_thread ()
   return;
 }
 
+static void
+stop_signal_delivery_thread ()
+{
+  return;
+}
+
 #endif /* !SCM_USE_PTHREAD_THREADS */
 
+/* Perform pre-fork cleanup by stopping the signal delivery thread.  */
+void
+scm_i_signals_pre_fork ()
+{
+  stop_signal_delivery_thread ();
+}
+
+/* Perform post-fork setup by restarting the signal delivery thread if
+   it was active before fork.  This happens in both the parent and the
+   child process.  */
+void
+scm_i_signals_post_fork ()
+{
+  int active = 0;
+
+  for (int sig = 0; sig < NSIG; sig++)
+    {
+      if (scm_is_true (SCM_SIMPLE_VECTOR_REF (signal_handler_threads, sig))
+          || scm_is_true (SCM_SIMPLE_VECTOR_REF (signal_handler_asyncs, sig)))
+        {
+          active = 1;
+          break;
+        }
+    }
+
+  once = SCM_I_PTHREAD_ONCE_INIT;
+  if (active)
+    scm_i_ensure_signal_delivery_thread ();
+}
+
 static void
 install_handler (int signum, SCM thread, SCM handler)
 {
diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h
index 1837833c3..876690fa5 100644
--- a/libguile/scmsigs.h
+++ b/libguile/scmsigs.h
@@ -1,7 +1,7 @@
 #ifndef SCM_SCMSIGS_H
 #define SCM_SCMSIGS_H
 
-/* Copyright 1995-1998,2000,2002,2006-2008,2018
+/* Copyright 1995-1998,2000,2002,2006-2008,2018,2023
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -43,7 +43,9 @@ SCM_INTERNAL void scm_init_scmsigs (void);
 
 SCM_INTERNAL void scm_i_close_signal_pipe (void);
 SCM_INTERNAL void scm_i_ensure_signal_delivery_thread (void);
+SCM_INTERNAL void scm_i_signals_pre_fork (void);
+SCM_INTERNAL void scm_i_signals_post_fork (void);
 
-SCM_INTERNAL scm_thread *scm_i_signal_delivery_thread;
+SCM_INTERNAL SCM scm_i_signal_delivery_thread;
 
 #endif  /* SCM_SCMSIGS_H */
diff --git a/libguile/threads.c b/libguile/threads.c
index ca6403cb2..e2bdd7007 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1681,18 +1681,19 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
 	    "Return a list of all threads.")
 #define FUNC_NAME s_scm_all_threads
 {
-  /* We can not allocate while holding the thread_admin_mutex because
-     of the way GC is done.
-  */
-  int n = thread_count;
   scm_thread *t;
-  SCM list = scm_c_make_list (n, SCM_UNSPECIFIED), *l;
 
   scm_i_pthread_mutex_lock (&thread_admin_mutex);
-  l = &list;
+
+  int n = thread_count;
+  SCM list = scm_c_make_list (n, SCM_UNSPECIFIED);
+  SCM *l = &list;
+
   for (t = all_threads; t && n > 0; t = t->next_thread)
     {
-      if (t != scm_i_signal_delivery_thread)
+      if (!t->exited
+          && (scm_is_false (scm_i_signal_delivery_thread)
+              || (!scm_is_eq (t->handle, scm_i_signal_delivery_thread))))
 	{
 	  SCM_SETCAR (*l, t->handle);
 	  l = SCM_CDRLOC (*l);
@@ -1700,7 +1701,9 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
       n--;
     }
   *l = SCM_EOL;
+
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
   return list;
 }
 #undef FUNC_NAME
diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
index 17bb59a18..ece0d7989 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,7 +1,6 @@
 ## Process this file with automake to produce Makefile.in.
 ##
-## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-##   2011, 2012, 2013, 2014, 2020, 2021, 2022 Free Software Foundation, Inc.
+## Copyright 2003-2014, 2020-2023 Free Software Foundation, Inc.
 ##
 ## This file is part of GUILE.
 ##
@@ -96,6 +95,9 @@ EXTRA_DIST += test-language.el test-language.js
 check_SCRIPTS += test-guild-compile
 TESTS += test-guild-compile
 
+check_SCRIPTS += test-sigaction-fork
+TESTS += test-sigaction-fork
+
 check_SCRIPTS += test-signal-fork
 TESTS += test-signal-fork
 
diff --git a/test-suite/standalone/test-sigaction-fork b/test-suite/standalone/test-sigaction-fork
new file mode 100755
index 000000000..25b62f1e7
--- /dev/null
+++ b/test-suite/standalone/test-sigaction-fork
@@ -0,0 +1,85 @@
+#!/bin/sh
+exec guile -q -s "$0" "$@"
+!#
+;;; test-sigaction-fork --- Signal thread vs. fork, again.
+;;;
+;;; Copyright (C) 2024 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Test the bug described at <https://bugs.gnu.org/68087>: the signal
+;;; thread would not be restarted after a call to 'primitive-fork',
+;;; leading signals to be silently ignored.
+
+(use-modules (ice-9 match))
+
+(define signals-handled
+  ;; List of signals handled.
+  '())
+
+(define parent
+  ;; PID of the parent process.
+  (getpid))
+
+(unless (provided? 'fork)
+  (exit 77))
+
+;; This call spawns the signal delivery thread as a side effect.
+(sigaction SIGALRM
+  (lambda (signal)
+    (call-with-blocked-asyncs
+     (lambda ()
+       (set! signals-handled
+             (cons `(first-handler . ,(getpid))
+                   signals-handled))))))
+
+(kill (getpid) SIGALRM)
+(while (null? signals-handled)                    ;let the async run
+  (sleep 1))
+
+(match (primitive-fork)
+  (0
+   (pk 'child (getpid) signals-handled)
+   (kill (getpid) SIGALRM)                        ;first handler
+   (sleep 1)                                      ;let the async run
+   (sigaction SIGALRM
+     (lambda (signal)
+       (call-with-blocked-asyncs
+        (lambda ()
+          (set! signals-handled
+                (cons `(second-handler . ,(getpid))
+                      signals-handled))))))
+   (kill (getpid) SIGALRM)           ;second handler
+   (sleep 1)                         ;give asyncs one more chance to run
+   (format (current-error-port) "signals handled by the child + parent: ~s~%"
+           signals-handled)
+   (exit (equal? signals-handled
+                 `((second-handler . ,(getpid))
+                   (first-handler . ,(getpid))
+                   (first-handler . ,parent)))))
+
+  (child
+   (kill (getpid) SIGALRM)           ;first handler
+   (sleep 1)                         ;give asyncs one more chance to run
+   (format (current-error-port) "signals handled by the parent: ~s~%"
+           signals-handled)
+   (exit (and (equal? signals-handled
+                      `((first-handler . ,parent)
+                        (first-handler . ,parent)))
+              (zero? (cdr (waitpid child)))))))
+
+;;; Local Variables:
+;;; mode: scheme
+;;; End:

base-commit: a09214fb867846b12f1eb8ed91423636e511c1c7
-- 
2.41.0