diff options
Diffstat (limited to 'gnu/services/shepherd.scm')
-rw-r--r-- | gnu/services/shepherd.scm | 138 |
1 files changed, 136 insertions, 2 deletions
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index d483ff1a15..2f30c6c907 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -63,7 +63,9 @@ shepherd-service-lookup-procedure shepherd-service-back-edges - shepherd-service-upgrade)) + shepherd-service-upgrade + + user-processes-service-type)) ;;; Commentary: ;;; @@ -269,7 +271,11 @@ and return the resulting '.go' file." (module-use! env (resolve-interface '(oop goops))) (module-use! env (resolve-interface '(shepherd service))) (compile-file #$file #:output-file #$output - #:env env)))))) + #:env env))) + + ;; It's faster to build locally than to download. + #:options '(#:local-build? #t + #:substitutable? #f)))) (define (shepherd-configuration-file services) "Return the shepherd configuration file for SERVICES." @@ -287,6 +293,12 @@ and return the resulting '.go' file." (default-environment-variables '("PATH=/run/current-system/profile/bin")) + ;; Booting off a DVD, especially on a slow machine, can make + ;; everything slow. Thus, increase the timeout compared to the + ;; default 5s in the Shepherd 0.7.0. See + ;; <https://bugs.gnu.org/40572>. + (default-pid-file-timeout 30) + ;; Arrange to spawn a REPL if something goes wrong. This is better ;; than a kernel panic. (call-with-error-handling @@ -404,4 +416,126 @@ need to be restarted to complete their upgrade." (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 |