mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -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 (srfi srfi-26)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
|
#:re-export (user-processes-service-type) ;backwards compatibility
|
||||||
#:export (fstab-service-type
|
#:export (fstab-service-type
|
||||||
root-file-system-service
|
root-file-system-service
|
||||||
file-system-service-type
|
file-system-service-type
|
||||||
swap-service
|
swap-service
|
||||||
user-processes-service-type
|
|
||||||
host-name-service
|
host-name-service
|
||||||
console-keymap-service
|
console-keymap-service
|
||||||
%default-console-font
|
%default-console-font
|
||||||
|
|
@ -185,128 +185,6 @@ (define-module (gnu services base)
|
||||||
;;; 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.
|
||||||
|
|
|
||||||
|
|
@ -63,7 +63,9 @@ (define-module (gnu services shepherd)
|
||||||
|
|
||||||
shepherd-service-lookup-procedure
|
shepherd-service-lookup-procedure
|
||||||
shepherd-service-back-edges
|
shepherd-service-back-edges
|
||||||
shepherd-service-upgrade))
|
shepherd-service-upgrade
|
||||||
|
|
||||||
|
user-processes-service-type))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -415,4 +417,126 @@ (define to-unload
|
||||||
|
|
||||||
(values to-unload to-restart))
|
(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
|
;;; shepherd.scm ends here
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue