mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-23 21:17:11 -05:00
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.
This commit is contained in:
Ludovic Courtès
parent
9d0b9c7c6c
commit
10c413685f
2 changed files with 126 additions and 124 deletions
|
|
@ -61,11 +61,11 @@ (define-module (gnu services base)
|
|||
#: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 @@ (define-module (gnu services base)
|
|||
;;; 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.
|
||||
|
|
|
|||
|
|
@ -63,7 +63,9 @@ (define-module (gnu services shepherd)
|
|||
|
||||
shepherd-service-lookup-procedure
|
||||
shepherd-service-back-edges
|
||||
shepherd-service-upgrade))
|
||||
shepherd-service-upgrade
|
||||
|
||||
user-processes-service-type))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -415,4 +417,126 @@ (define to-unload
|
|||
|
||||
(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
|
||||
|
|
|
|||
Loading…
Reference in a new issue