services: dbus: 'wrapped-dbus-service' accepts a list of variables.

* gnu/services/dbus.scm (wrapped-dbus-service): Replace 'variable' and
'value' by 'variables', and adjust code accordingly.
* gnu/services/desktop.scm (upower-dbus-service):
(geoclue-dbus-service, elogind-dbus-service): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2019-04-02 22:35:49 +02:00
parent f63861b5a6
commit aa071ca049
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 16 additions and 10 deletions

View File

@ -231,14 +231,20 @@ and policy files. For example, to allow avahi-daemon to use the system bus,
(dbus-configuration (dbus dbus) (dbus-configuration (dbus dbus)
(services services)))) (services services))))
(define (wrapped-dbus-service service program variable value) (define (wrapped-dbus-service service program variables)
"Return a wrapper for @var{service}, a package containing a D-Bus service, "Return a wrapper for @var{service}, a package containing a D-Bus service,
where @var{program} is wrapped such that environment variable @var{variable} where @var{program} is wrapped such that @var{variables}, a list of name/value
is set to @var{value} when the bus daemon launches it." tuples, are all set as environment variables when the bus daemon launches it."
(define wrapper (define wrapper
(program-file (string-append (package-name service) "-program-wrapper") (program-file (string-append (package-name service) "-program-wrapper")
#~(begin #~(begin
(setenv #$variable #$value) (use-modules (ice-9 match))
(for-each (match-lambda
((variable value)
(setenv variable value)))
'#$variables)
(apply execl (string-append #$service "/" #$program) (apply execl (string-append #$service "/" #$program)
(string-append #$service "/" #$program) (string-append #$service "/" #$program)
(cdr (command-line)))))) (cdr (command-line))))))

View File

@ -217,8 +217,8 @@
(define (upower-dbus-service config) (define (upower-dbus-service config)
(list (wrapped-dbus-service (upower-configuration-upower config) (list (wrapped-dbus-service (upower-configuration-upower config)
"libexec/upowerd" "libexec/upowerd"
"UPOWER_CONF_FILE_NAME" `(("UPOWER_CONF_FILE_NAME"
(upower-configuration-file config)))) ,(upower-configuration-file config))))))
(define (upower-shepherd-service config) (define (upower-shepherd-service config)
"Return a shepherd service for UPower with CONFIG." "Return a shepherd service for UPower with CONFIG."
@ -349,8 +349,8 @@ users are allowed."
(define (geoclue-dbus-service config) (define (geoclue-dbus-service config)
(list (wrapped-dbus-service (geoclue-configuration-geoclue config) (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
"libexec/geoclue" "libexec/geoclue"
"GEOCLUE_CONFIG_FILE" `(("GEOCLUE_CONFIG_FILE"
(geoclue-configuration-file config)))) ,(geoclue-configuration-file config))))))
(define %geoclue-accounts (define %geoclue-accounts
(list (user-group (name "geoclue") (system? #t)) (list (user-group (name "geoclue") (system? #t))
@ -702,8 +702,8 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
(define (elogind-dbus-service config) (define (elogind-dbus-service config)
(list (wrapped-dbus-service (elogind-package config) (list (wrapped-dbus-service (elogind-package config)
"libexec/elogind/elogind" "libexec/elogind/elogind"
"ELOGIND_CONF_FILE" `(("ELOGIND_CONF_FILE"
(elogind-configuration-file config)))) ,(elogind-configuration-file config))))))
(define (pam-extension-procedure config) (define (pam-extension-procedure config)
"Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM