services: Add Shepherd 'configuration' action to various services.

* gnu/services/avahi.scm (avahi-shepherd-service): Add 'actions' field.
* gnu/services/base.scm (nscd-actions): Add call to
'shepherd-configuration-action'.
* gnu/services/desktop.scm (upower-shepherd-service): Add 'actions'
field.
(elogind-shepherd-service): Likewise.
* gnu/services/dict.scm (dicod-shepherd-service): Likewise.
* gnu/services/networking.scm (openntpd-shepherd-service): Likewise.
(tor-shepherd-service): Likewise.
* gnu/services/ssh.scm (openssh-shepherd-service): Likewise.
* gnu/services/web.scm (nginx-shepherd-service): Likewise.
* gnu/services/xorg.scm (gdm-shepherd-service): Likewise.
* gnu/tests/base.scm (run-basic-test)["nscd configuration action"]: New
test.
* doc/guix.texi (Services): Document it.
This commit is contained in:
Ludovic Courtès 2022-11-11 18:56:35 +01:00
parent ebc7de6a1e
commit 8d9647d8a7
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
10 changed files with 50 additions and 19 deletions

View file

@ -17654,6 +17654,17 @@ Service xorg-server has been stopped.
Service xorg-server has been started. Service xorg-server has been started.
@end example @end example
@cindex configuration, action for shepherd services
@cindex configuration file, of a shepherd service
For some services, @command{herd configuration} returns the name of the
service's configuration file, which can be handy to inspect its
configuration:
@example
# herd configuration sshd
/gnu/store/@dots{}-sshd_config
@end example
The following sections document the available services, starting with The following sections document the available services, starting with
the core services, that may be used in an @code{operating-system} the core services, that may be used in an @code{operating-system}
declaration. declaration.

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -137,7 +137,8 @@ (define (avahi-shepherd-service config)
#$@(if debug? #~("--debug") #~()) #$@(if debug? #~("--debug") #~())
"-f" #$config) "-f" #$config)
#:pid-file "/run/avahi-daemon/pid")) #:pid-file "/run/avahi-daemon/pid"))
(stop #~(make-kill-destructor)))))) (stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action config)))))))
(define avahi-service-type (define avahi-service-type
(let ((avahi-package (compose list avahi-configuration-avahi))) (let ((avahi-package (compose list avahi-configuration-avahi)))

View file

@ -1327,10 +1327,11 @@ (define (nscd-action-procedure nscd config option)
(loop))))))) (loop)))))))
(define (nscd-actions nscd config) (define (nscd-actions nscd config)
"Return Shepherd actions for NSCD." "Return Shepherd actions for NSCD using CONFIG its config file."
;; Make this functionality available as actions because that's a simple way ;; Make this functionality available as actions because that's a simple way
;; to run the right 'nscd' binary with the right config file. ;; to run the right 'nscd' binary with the right config file.
(list (shepherd-action (list (shepherd-configuration-action config)
(shepherd-action
(name 'statistics) (name 'statistics)
(documentation "Display statistics about nscd usage.") (documentation "Display statistics about nscd usage.")
(procedure (nscd-action-procedure nscd config "--statistics"))) (procedure (nscd-action-procedure nscd config "--statistics")))

View file

@ -273,7 +273,8 @@ (define (upower-shepherd-service config)
#:environment-variables #:environment-variables
(list (string-append "UPOWER_CONF_FILE_NAME=" (list (string-append "UPOWER_CONF_FILE_NAME="
#$config)))) #$config))))
(stop #~(make-kill-destructor)))))) (stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action config)))))))
(define upower-service-type (define upower-service-type
(let ((upower-package (compose list upower-configuration-upower))) (let ((upower-package (compose list upower-configuration-upower)))
@ -1168,6 +1169,9 @@ (module (file-append (elogind-package config)
(define (elogind-shepherd-service config) (define (elogind-shepherd-service config)
"Return a Shepherd service to start elogind according to @var{config}." "Return a Shepherd service to start elogind according to @var{config}."
(define config-file
(elogind-configuration-file config))
(list (shepherd-service (list (shepherd-service
(requirement '(dbus-system)) (requirement '(dbus-system))
(provision '(elogind)) (provision '(elogind))
@ -1176,9 +1180,9 @@ (define (elogind-shepherd-service config)
"/libexec/elogind/elogind")) "/libexec/elogind/elogind"))
#:environment-variables #:environment-variables
(list (string-append "ELOGIND_CONF_FILE=" (list (string-append "ELOGIND_CONF_FILE="
#$(elogind-configuration-file #$config-file))))
config))))) (stop #~(make-kill-destructor))
(stop #~(make-kill-destructor))))) (actions (list (shepherd-configuration-action config-file))))))
(define elogind-service-type (define elogind-service-type
(service-type (name 'elogind) (service-type (name 'elogind)

View file

@ -182,7 +182,8 @@ (define (dicod-shepherd-service config)
(stop #~(if (and (defined? 'make-inetd-destructor) (stop #~(if (and (defined? 'make-inetd-destructor)
#$(= 1 (length interfaces))) ;XXX #$(= 1 (length interfaces))) ;XXX
(make-inetd-destructor) (make-inetd-destructor)
(make-kill-destructor))))))) (make-kill-destructor)))
(actions (list (shepherd-configuration-action dicod.conf)))))))
(define dicod-service-type (define dicod-service-type
(service-type (service-type

View file

@ -652,7 +652,8 @@ (define ntpd.conf
;; while running, leading shepherd to disable it. To ;; while running, leading shepherd to disable it. To
;; prevent spamming stderr, redirect output to logfile. ;; prevent spamming stderr, redirect output to logfile.
#:log-file "/var/log/ntpd.log")) #:log-file "/var/log/ntpd.log"))
(stop #~(make-kill-destructor)))))) (stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action ntpd.conf)))))))
(define (openntpd-service-activation config) (define (openntpd-service-activation config)
"Return the activation gexp for CONFIG." "Return the activation gexp for CONFIG."
@ -1032,6 +1033,7 @@ (define (tor-shepherd-service config)
(list #$tor "-f" #$torrc) (list #$tor "-f" #$torrc)
#:user "tor" #:group "tor")) #:user "tor" #:group "tor"))
(stop #~(make-kill-destructor)) (stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action torrc)))
(documentation "Run the Tor anonymous network overlay.")))))))) (documentation "Run the Tor anonymous network overlay."))))))))
(define (tor-activation config) (define (tor-activation config)

View file

@ -524,9 +524,12 @@ (define port-number
(define max-connections (define max-connections
(openssh-configuration-max-connections config)) (openssh-configuration-max-connections config))
(define config-file
(openssh-config-file config))
(define openssh-command (define openssh-command
#~(list (string-append #$(openssh-configuration-openssh config) "/sbin/sshd") #~(list (string-append #$(openssh-configuration-openssh config) "/sbin/sshd")
"-D" "-f" #$(openssh-config-file config))) "-D" "-f" #$config-file))
(define inetd-style? (define inetd-style?
;; Whether to use 'make-inetd-constructor'. That procedure appeared in ;; Whether to use 'make-inetd-constructor'. That procedure appeared in
@ -568,6 +571,7 @@ (define ipv6-support?
(stop #~(if #$inetd-style? (stop #~(if #$inetd-style?
(make-inetd-destructor) (make-inetd-destructor)
(make-kill-destructor))) (make-kill-destructor)))
(actions (list (shepherd-configuration-action config-file)))
(auto-start? (openssh-auto-start? config))))) (auto-start? (openssh-auto-start? config)))))
(define (openssh-pam-services config) (define (openssh-pam-services config)

View file

@ -790,13 +790,11 @@ (define (nginx-shepherd-service config)
(nginx file run-directory shepherd-requirement) (nginx file run-directory shepherd-requirement)
(let* ((nginx-binary (file-append nginx "/sbin/nginx")) (let* ((nginx-binary (file-append nginx "/sbin/nginx"))
(pid-file (in-vicinity run-directory "pid")) (pid-file (in-vicinity run-directory "pid"))
(config-file (or file (default-nginx-config config)))
(nginx-action (nginx-action
(lambda args (lambda args
#~(lambda _ #~(lambda _
(invoke #$nginx-binary "-c" (invoke #$nginx-binary "-c" #$config-file #$@args)
#$(or file
(default-nginx-config config))
#$@args)
(match '#$args (match '#$args
(("-s" . _) #f) (("-s" . _) #f)
(_ (_
@ -817,6 +815,7 @@ (define (nginx-shepherd-service config)
(stop (nginx-action "-s" "stop")) (stop (nginx-action "-s" "stop"))
(actions (actions
(list (list
(shepherd-configuration-action config-file)
(shepherd-action (shepherd-action
(name 'reload) (name 'reload)
(documentation "Reload nginx configuration file and restart worker processes. (documentation "Reload nginx configuration file and restart worker processes.

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2017, 2019-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com> ;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
@ -1083,6 +1083,9 @@ (module "pam_permit.so")))))
(gdm-configuration-allow-empty-passwords? config)))) (gdm-configuration-allow-empty-passwords? config))))
(define (gdm-shepherd-service config) (define (gdm-shepherd-service config)
(define config-file
(gdm-configuration-file config))
(list (shepherd-service (list (shepherd-service
(documentation "Xorg display server (GDM)") (documentation "Xorg display server (GDM)")
(provision '(xorg-server)) (provision '(xorg-server))
@ -1095,9 +1098,7 @@ (define (gdm-shepherd-service config)
(list #$@(if (gdm-configuration-auto-suspend? config) (list #$@(if (gdm-configuration-auto-suspend? config)
#~() #~()
#~("DCONF_PROFILE=/etc/dconf/profile/gdm")) #~("DCONF_PROFILE=/etc/dconf/profile/gdm"))
(string-append (string-append "GDM_CUSTOM_CONF=" #$config-file)
"GDM_CUSTOM_CONF="
#$(gdm-configuration-file config))
(string-append (string-append
"GDM_DBUS_DAEMON=" "GDM_DBUS_DAEMON="
#$(gdm-configuration-dbus-daemon config)) #$(gdm-configuration-dbus-daemon config))
@ -1129,6 +1130,7 @@ (define (gdm-shepherd-service config)
"GDM_WAYLAND_SESSION=" "GDM_WAYLAND_SESSION="
#$(gdm-configuration-wayland-session config)))))) #$(gdm-configuration-wayland-session config))))))
(stop #~(make-kill-destructor)) (stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action config-file)))
(respawn? #t)))) (respawn? #t))))
(define gdm-polkit-rules (define gdm-polkit-rules

View file

@ -424,6 +424,12 @@ (define (entry->list entry)
(x (x
(pk 'failure x #f)))) (pk 'failure x #f))))
(test-assert "nscd configuration action"
(marionette-eval '(with-shepherd-action 'nscd ('configuration)
results
(file-exists? (car results)))
marionette))
(test-equal "nscd invalidate action" (test-equal "nscd invalidate action"
'(#t) ;one value, #t '(#t) ;one value, #t
(marionette-eval '(with-shepherd-action 'nscd ('invalidate "hosts") (marionette-eval '(with-shepherd-action 'nscd ('invalidate "hosts")