services: user-processes: Wait for complete process termination.

* gnu/services/base.scm (user-processes-service): Add 'wait' loop.
This commit is contained in:
Ludovic Courtès 2014-09-17 09:13:51 +02:00
parent 66d5d8c072
commit d656c14ec9
1 changed files with 11 additions and 0 deletions

View File

@ -182,6 +182,8 @@ stopped before 'kill' is called."
(@ (ice-9 rdelim) read-string)))) (@ (ice-9 rdelim) read-string))))
'())) '()))
(define lset= (@ (srfi srfi-1) lset=))
;; When this happens, all the processes have been ;; When this happens, all the processes have been
;; killed, including 'deco', so DMD-OUTPUT-PORT and ;; killed, including 'deco', so DMD-OUTPUT-PORT and
;; thus CURRENT-OUTPUT-PORT are dangling. ;; thus CURRENT-OUTPUT-PORT are dangling.
@ -206,6 +208,15 @@ stopped before 'kill' is called."
(kill-except omitted-pids SIGKILL) (kill-except omitted-pids SIGKILL)
(delete-file #$%do-not-kill-file))) (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") (display "all processes have been terminated\n")
#f)) #f))
(respawn? #f))))) (respawn? #f)))))