me/guix
Archived
1
0
Fork 0
Code Activity

services: 'user-processes-service-type' can now be extended.

Browse source 
* gnu/services/base.scm (user-processes-shepherd-service): New
procedure, taken from former 'user-processes-service-type'.  Add
REQUIREMENTS argument; remove GRACE-DELAY argument.
(user-processes-service-type): Redefine in terms of 'service-type'.
(user-processes-service): Remove.
(file-system-service-type): Extend USER-PROCESSES-SERVICE-TYPE.
* gnu/system.scm (essential-services): Use USER-PROCESSES-SERVICE-TYPE
directly.
This commit is contained in:
Ludovic Courtès 2017-12-20 11:05:11 +01:00
parent 8785bd7759
commit 206a28d84a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 130 additions and 108 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

236
gnu/services/base.scm
View file

@ -57,7 +57,7 @@
file-system-service-type file-system-service-type
user-unmount-service user-unmount-service
swap-service swap-service
user-processes-service user-processes-service-type
host-name-service host-name-service
console-keymap-service console-keymap-service
%default-console-font %default-console-font
@ -162,6 +162,129 @@
;;; ;;;
;;; Code: ;;; 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. ;;; File systems.
@ -349,7 +472,11 @@ FILE-SYSTEM."
(list (service-extension shepherd-root-service-type (list (service-extension shepherd-root-service-type
file-system-shepherd-services) file-system-shepherd-services)
(service-extension fstab-service-type (service-extension fstab-service-type
identity))) identity)
;; Have 'user-processes' depend on 'file-systems'.
(service-extension user-processes-service-type
(const '(file-systems)))))
(compose concatenate) (compose concatenate)
(extend append) (extend append)
(description (description
@ -389,111 +516,6 @@ file systems, as well as corresponding @file{/etc/fstab} entries.")))
in KNOWN-MOUNT-POINTS when it is stopped." in KNOWN-MOUNT-POINTS when it is stopped."
(service user-unmount-service-type known-mount-points)) (service user-unmount-service-type known-mount-points))
(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-service-type
(shepherd-service-type
'user-processes
(lambda (grace-delay)
(shepherd-service
(documentation "When stopped, terminate all user processes.")
(provision '(user-processes))
(requirement '(file-systems))
(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 #: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
has been sent are terminated with SIGKILL.
The returned service will depend on 'file-systems', meaning that it is
considered started after all the auto-mount file systems have been mounted.
All the services that spawn processes must depend on this one so that they are
stopped before 'kill' is called."
(service user-processes-service-type grace-delay))
;;; ;;;
;;; Preserve entropy to seed /dev/urandom on boot. ;;; Preserve entropy to seed /dev/urandom on boot.

2
gnu/system.scm
View file

@ -449,7 +449,7 @@ a container or that of a \"bare metal\" system."
(other-fs (non-boot-file-system-service os)) (other-fs (non-boot-file-system-service os))
(unmount (user-unmount-service known-fs)) (unmount (user-unmount-service known-fs))
(swaps (swap-services os)) (swaps (swap-services os))
(procs (user-processes-service)) (procs (service user-processes-service-type))
(host-name (host-name-service (operating-system-host-name os))) (host-name (host-name-service (operating-system-host-name os)))
(entries (operating-system-directory-base-entries (entries (operating-system-directory-base-entries
os #:container? container?))) os #:container? container?)))