diff options
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r-- | gnu/services/base.scm | 124 |
1 files changed, 1 insertions, 123 deletions
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 @@ -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. ;;; |