diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-05-01 19:36:10 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-05-05 22:44:31 +0200 |
| commit | fe1a39d319258c26fb9bcedc2fd337a9e2f40df9 (patch) | |
| tree | abfd43f6b00b799c447ec256ea709bf4e84d5867 /gnu/services/dbus.scm | |
| parent | 8a629613d1eadb0f3f6fb1e5ce65b484745b30a3 (diff) | |
services: Group desktop services in (gnu services desktop).
* gnu/services/colord.scm, gnu/services/dbus.scm,
gnu/services/upower.scm: Remove.
* gnu/services/desktop.scm: New file, with contents taken from the above
files.
* gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly.
* doc/guix.texi (Desktop Services): New section.
(Various Services): Move colord-service and upower-service from
here to "Desktop Services".
Diffstat (limited to 'gnu/services/dbus.scm')
| -rw-r--r-- | gnu/services/dbus.scm | 127 |
1 files changed, 0 insertions, 127 deletions
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm deleted file mode 100644 index 8f3b3509517..00000000000 --- a/gnu/services/dbus.scm +++ /dev/null | |||
| @@ -1,127 +0,0 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | ||
| 2 | ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> | ||
| 3 | ;;; | ||
| 4 | ;;; This file is part of GNU Guix. | ||
| 5 | ;;; | ||
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | ||
| 7 | ;;; under the terms of the GNU General Public License as published by | ||
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | ||
| 9 | ;;; your option) any later version. | ||
| 10 | ;;; | ||
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | ||
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 14 | ;;; GNU General Public License for more details. | ||
| 15 | ;;; | ||
| 16 | ;;; You should have received a copy of the GNU General Public License | ||
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | ||
| 18 | |||
| 19 | (define-module (gnu services dbus) | ||
| 20 | #:use-module (gnu services) | ||
| 21 | #:use-module (gnu system shadow) | ||
| 22 | #:use-module (gnu packages glib) | ||
| 23 | #:use-module (gnu packages admin) | ||
| 24 | #:use-module (guix monads) | ||
| 25 | #:use-module (guix store) | ||
| 26 | #:use-module (guix gexp) | ||
| 27 | #:export (dbus-service)) | ||
| 28 | |||
| 29 | ;;; Commentary: | ||
| 30 | ;;; | ||
| 31 | ;;; This module supports the configuration of the D-Bus message bus | ||
| 32 | ;;; (http://dbus.freedesktop.org/). D-Bus is an inter-process communication | ||
| 33 | ;;; facility. Its "system bus" is used to allow system services to | ||
| 34 | ;;; communicate and be notified of system-wide events. | ||
| 35 | ;;; | ||
| 36 | ;;; Code: | ||
| 37 | |||
| 38 | (define (dbus-configuration-directory dbus services) | ||
| 39 | "Return a configuration directory for @var{dbus} that includes the | ||
| 40 | @code{etc/dbus-1/system.d} directories of each package listed in | ||
| 41 | @var{services}." | ||
| 42 | (define build | ||
| 43 | #~(begin | ||
| 44 | (use-modules (sxml simple) | ||
| 45 | (srfi srfi-1)) | ||
| 46 | |||
| 47 | (define (services->sxml services) | ||
| 48 | ;; Return the SXML 'includedir' clauses for DIRS. | ||
| 49 | `(busconfig | ||
| 50 | ,@(append-map (lambda (dir) | ||
| 51 | `((includedir | ||
| 52 | ,(string-append dir "/etc/dbus-1/system.d")) | ||
| 53 | (servicedir ;for '.service' files | ||
| 54 | ,(string-append dir "/share/dbus-1/services")))) | ||
| 55 | services))) | ||
| 56 | |||
| 57 | (mkdir #$output) | ||
| 58 | (copy-file (string-append #$dbus "/etc/dbus-1/system.conf") | ||
| 59 | (string-append #$output "/system.conf")) | ||
| 60 | |||
| 61 | ;; The default 'system.conf' has an <includedir> clause for | ||
| 62 | ;; 'system.d', so create it. | ||
| 63 | (mkdir (string-append #$output "/system.d")) | ||
| 64 | |||
| 65 | ;; 'system-local.conf' is automatically included by the default | ||
| 66 | ;; 'system.conf', so this is where we stuff our own things. | ||
| 67 | (call-with-output-file (string-append #$output "/system-local.conf") | ||
| 68 | (lambda (port) | ||
| 69 | (sxml->xml (services->sxml (list #$@services)) | ||
| 70 | port))))) | ||
| 71 | |||
| 72 | (gexp->derivation "dbus-configuration" build)) | ||
| 73 | |||
| 74 | (define* (dbus-service services #:key (dbus dbus)) | ||
| 75 | "Return a service that runs the system bus, using @var{dbus}, with support | ||
| 76 | for @var{services}. | ||
| 77 | |||
| 78 | @var{services} must be a list of packages that provide an | ||
| 79 | @file{etc/dbus-1/system.d} directory containing additional D-Bus configuration | ||
| 80 | and policy files. For example, to allow avahi-daemon to use the system bus, | ||
| 81 | @var{services} must be equal to @code{(list avahi)}." | ||
| 82 | (mlet %store-monad ((conf (dbus-configuration-directory dbus services))) | ||
| 83 | (return | ||
| 84 | (service | ||
| 85 | (documentation "Run the D-Bus system daemon.") | ||
| 86 | (provision '(dbus-system)) | ||
| 87 | (requirement '(user-processes)) | ||
| 88 | (start #~(make-forkexec-constructor | ||
| 89 | (list (string-append #$dbus "/bin/dbus-daemon") | ||
| 90 | "--nofork" | ||
| 91 | (string-append "--config-file=" #$conf "/system.conf")))) | ||
| 92 | (stop #~(make-kill-destructor)) | ||
| 93 | (user-groups (list (user-group | ||
| 94 | (name "messagebus") | ||
| 95 | (system? #t)))) | ||
| 96 | (user-accounts (list (user-account | ||
| 97 | (name "messagebus") | ||
| 98 | (group "messagebus") | ||
| 99 | (system? #t) | ||
| 100 | (comment "D-Bus system bus user") | ||
| 101 | (home-directory "/var/run/dbus") | ||
| 102 | (shell | ||
| 103 | #~(string-append #$shadow "/sbin/nologin"))))) | ||
| 104 | (activate #~(begin | ||
| 105 | (use-modules (guix build utils)) | ||
| 106 | |||
| 107 | (mkdir-p "/var/run/dbus") | ||
| 108 | |||
| 109 | (let ((user (getpwnam "messagebus"))) | ||
| 110 | (chown "/var/run/dbus" | ||
| 111 | (passwd:uid user) (passwd:gid user))) | ||
| 112 | |||
| 113 | (unless (file-exists? "/etc/machine-id") | ||
| 114 | (format #t "creating /etc/machine-id...~%") | ||
| 115 | (let ((prog (string-append #$dbus "/bin/dbus-uuidgen"))) | ||
| 116 | ;; XXX: We can't use 'system' because the initrd's | ||
| 117 | ;; guile system(3) only works when 'sh' is in $PATH. | ||
| 118 | (let ((pid (primitive-fork))) | ||
| 119 | (if (zero? pid) | ||
| 120 | (call-with-output-file "/etc/machine-id" | ||
| 121 | (lambda (port) | ||
| 122 | (close-fdes 1) | ||
| 123 | (dup2 (port->fdes port) 1) | ||
| 124 | (execl prog))) | ||
| 125 | (waitpid pid))))))))))) | ||
| 126 | |||
| 127 | ;;; dbus.scm ends here | ||
