diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/dbus.scm | 105 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 50 |
2 files changed, 75 insertions, 80 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}. diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 69edc6d9bb..87d3eaa1b0 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -245,17 +245,6 @@ levels, with the given configuration settings. It implements the (home-directory "/var/empty") (shell #~(string-append #$shadow "/sbin/nologin"))))) -(define (colord-dmd-service colord) - "Return a dmd service for COLORD." - ;; TODO: Remove when D-Bus activation works. - (list (dmd-service - (documentation "Run the colord color management service.") - (provision '(colord-daemon)) - (requirement '(dbus-system udev)) - (start #~(make-forkexec-constructor - (list (string-append #$colord "/libexec/colord")))) - (stop #~(make-kill-destructor))))) - (define colord-service-type (service-type (name 'colord) (extensions @@ -263,8 +252,6 @@ levels, with the given configuration settings. It implements the (const %colord-accounts)) (service-extension activation-service-type (const %colord-activation)) - (service-extension dmd-root-service-type - colord-dmd-service) ;; Colord is a D-Bus service that dbus-daemon can ;; activate. @@ -343,23 +330,6 @@ users are allowed." "GEOCLUE_CONFIG_FILE" (geoclue-configuration-file config)))) -(define (geoclue-dmd-service config) - "Return a GeoClue dmd service for CONFIG." - ;; TODO: Remove when D-Bus activation works. - (let ((geoclue (geoclue-configuration-geoclue config)) - (config (geoclue-configuration-file config))) - (list (dmd-service - (documentation "Run the GeoClue location service.") - (provision '(geoclue-daemon)) - (requirement '(dbus-system)) - - (start #~(make-forkexec-constructor - (list (string-append #$geoclue "/libexec/geoclue")) - #:user "geoclue" - #:environment-variables - (list (string-append "GEOCLUE_CONFIG_FILE=" #$config)))) - (stop #~(make-kill-destructor)))))) - (define %geoclue-accounts (list (user-group (name "geoclue") (system? #t)) (user-account @@ -375,8 +345,6 @@ users are allowed." (extensions (list (service-extension dbus-root-service-type geoclue-dbus-service) - (service-extension dmd-root-service-type - geoclue-dmd-service) (service-extension account-service-type (const %geoclue-accounts)))))) @@ -426,18 +394,6 @@ site} for more information." (define %polkit-pam-services (list (unix-pam-service "polkitd"))) -(define (polkit-dmd-service polkit) - "Return the <dmd-service> for POLKIT." - ;; TODO: Remove when D-Bus activation works. - (list (dmd-service - (documentation "Run the polkit privilege management service.") - (provision '(polkit-daemon)) - (requirement '(dbus-system)) - - (start #~(make-forkexec-constructor - (list (string-append #$polkit "/lib/polkit-1/polkitd")))) - (stop #~(make-kill-destructor))))) - (define polkit-service-type ;; TODO: Make it extensible so it can collect policy files from other ;; services. @@ -448,9 +404,7 @@ site} for more information." (service-extension pam-root-service-type (const %polkit-pam-services)) (service-extension dbus-root-service-type - list) - (service-extension dmd-root-service-type - polkit-dmd-service))))) + list))))) (define* (polkit-service #:key (polkit polkit)) "Return a service that runs the @command{polkit} privilege management @@ -601,6 +555,8 @@ the system if the user is logged in locally." (define (elogind-dmd-service config) "Return a dmd service for elogind, using @var{config}." + ;; TODO: We could probably rely on service activation but the '.service' + ;; file currently contains an erroneous 'Exec' line. (let ((config-file (elogind-configuration-file config)) (elogind (elogind-package config))) (list (dmd-service |