aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/dbus.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/dbus.scm')
-rw-r--r--gnu/services/dbus.scm105
1 files changed, 72 insertions, 33 deletions
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index e4ecd961c5..9b0d198683 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,7 +21,7 @@
#:use-module (gnu services)
#:use-module (gnu services dmd)
#:use-module (gnu system shadow)
- #:use-module (gnu packages glib)
+ #:use-module ((gnu packages glib) #:select (dbus/activation))
#:use-module (gnu packages admin)
#:use-module (guix gexp)
#:use-module (guix records)
@@ -37,13 +38,38 @@
dbus-configuration make-dbus-configuration
dbus-configuration?
(dbus dbus-configuration-dbus ;<package>
- (default dbus))
+ (default dbus/activation))
(services dbus-configuration-services ;list of <package>
(default '())))
-(define (dbus-configuration-directory dbus services)
- "Return a configuration directory for @var{dbus} that includes the
-@code{etc/dbus-1/system.d} directories of each package listed in
+(define (system-service-directory services)
+ "Return the system service directory, containing @code{.service} files for
+all the services that may be activated by the daemon."
+ (computed-file "dbus-system-services"
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+
+ (define files
+ (append-map (lambda (service)
+ (find-files (string-append
+ service
+ "/share/dbus-1/system-services")
+ "\\.service$"))
+ (list #$@services)))
+
+ (mkdir #$output)
+ (for-each (lambda (file)
+ (symlink file
+ (string-append #$output "/"
+ (basename file))))
+ files)
+ #t)
+ #:modules '((guix build utils))))
+
+(define (dbus-configuration-directory services)
+ "Return a directory contains the @code{system-local.conf} file for DBUS that
+includes the @code{etc/dbus-1/system.d} directories of each package listed in
@var{services}."
(define build
#~(begin
@@ -53,24 +79,27 @@
(define (services->sxml services)
;; Return the SXML 'includedir' clauses for DIRS.
`(busconfig
+ (servicehelper "/run/setuid-programs/dbus-daemon-launch-helper")
+
+ ;; First, the '.service' files of services subject to activation.
+ ;; We use a fixed location under /etc because the setuid helper
+ ;; looks for them in that location and nowhere else. See
+ ;; <https://bugs.freedesktop.org/show_bug.cgi?id=92458>.
+ (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"))
- (servicedir ;likewise, for auto-activation
- ,(string-append
- dir
- "/share/dbus-1/system-services"))))
+ (servicedir ;for '.service' files
+ ,(string-append dir "/share/dbus-1/services"))))
services)))
(mkdir #$output)
- (copy-file (string-append #$dbus "/etc/dbus-1/system.conf")
- (string-append #$output "/system.conf"))
- ;; The default 'system.conf' has an <includedir> clause for
- ;; 'system.d', so create it.
- (mkdir (string-append #$output "/system.d"))
+ ;; Provide /etc/dbus-1/system-services, which is where the setuid
+ ;; helper looks for system service files.
+ (symlink #$(system-service-directory services)
+ (string-append #$output "/system-services"))
;; 'system-local.conf' is automatically included by the default
;; 'system.conf', so this is where we stuff our own things.
@@ -81,6 +110,12 @@
(computed-file "dbus-configuration" build))
+(define (dbus-etc-files config)
+ "Return a list of FILES for @var{etc-service-type} to build the
+@code{/etc/dbus-1} directory."
+ (list `("dbus-1" ,(dbus-configuration-directory
+ (dbus-configuration-services config)))))
+
(define %dbus-accounts
;; Accounts used by the system bus.
(list (user-group (name "messagebus") (system? #t))
@@ -92,6 +127,12 @@
(home-directory "/var/run/dbus")
(shell #~(string-append #$shadow "/sbin/nologin")))))
+(define dbus-setuid-programs
+ ;; Return the file name of the setuid program that we need.
+ (match-lambda
+ (($ <dbus-configuration> dbus services)
+ (list #~(string-append #$dbus "/libexec/dbus-daemon-launch-helper")))))
+
(define (dbus-activation config)
"Return an activation gexp for D-Bus using @var{config}."
#~(begin
@@ -120,18 +161,15 @@
(define dbus-dmd-service
(match-lambda
- (($ <dbus-configuration> dbus services)
- (let ((conf (dbus-configuration-directory dbus services)))
- (list (dmd-service
- (documentation "Run the D-Bus system daemon.")
- (provision '(dbus-system))
- (requirement '(user-processes))
- (start #~(make-forkexec-constructor
- (list (string-append #$dbus "/bin/dbus-daemon")
- "--nofork"
- (string-append "--config-file=" #$conf
- "/system.conf"))))
- (stop #~(make-kill-destructor))))))))
+ (($ <dbus-configuration> dbus)
+ (list (dmd-service
+ (documentation "Run the D-Bus system daemon.")
+ (provision '(dbus-system))
+ (requirement '(user-processes))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$dbus "/bin/dbus-daemon")
+ "--nofork" "--system")))
+ (stop #~(make-kill-destructor)))))))
(define dbus-root-service-type
(service-type (name 'dbus)
@@ -140,14 +178,15 @@
dbus-dmd-service)
(service-extension activation-service-type
dbus-activation)
+ (service-extension etc-service-type
+ dbus-etc-files)
(service-extension account-service-type
- (const %dbus-accounts))))
+ (const %dbus-accounts))
+ (service-extension setuid-program-service-type
+ dbus-setuid-programs)))
;; Extensions consist of lists of packages (representing D-Bus
;; services) that we just concatenate.
- ;;
- ;; FIXME: We need 'dbus-daemon-launch-helper' to be
- ;; setuid-root for auto-activation to work.
(compose concatenate)
;; The service's parameters field is extended by augmenting
@@ -159,7 +198,7 @@
(append (dbus-configuration-services config)
services)))))))
-(define* (dbus-service #:key (dbus dbus) (services '()))
+(define* (dbus-service #:key (dbus dbus/activation) (services '()))
"Return a service that runs the \"system bus\", using @var{dbus}, with
support for @var{services}.