aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-17 09:13:51 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-17 09:19:48 +0200
commitd656c14ec9ed9ec68abeb68e98e9eaa602d9e11e (patch)
tree630dca3e5fd543f09a26d73494780a5e1ec6e7a7
parent66d5d8c072dcb90ad4e8fafe9c0ec86efff4c499 (diff)
downloadpatches-d656c14ec9ed9ec68abeb68e98e9eaa602d9e11e.tar
patches-d656c14ec9ed9ec68abeb68e98e9eaa602d9e11e.tar.gz
services: user-processes: Wait for complete process termination.
* gnu/services/base.scm (user-processes-service): Add 'wait' loop.
-rw-r--r--gnu/services/base.scm11
1 files changed, 11 insertions, 0 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3b85363fe2..9bc78bd1ae 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -182,6 +182,8 @@ stopped before 'kill' is called."
(@ (ice-9 rdelim) read-string))))
'()))
+ (define lset= (@ (srfi srfi-1) lset=))
+
;; When this happens, all the processes have been
;; killed, including 'deco', so DMD-OUTPUT-PORT and
;; thus CURRENT-OUTPUT-PORT are dangling.
@@ -206,6 +208,15 @@ stopped before 'kill' is called."
(kill-except omitted-pids SIGKILL)
(delete-file #$%do-not-kill-file)))
+ (let wait ()
+ (let ((pids (processes)))
+ (unless (lset= = pids (cons 1 omitted-pids))
+ (format #t "waiting for process termination\
+ (processes left: ~s)~%"
+ pids)
+ (sleep 2)
+ (wait))))
+
(display "all processes have been terminated\n")
#f))
(respawn? #f)))))