04/05: services: user-processes: Really honor the grace delay.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 7bed4df49a6534511cc0c48f76996c957c012c30
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 13 17:22:39 2015 +0100

    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 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 402f599..3a4be44 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -193,7 +193,7 @@ in KNOWN-MOUNT-POINTS when it is stopped."
   ;; 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 @@ stopped before 'kill' is called."
                                              (@ (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 @@ stopped before 'kill' is called."
                            (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 @@ stopped before 'kill' is called."
                              ;; 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 @@ stopped before 'kill' is called."
                              (format #t "waiting for process termination\
  (processes left: ~s)~%"
                                      pids)
-                             (sleep 2)
+                             (sleep* 2)
                              (wait))))
 
                        (display "all processes have been terminated\n")