guix-devel/gnu/services/dbus.scm

127 lines
5.2 KiB
Scheme
Raw Normal View History

;;; GNU Guix --- Functional package management for GNU
monads: Move '%store-monad' and related procedures where they belong. This turns (guix monads) into a generic module for monads, and moves the store monad and related monadic procedures in their corresponding module. * guix/monads.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file, package-file, package->derivation, package->cross-derivation, origin->derivation, imported-modules, compiled, modules, built-derivations, run-with-store): Move to... * guix/store.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file): ... here. (%guile-for-build): New variable. (run-with-store): Moved from monads.scm. Remove default value for #:guile-for-build. * guix/packages.scm (default-guile): Export. (set-guile-for-build): New procedure. (package-file, package->derivation, package->cross-derivation, origin->derivation): Moved from monads.scm. * guix/derivations.scm (%guile-for-build): Remove. (imported-modules): Rename to... (%imported-modules): ... this. (compiled-modules): Rename to... (%compiled-modules): ... this. (built-derivations, imported-modules, compiled-modules): New procedures. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm, gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm, guix/gexp.scm, guix/git-download.scm, guix/profiles.scm, guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly. * guix/monad-repl.scm (default-guile-derivation): New procedure. (store-monad-language, run-in-store): Use it. * build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit 'set-guile-for-build' call. * guix/scripts/archive.scm (derivation-from-expression): Likewise. * guix/scripts/build.scm (options/resolve-packages): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * doc/guix.texi (The Store Monad): Adjust module names accordingly.
2015-01-14 13:34:52 +01:00
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services dbus)
#:use-module (gnu services)
#:use-module (gnu system shadow)
#:use-module (gnu packages glib)
#:use-module (guix monads)
monads: Move '%store-monad' and related procedures where they belong. This turns (guix monads) into a generic module for monads, and moves the store monad and related monadic procedures in their corresponding module. * guix/monads.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file, package-file, package->derivation, package->cross-derivation, origin->derivation, imported-modules, compiled, modules, built-derivations, run-with-store): Move to... * guix/store.scm (store-return, store-bind, %store-monad, store-lift, text-file, interned-file): ... here. (%guile-for-build): New variable. (run-with-store): Moved from monads.scm. Remove default value for #:guile-for-build. * guix/packages.scm (default-guile): Export. (set-guile-for-build): New procedure. (package-file, package->derivation, package->cross-derivation, origin->derivation): Moved from monads.scm. * guix/derivations.scm (%guile-for-build): Remove. (imported-modules): Rename to... (%imported-modules): ... this. (compiled-modules): Rename to... (%compiled-modules): ... this. (built-derivations, imported-modules, compiled-modules): New procedures. * gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm, gnu/services/dmd.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm, gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm, guix/gexp.scm, guix/git-download.scm, guix/profiles.scm, guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly. * guix/monad-repl.scm (default-guile-derivation): New procedure. (store-monad-language, run-in-store): Use it. * build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit 'set-guile-for-build' call. * guix/scripts/archive.scm (derivation-from-expression): Likewise. * guix/scripts/build.scm (options/resolve-packages): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * doc/guix.texi (The Store Monad): Adjust module names accordingly.
2015-01-14 13:34:52 +01:00
#:use-module (guix store)
#:use-module (guix gexp)
#:export (dbus-service))
;;; Commentary:
;;;
;;; This module supports the configuration of the D-Bus message bus
;;; (http://dbus.freedesktop.org/). D-Bus is an inter-process communication
;;; facility. Its "system bus" is used to allow system services to
;;; communicate and be notified of system-wide events.
;;;
;;; Code:
(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
@var{services}."
(define build
#~(begin
(use-modules (sxml simple)
(srfi srfi-1))
(define (services->sxml services)
;; Return the SXML 'includedir' clauses for DIRS.
`(busconfig
,@(append-map (lambda (dir)
`((includedir
,(string-append dir "/etc/dbus-1/system.d"))
(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"))
;; 'system-local.conf' is automatically included by the default
;; 'system.conf', so this is where we stuff our own things.
(call-with-output-file (string-append #$output "/system-local.conf")
(lambda (port)
(sxml->xml (services->sxml (list #$@services))
port)))))
(gexp->derivation "dbus-configuration" build))
(define* (dbus-service services #:key (dbus dbus))
"Return a service that runs the system bus, using @var{dbus}, with support
for @var{services}.
@var{services} must be a list of packages that provide an
@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
and policy files. For example, to allow avahi-daemon to use the system bus,
@var{services} must be equal to @code{(list avahi)}."
(mlet %store-monad ((conf (dbus-configuration-directory dbus services)))
(return
(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))
(user-groups (list (user-group
(name "messagebus")
(system? #t))))
(user-accounts (list (user-account
(name "messagebus")
(group "messagebus")
(system? #t)
(comment "D-Bus system bus user")
(home-directory "/var/run/dbus")
(shell
"/run/current-system/profile/sbin/nologin"))))
(activate #~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/dbus")
(let ((user (getpwnam "messagebus")))
(chown "/var/run/dbus"
(passwd:uid user) (passwd:gid user)))
(unless (file-exists? "/etc/machine-id")
(format #t "creating /etc/machine-id...~%")
(let ((prog (string-append #$dbus "/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)))))))))))
;;; dbus.scm ends here