aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm124
-rw-r--r--gnu/services/sddm.scm2
-rw-r--r--gnu/services/shepherd.scm126
3 files changed, 127 insertions, 125 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 08ab5970dc..a532e884c3 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.
;;;
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index 1921afce95..59f8b16985 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -170,7 +170,7 @@ Relogin=" (if (sddm-configuration-relogin? config)
(list (shepherd-service
(documentation "SDDM display manager.")
(requirement '(user-processes))
- (provision '(display-manager))
+ (provision '(xorg-server display-manager))
(start #~(make-forkexec-constructor #$sddm-command))
(stop #~(make-kill-destructor)))))
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 9906ae43c4..e99458da43 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:
;;;
@@ -415,4 +417,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
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-25 01:04:16 +0000