ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 06:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: dbus: Build '/etc/dbus-1/system-local.conf'.

Browse source 
* gnu/services/dbus.scm (dbus-etc-files): New procedure.
  (dbus-dmd-service): Remove the use of '--config-file'.
  (dbus-configuration-directory): Adjust accordingly.
  (dbus-root-service-type): Add extension of ETC-SERVICE-TYPE.
This commit is contained in:
宋文武 2015-10-18 14:18:52 +08:00
parent b2aab72c14
commit 64643b90ab
1 changed files with 21 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
gnu/services/dbus.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -41,9 +42,9 @@ (define-record-type* <dbus-configuration>
(services dbus-configuration-services ;list of <package> (services dbus-configuration-services ;list of <package>
(default '()))) (default '())))
(define (dbus-configuration-directory dbus services) (define (dbus-configuration-directory services)
"Return a configuration directory for @var{dbus} that includes the "Return a directory contains the @code{system-local.conf} file for DBUS that
@code{etc/dbus-1/system.d} directories of each package listed in includes the @code{etc/dbus-1/system.d} directories of each package listed in
@var{services}." @var{services}."
(define build (define build
#~(begin #~(begin
@ -65,13 +66,6 @@ (define (services->sxml services)
services))) services)))
(mkdir #$output) (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-local.conf' is automatically included by the default
;; 'system.conf', so this is where we stuff our own things. ;; 'system.conf', so this is where we stuff our own things.
(call-with-output-file (string-append #$output "/system-local.conf") (call-with-output-file (string-append #$output "/system-local.conf")
@ -81,6 +75,12 @@ (define (services->sxml services)
(computed-file "dbus-configuration" build)) (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 (define %dbus-accounts
;; Accounts used by the system bus. ;; Accounts used by the system bus.
(list (user-group (name "messagebus") (system? #t)) (list (user-group (name "messagebus") (system? #t))
@ -118,20 +118,15 @@ (define (dbus-activation config)
(execl prog))) (execl prog)))
(waitpid pid))))))) (waitpid pid)))))))
(define dbus-dmd-service (define (dbus-dmd-service config)
(match-lambda
(($ <dbus-configuration> dbus services)
(let ((conf (dbus-configuration-directory dbus services)))
(list (dmd-service (list (dmd-service
(documentation "Run the D-Bus system daemon.") (documentation "Run the D-Bus system daemon.")
(provision '(dbus-system)) (provision '(dbus-system))
(requirement '(user-processes)) (requirement '(user-processes))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$dbus "/bin/dbus-daemon") (list (string-append #$dbus "/bin/dbus-daemon")
"--nofork" "--nofork" "--system")))
(string-append "--config-file=" #$conf (stop #~(make-kill-destructor)))))
"/system.conf"))))
(stop #~(make-kill-destructor))))))))
(define dbus-root-service-type (define dbus-root-service-type
(service-type (name 'dbus) (service-type (name 'dbus)
@ -140,6 +135,8 @@ (define dbus-root-service-type
dbus-dmd-service) dbus-dmd-service)
(service-extension activation-service-type (service-extension activation-service-type
dbus-activation) dbus-activation)
(service-extension etc-service-type
dbus-etc-files)
(service-extension account-service-type (service-extension account-service-type
(const %dbus-accounts)))) (const %dbus-accounts))))