From 576ac6155dcabea47dfdf69fb9a8cc07cecf9695 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 30 May 2020 19:32:43 +0200
Subject: [PATCH 3/3] service: 'fork+exec-command' blocks handled signals
 before forking.

This is a followup to d190773751ddeddbe0daa8e4a43f76b73c4fd7ac, which
addressed only SIGTERM instead of all of %PRECIOUS-SIGNALS.
Furthermore, setting the SIGTERM handler introduced a window in the
shepherd process during which SIGTERM instances would be lost.

* modules/shepherd/service.scm (%precious-signals): New variable.
(fork+exec-command): Remove calls to 'sigaction' for SIGTERM.  Wrap
'let' in 'with-blocked-signals'.  Restore default signal handlers in the
child before unblocking signals.
---
 modules/shepherd/service.scm | 53 ++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 27 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index f3ac32a..1bc77b1 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -870,6 +870,10 @@ false."
                   program (strerror (system-error-errno args)))
           (primitive-exit 1))))))))
 
+(define %precious-signals
+  ;; Signals that the shepherd process handles.
+  (list SIGCHLD SIGINT SIGHUP SIGTERM))
+
 (define* (fork+exec-command command
                             #:key
                             (user #f)
@@ -886,33 +890,28 @@ its PID."
     (sigaction SIGCHLD handle-SIGCHLD SA_NOCLDSTOP)
     (set! %sigchld-handler-installed? #t))
 
-  ;; When forking a process, the signal handlers are inherited, until it
-  ;; forks. If SIGTERM is received by the forked process, before it calls
-  ;; execv, the installed SIGTERM handler, stopping Shepherd will be called.
-  ;; To avoid this, save the SIGTERM handler, disable it, and restore it once,
-  ;; the process has been forked. This way, the forked process will use the
-  ;; default SIGTERM handler stopping the process.
-  (let ((term-handler (match (sigaction SIGTERM)
-                        ((proc . _)
-                         proc)))
-        (pid (and (sigaction SIGTERM SIG_DFL)
-                  (primitive-fork))))
-    (if (zero? pid)
-        (begin
-          ;; Unblock any signals that might have been blocked by the parent
-          ;; process if using 'signalfd'.
-          (unblock-signals (list SIGCHLD SIGINT SIGHUP SIGTERM))
-
-          (exec-command command
-                        #:user user
-                        #:group group
-                        #:log-file log-file
-                        #:directory directory
-                        #:file-creation-mask file-creation-mask
-                        #:environment-variables environment-variables))
-        (begin
-          ;; Restore the initial SIGTERM handler.
-          (sigaction SIGTERM term-handler)
+  ;; Child processes inherit signal handlers until they exec.  If one of
+  ;; %PRECIOUS-SIGNALS is received by the child before it execs, the installed
+  ;; handler, which stops shepherd, is called.  To avoid this, block signals
+  ;; so that the child process never executes those handlers.
+  (with-blocked-signals %precious-signals
+    (let ((pid (primitive-fork)))
+      (if (zero? pid)
+          (begin
+            ;; First restore the default handlers.
+            (for-each (cut sigaction <> SIG_DFL) %precious-signals)
+
+            ;; Unblock any signals that have been blocked by the parent
+            ;; process.
+            (unblock-signals %precious-signals)
+
+            (exec-command command
+                          #:user user
+                          #:group group
+                          #:log-file log-file
+                          #:directory directory
+                          #:file-creation-mask file-creation-mask
+                          #:environment-variables environment-variables))
           pid))))
 
 (define* (make-forkexec-constructor command
-- 
2.26.2