[shepherd] 02/06: service: Terminate the progress group when the PID file doesn't show up.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 37dd896ce48908e4e3c56101fa07405070a6ce03
Author: Ludovic Courtès <address@hidden>
AuthorDate: Sat Apr 18 15:24:26 2020 +0200

    service: Terminate the progress group when the PID file doesn't show up.
    
    Fixes <https://bugs.gnu.org/40672>.
    
    Previously, we'd just terminate the initial process, which was typically
    already dead (because it had deamonized), thus potentially leaving the
    actual daemon running in the background.
    
    * modules/shepherd/service.scm (make-forkexec-constructor): When
    PID-FILE is true and 'read-pid-file' returns #f, pass (- PID) as the
    argument to 'kill'.
    * tests/pid-file.sh: Add test with 'test-daemonizes' service.
---
 modules/shepherd/service.scm |  3 ++-
 tests/pid-file.sh            | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 6d87c17..9088811 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -952,7 +952,8 @@ start."
                                       #:max-delay pid-file-timeout
                                       #:validate-pid? #t)
                   (#f
-                   (catch-system-error (kill pid SIGTERM))
+                   ;; Send SIGTERM to the whole process group.
+                   (catch-system-error (kill (- pid) SIGTERM))
                    #f)
                   ((? integer? pid)
                    pid))
diff --git a/tests/pid-file.sh b/tests/pid-file.sh
index 5db6bd8..b4b3129 100644
--- a/tests/pid-file.sh
+++ b/tests/pid-file.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Test the #:pid-file option of 'make-forkexec-constructor'.
-# Copyright © 2016, 2019 Ludovic Courtès <address@hidden>
+# Copyright © 2016, 2019, 2020 Ludovic Courtès <address@hidden>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -40,6 +40,15 @@ cat > "$conf"<<EOF
   ;; wpa_supplicant 2.7 for instance.
   '("$SHELL" "-c" "echo > $PWD/$service_pid ; sleep 1.5; echo \$\$ > 
$PWD/$service_pid ; exec sleep 600"))
 
+(define %daemon-command
+  ;; Emulate a daemon by forking and exiting right away.
+  (quasiquote ("guile" "-c"
+    ,(object->string '(when (zero? (primitive-fork))
+                        (call-with-output-file "$PWD/$service_pid"
+                          (lambda (port)
+                            (display (getpid) port)))
+                        (sleep 100))))))
+
 (register-services
  (make <service>
    ;; A service that never produces its PID file, yet leaves a process
@@ -63,6 +72,16 @@ cat > "$conf"<<EOF
                                       #:pid-file "$PWD/$service_pid"
                                       #:pid-file-timeout 6)
    #:stop  (make-kill-destructor)
+   #:respawn? #f)
+
+ (make <service>
+   ;; This one "daemonizes", fails to create a PID file, but leaves
+   ;; a child process behind it.
+   #:provides '(test-daemonizes)
+   #:start (make-forkexec-constructor %daemon-command
+                                      #:pid-file "/does-not-exist"
+                                      #:pid-file-timeout 6)
+   #:stop  (make-kill-destructor)
    #:respawn? #f))
 EOF
 
@@ -87,6 +106,18 @@ test -f "$service_pid"
 if kill -0 `cat "$service_pid"`
 then false; else true; fi
 
+# Now a service that "daemonizes" but fails to start.
+rm -f "$service_pid"
+if $herd start test-daemonizes
+then false; else true; fi
+
+$herd status test-daemonizes | grep stopped
+
+# Make sure it did not leave its child process behind it.
+test -f "$service_pid"
+if kill -0 `cat "$service_pid"`
+then false; else true; fi
+
 # Now start the service that works.
 $herd start test-works
 $herd status test-works | grep started