From 10c413685f13af12fa2bb34796db82e1f52b47af Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 17 Apr 2020 12:45:54 +0200
Subject: 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 +-------------------------------------------------
 1 file changed, 1 insertion(+), 123 deletions(-)

(limited to 'gnu/services/base.scm')

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index cb556e87bc..094bc5297e 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
@@ -185,128 +185,6 @@
 ;;; Code:
 
 
-
-;;;
-;;; 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.
-- 
cgit 1.4.1