02/07: services: Move 'user-processes' to (gnu services shepherd).

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 10c413685f13af12fa2bb34796db82e1f52b47af
Author: Ludovic Courtès <address@hidden>
AuthorDate: Fri Apr 17 12:45:54 2020 +0200

    services: Move 'user-processes' to (gnu services shepherd).
    
    * gnu/services/base.scm (%do-not-kill-file)
    (user-processes-shepherd-service, user-processes-service-type): Move
    to...
    * gnu/services/shepherd.scm: ... here.
---
 gnu/services/base.scm     | 124 +--------------------------------------------
 gnu/services/shepherd.scm | 126 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 126 insertions(+), 124 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index cb556e8..094bc52 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -61,11 +61,11 @@
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:re-export (user-processes-service-type)       ;backwards compatibility
   #:export (fstab-service-type
             root-file-system-service
             file-system-service-type
             swap-service
-            user-processes-service-type
             host-name-service
             console-keymap-service
             %default-console-font
@@ -187,128 +187,6 @@
 
 
 ;;;
-;;; User processes.
-;;;
-
-(define %do-not-kill-file
-  ;; Name of the file listing PIDs of processes that must survive when halting
-  ;; the system.  Typical example is user-space file systems.
-  "/etc/shepherd/do-not-kill")
-
-(define (user-processes-shepherd-service requirements)
-  "Return the 'user-processes' Shepherd service with dependencies on
-REQUIREMENTS (a list of service names).
-
-This is a synchronization point used to make sure user processes and daemons
-get started only after crucial initial services have been started---file
-system mounts, etc.  This is similar to the 'sysvinit' target in systemd."
-  (define grace-delay
-    ;; Delay after sending SIGTERM and before sending SIGKILL.
-    4)
-
-  (list (shepherd-service
-         (documentation "When stopped, terminate all user processes.")
-         (provision '(user-processes))
-         (requirement requirements)
-         (start #~(const #t))
-         (stop #~(lambda _
-                   (define (kill-except omit signal)
-                     ;; Kill all the processes with SIGNAL except those listed
-                     ;; in OMIT and the current process.
-                     (let ((omit (cons (getpid) omit)))
-                       (for-each (lambda (pid)
-                                   (unless (memv pid omit)
-                                     (false-if-exception
-                                      (kill pid signal))))
-                                 (processes))))
-
-                   (define omitted-pids
-                     ;; List of PIDs that must not be killed.
-                     (if (file-exists? #$%do-not-kill-file)
-                         (map string->number
-                              (call-with-input-file #$%do-not-kill-file
-                                (compose string-tokenize
-                                         (@ (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")
-
-                   (if (null? omitted-pids)
-                       (begin
-                         ;; Easy: terminate all of them.
-                         (kill -1 SIGTERM)
-                         (sleep* #$grace-delay)
-                         (kill -1 SIGKILL))
-                       (begin
-                         ;; Kill them all except OMITTED-PIDS.  XXX: We would
-                         ;; like to (kill -1 SIGSTOP) to get a fixed list of
-                         ;; processes, like 'killall5' does, but that seems
-                         ;; unreliable.
-                         (kill-except omitted-pids SIGTERM)
-                         (sleep* #$grace-delay)
-                         (kill-except omitted-pids SIGKILL)
-                         (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\
- (processes left: ~s)~%"
-                                 pids)
-                         (sleep* 2)
-                         (wait))))
-
-                   (display "all processes have been terminated\n")
-                   #f))
-         (respawn? #f))))
-
-(define user-processes-service-type
-  (service-type
-   (name 'user-processes)
-   (extensions (list (service-extension shepherd-root-service-type
-                                        user-processes-shepherd-service)))
-   (compose concatenate)
-   (extend append)
-
-   ;; The value is the list of Shepherd services 'user-processes' depends on.
-   ;; Extensions can add new services to this list.
-   (default-value '())
-
-   (description "The @code{user-processes} service 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 after a few
-seconds after @code{SIGTERM} has been sent are terminated with
-@code{SIGKILL}.")))
-
-
-;;;
 ;;; File systems.
 ;;;
 
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 9906ae4..e99458d 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -63,7 +63,9 @@
 
             shepherd-service-lookup-procedure
             shepherd-service-back-edges
-            shepherd-service-upgrade))
+            shepherd-service-upgrade
+
+            user-processes-service-type))
 
 ;;; Commentary:
 ;;;
@@ -415,4 +417,126 @@ need to be restarted to complete their upgrade."
 
   (values to-unload to-restart))
 
+
+;;;
+;;; User processes.
+;;;
+
+(define %do-not-kill-file
+  ;; Name of the file listing PIDs of processes that must survive when halting
+  ;; the system.  Typical example is user-space file systems.
+  "/etc/shepherd/do-not-kill")
+
+(define (user-processes-shepherd-service requirements)
+  "Return the 'user-processes' Shepherd service with dependencies on
+REQUIREMENTS (a list of service names).
+
+This is a synchronization point used to make sure user processes and daemons
+get started only after crucial initial services have been started---file
+system mounts, etc.  This is similar to the 'sysvinit' target in systemd."
+  (define grace-delay
+    ;; Delay after sending SIGTERM and before sending SIGKILL.
+    4)
+
+  (list (shepherd-service
+         (documentation "When stopped, terminate all user processes.")
+         (provision '(user-processes))
+         (requirement requirements)
+         (start #~(const #t))
+         (stop #~(lambda _
+                   (define (kill-except omit signal)
+                     ;; Kill all the processes with SIGNAL except those listed
+                     ;; in OMIT and the current process.
+                     (let ((omit (cons (getpid) omit)))
+                       (for-each (lambda (pid)
+                                   (unless (memv pid omit)
+                                     (false-if-exception
+                                      (kill pid signal))))
+                                 (processes))))
+
+                   (define omitted-pids
+                     ;; List of PIDs that must not be killed.
+                     (if (file-exists? #$%do-not-kill-file)
+                         (map string->number
+                              (call-with-input-file #$%do-not-kill-file
+                                (compose string-tokenize
+                                         (@ (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")
+
+                   (if (null? omitted-pids)
+                       (begin
+                         ;; Easy: terminate all of them.
+                         (kill -1 SIGTERM)
+                         (sleep* #$grace-delay)
+                         (kill -1 SIGKILL))
+                       (begin
+                         ;; Kill them all except OMITTED-PIDS.  XXX: We would
+                         ;; like to (kill -1 SIGSTOP) to get a fixed list of
+                         ;; processes, like 'killall5' does, but that seems
+                         ;; unreliable.
+                         (kill-except omitted-pids SIGTERM)
+                         (sleep* #$grace-delay)
+                         (kill-except omitted-pids SIGKILL)
+                         (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\
+ (processes left: ~s)~%"
+                                 pids)
+                         (sleep* 2)
+                         (wait))))
+
+                   (display "all processes have been terminated\n")
+                   #f))
+         (respawn? #f))))
+
+(define user-processes-service-type
+  (service-type
+   (name 'user-processes)
+   (extensions (list (service-extension shepherd-root-service-type
+                                        user-processes-shepherd-service)))
+   (compose concatenate)
+   (extend append)
+
+   ;; The value is the list of Shepherd services 'user-processes' depends on.
+   ;; Extensions can add new services to this list.
+   (default-value '())
+
+   (description "The @code{user-processes} service 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 after a few
+seconds after @code{SIGTERM} has been sent are terminated with
+@code{SIGKILL}.")))
+
 ;;; shepherd.scm ends here