diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-11-15 20:11:35 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-11-15 20:11:35 +0100 |
commit | f056553c6b8ffa36f4ce9fb1c3602a8f4b1de242 (patch) | |
tree | 80c815216a3717cf00b615c9cb8840c113eaf79f /gnu/services/dbus.scm | |
parent | 2c9d34166983565120f831284df57a07e2edd2f9 (diff) | |
parent | 528b52390d216d8a8cd13dfcd1e6e40a6448e6c2 (diff) | |
download | guix-f056553c6b8ffa36f4ce9fb1c3602a8f4b1de242.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'gnu/services/dbus.scm')
-rw-r--r-- | gnu/services/dbus.scm | 48 |
1 files changed, 29 insertions, 19 deletions
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 35d7ff3c9c..7b3c8100e2 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -86,6 +86,19 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (use-modules (sxml simple) (srfi srfi-1)) + (define-syntax directives + (syntax-rules () + ;; Expand the given directives (SXML expressions) only if their + ;; key names a file that exists. + ((_ (name directory) rest ...) + (let ((dir directory)) + (if (file-exists? dir) + `((name ,dir) + ,@(directives rest ...)) + (directives rest ...)))) + ((_) + '()))) + (define (services->sxml services) ;; Return the SXML 'includedir' clauses for DIRS. `(busconfig @@ -98,10 +111,13 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (servicedir "/etc/dbus-1/system-services") ,@(append-map (lambda (dir) - `((includedir - ,(string-append dir "/etc/dbus-1/system.d")) - (servicedir ;for '.service' files - ,(string-append dir "/share/dbus-1/services")))) + (directives + (includedir + (string-append dir "/etc/dbus-1/system.d")) + (includedir + (string-append dir "/share/dbus-1/system.d")) + (servicedir ;for '.service' files + (string-append dir "/share/dbus-1/services")))) services))) (mkdir #$output) @@ -160,18 +176,9 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (unless (file-exists? "/etc/machine-id") (format #t "creating /etc/machine-id...~%") - (let ((prog (string-append #$(dbus-configuration-dbus config) - "/bin/dbus-uuidgen"))) - ;; XXX: We can't use 'system' because the initrd's - ;; guile system(3) only works when 'sh' is in $PATH. - (let ((pid (primitive-fork))) - (if (zero? pid) - (call-with-output-file "/etc/machine-id" - (lambda (port) - (close-fdes 1) - (dup2 (port->fdes port) 1) - (execl prog))) - (waitpid pid))))))) + (invoke (string-append #$(dbus-configuration-dbus config) + "/bin/dbus-uuidgen") + "--ensure=/etc/machine-id")))) (define dbus-shepherd-service (match-lambda @@ -179,10 +186,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (list (shepherd-service (documentation "Run the D-Bus system daemon.") (provision '(dbus-system)) - (requirement '(user-processes)) + (requirement '(user-processes syslogd)) (start #~(make-forkexec-constructor (list (string-append #$dbus "/bin/dbus-daemon") - "--nofork" "--system") + "--nofork" "--system" "--syslog-only") #:pid-file "/var/run/dbus/pid")) (stop #~(make-kill-destructor))))))) @@ -213,7 +220,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (append (dbus-configuration-services config) services))))) - (default-value (dbus-configuration)))) + (default-value (dbus-configuration)) + (description "Run the system-wide D-Bus inter-process message +bus. It allows programs and daemons to communicate and is also responsible +for spawning (@dfn{activating}) D-Bus services on demand."))) (define* (dbus-service #:key (dbus dbus) (services '())) "Return a service that runs the \"system bus\", using @var{dbus}, with |