tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-27 03:21:49 +02:00
Code Activity

Merge branch 'dbus-update'

Browse Source
This commit is contained in:
Ludovic Courtès
2015-10-31 15:11:58 +01:00
parent 375c610844 3c3e69728c
commit d9b9454c98
40 changed files with 1087 additions and 446 deletions
Download Patch File Download Diff File Expand all files Collapse all files
gnu/services/dbus.scm
+72 -33
View File
@@ -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}.
gnu/services/desktop.scm
+3 -47
View File
@@ -247,17 +247,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
@@ -265,8 +254,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.
@@ -345,23 +332,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
@@ -377,8 +347,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))))))
@@ -428,18 +396,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.
@@ -450,9 +406,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
@@ -603,6 +557,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