summaryrefslogtreecommitdiff
path: root/gnu/services/base.scm
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-04-19 16:53:01 +0200
committerMarius Bakke <mbakke@fastmail.com>2020-04-19 16:53:01 +0200
commit7abe35febe4234609e14e169b6fcc0cbaf4c7119 (patch)
tree5a8307a28e0c0a6aeab21ce8b9d3487229522588 /gnu/services/base.scm
parent457ded48c54ba04489cb871d3ec6bda0c59bead7 (diff)
parent5c10d55206a4f7a9b932ff08512a4f50c1db35be (diff)
downloadpatches-7abe35febe4234609e14e169b6fcc0cbaf4c7119.tar
patches-7abe35febe4234609e14e169b6fcc0cbaf4c7119.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r--gnu/services/base.scm124
1 files changed, 1 insertions, 123 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 08ab5970dc..a532e884c3 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.
;;;