From 7bed4df49a6534511cc0c48f76996c957c012c30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 13 Jan 2015 17:22:39 +0100
Subject: [PATCH] services: user-processes: Really honor the grace delay.
* gnu/services/base.scm (user-processes-service): Change #:grace-delay
default value to 4. Define 'sleep*' and use it.
---
gnu/services/base.scm | 20 ++++++++++++++++----
1 file changed, 16 insertions(+), 4 deletions(-)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 402f5991a52..3a4be443301 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -193,7 +193,7 @@ (define %do-not-kill-file
;; the system. Typical example is user-space file systems.
"/etc/dmd/do-not-kill")
-(define* (user-processes-service requirements #:key (grace-delay 5))
+(define* (user-processes-service requirements #:key (grace-delay 4))
"Return the service that is responsible for terminating all the processes so
that the root file system can be re-mounted read-only, just before
rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM
@@ -230,6 +230,18 @@ (define omitted-pids
(@ (ice-9 rdelim) read-string))))
'()))
+ (define (now)
+ (car (gettimeofday)))
+
+ (define (sleep* n)
+ ;; Really sleep N seconds.
+ ;; Work around <http://bugs.gnu.org/19581>.
+ (define start (now))
+ (let loop ((elapsed 0))
+ (when (> n elapsed)
+ (sleep (- n elapsed))
+ (loop (- (now) start)))))
+
(define lset= (@ (srfi srfi-1) lset=))
(display "sending all processes the TERM signal\n")
@@ -238,7 +250,7 @@ (define lset= (@ (srfi srfi-1) lset=))
(begin
;; Easy: terminate all of them.
(kill -1 SIGTERM)
- (sleep #$grace-delay)
+ (sleep* #$grace-delay)
(kill -1 SIGKILL))
(begin
;; Kill them all except OMITTED-PIDS. XXX: We
@@ -246,7 +258,7 @@ (define lset= (@ (srfi srfi-1) lset=))
;; list of processes, like 'killall5' does, but
;; that seems unreliable.
(kill-except omitted-pids SIGTERM)
- (sleep #$grace-delay)
+ (sleep* #$grace-delay)
(kill-except omitted-pids SIGKILL)
(delete-file #$%do-not-kill-file)))
@@ -256,7 +268,7 @@ (define lset= (@ (srfi srfi-1) lset=))
(format #t "waiting for process termination\
(processes left: ~s)~%"
pids)
- (sleep 2)
+ (sleep* 2)
(wait))))
(display "all processes have been terminated\n")
--
GitLab