aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-08-28 09:54:03 +0200
committerLudovic Courtès <ludo@gnu.org>2017-08-28 09:56:33 +0200
commit7f090203d5fb033eb1b64778b03afad5bb35f5f2 (patch)
tree7c979b613c059c60eaafb75806bb362ae5947483 /gnu/services
parent06b8eae3d101b9c1f237de34f21091e085390e11 (diff)
downloadpatches-7f090203d5fb033eb1b64778b03afad5bb35f5f2.tar
patches-7f090203d5fb033eb1b64778b03afad5bb35f5f2.tar.gz
services: user-processes: Reap child processes.
Fixes <http://bugs.gnu.org/26931>. Reported by Leo Famulari <leo@famulari.name>. * gnu/services/base.scm (user-processes-service-type)[stop]: Add 'reap-children' loop. * gnu/tests/base.scm (run-halt-test): New procedure. (%test-halt): New variable.
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm13
1 files changed, 13 insertions, 0 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 54bd9ca2fb..5001298ab3 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -456,6 +456,19 @@ in KNOWN-MOUNT-POINTS when it is stopped."
(delete-file #$%do-not-kill-file)))
(let wait ()
+ ;; Reap children, if any, so that we don't end up with
+ ;; zombies and enter an infinite loop.
+ (let reap-children ()
+ (define result
+ (false-if-exception
+ (waitpid WAIT_ANY (if (null? omitted-pids)
+ 0
+ WNOHANG))))
+
+ (when (and (pair? result)
+ (not (zero? (car result))))
+ (reap-children)))
+
(let ((pids (processes)))
(unless (lset= = pids (cons 1 omitted-pids))
(format #t "waiting for process termination\