1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (gnu services dbus)
21 #:use-module (gnu services)
22 #:use-module (gnu services shepherd)
23 #:use-module (gnu system shadow)
24 #:use-module (gnu system pam)
25 #:use-module ((gnu packages glib) #:select (dbus))
26 #:use-module (gnu packages polkit)
27 #:use-module (gnu packages admin)
28 #:use-module (guix gexp)
29 #:use-module (guix records)
30 #:use-module (srfi srfi-1)
31 #:use-module (ice-9 match)
32 #:export (dbus-configuration
34 dbus-root-service-type
44 (define-record-type* <dbus-configuration>
45 dbus-configuration make-dbus-configuration
47 (dbus dbus-configuration-dbus ;<package>
49 (services dbus-configuration-services ;list of <package>
52 (define (system-service-directory services)
53 "Return the system service directory, containing @code{.service} files for
54 all the services that may be activated by the daemon."
55 (computed-file "dbus-system-services"
56 (with-imported-modules '((guix build utils))
58 (use-modules (guix build utils)
62 (append-map (lambda (service)
66 "/share/dbus-1/system-services")
71 (for-each (lambda (file)
73 (string-append #$output "/"
78 (define (dbus-configuration-directory services)
79 "Return a directory contains the @code{system-local.conf} file for DBUS that
80 includes the @code{etc/dbus-1/system.d} directories of each package listed in
84 (use-modules (sxml simple)
87 (define (services->sxml services)
88 ;; Return the SXML 'includedir' clauses for DIRS.
90 (servicehelper "/run/setuid-programs/dbus-daemon-launch-helper")
92 ;; First, the '.service' files of services subject to activation.
93 ;; We use a fixed location under /etc because the setuid helper
94 ;; looks for them in that location and nowhere else. See
95 ;; <https://bugs.freedesktop.org/show_bug.cgi?id=92458>.
96 (servicedir "/etc/dbus-1/system-services")
98 ,@(append-map (lambda (dir)
100 ,(string-append dir "/etc/dbus-1/system.d"))
101 (servicedir ;for '.service' files
102 ,(string-append dir "/share/dbus-1/services"))))
107 ;; Provide /etc/dbus-1/system-services, which is where the setuid
108 ;; helper looks for system service files.
109 (symlink #$(system-service-directory services)
110 (string-append #$output "/system-services"))
112 ;; 'system-local.conf' is automatically included by the default
113 ;; 'system.conf', so this is where we stuff our own things.
114 (call-with-output-file (string-append #$output "/system-local.conf")
116 (sxml->xml (services->sxml (list #$@services))
119 (computed-file "dbus-configuration" build))
121 (define (dbus-etc-files config)
122 "Return a list of FILES for @var{etc-service-type} to build the
123 @code{/etc/dbus-1} directory."
124 (list `("dbus-1" ,(dbus-configuration-directory
125 (dbus-configuration-services config)))))
127 (define %dbus-accounts
128 ;; Accounts used by the system bus.
129 (list (user-group (name "messagebus") (system? #t))
134 (comment "D-Bus system bus user")
135 (home-directory "/var/run/dbus")
136 (shell (file-append shadow "/sbin/nologin")))))
138 (define dbus-setuid-programs
139 ;; Return the file name of the setuid program that we need.
141 (($ <dbus-configuration> dbus services)
142 (list (file-append dbus "/libexec/dbus-daemon-launch-helper")))))
144 (define (dbus-activation config)
145 "Return an activation gexp for D-Bus using @var{config}."
147 (use-modules (guix build utils))
149 (mkdir-p "/var/run/dbus")
151 (let ((user (getpwnam "messagebus")))
152 (chown "/var/run/dbus"
153 (passwd:uid user) (passwd:gid user)))
155 (unless (file-exists? "/etc/machine-id")
156 (format #t "creating /etc/machine-id...~%")
157 (let ((prog (string-append #$(dbus-configuration-dbus config)
158 "/bin/dbus-uuidgen")))
159 ;; XXX: We can't use 'system' because the initrd's
160 ;; guile system(3) only works when 'sh' is in $PATH.
161 (let ((pid (primitive-fork)))
163 (call-with-output-file "/etc/machine-id"
166 (dup2 (port->fdes port) 1)
170 (define dbus-shepherd-service
172 (($ <dbus-configuration> dbus)
173 (list (shepherd-service
174 (documentation "Run the D-Bus system daemon.")
175 (provision '(dbus-system))
176 (requirement '(user-processes))
177 (start #~(make-forkexec-constructor
178 (list (string-append #$dbus "/bin/dbus-daemon")
179 "--nofork" "--system")
180 #:pid-file "/var/run/dbus/pid"))
181 (stop #~(make-kill-destructor)))))))
183 (define dbus-root-service-type
184 (service-type (name 'dbus)
186 (list (service-extension shepherd-root-service-type
187 dbus-shepherd-service)
188 (service-extension activation-service-type
190 (service-extension etc-service-type
192 (service-extension account-service-type
193 (const %dbus-accounts))
194 (service-extension setuid-program-service-type
195 dbus-setuid-programs)))
197 ;; Extensions consist of lists of packages (representing D-Bus
198 ;; services) that we just concatenate.
199 (compose concatenate)
201 ;; The service's parameters field is extended by augmenting
202 ;; its <dbus-configuration> 'services' field.
203 (extend (lambda (config services)
207 (append (dbus-configuration-services config)
210 (default-value (dbus-configuration))))
212 (define* (dbus-service #:key (dbus dbus) (services '()))
213 "Return a service that runs the \"system bus\", using @var{dbus}, with
214 support for @var{services}.
216 @uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication
217 facility. Its system bus is used to allow system services to communicate and
218 be notified of system-wide events.
220 @var{services} must be a list of packages that provide an
221 @file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
222 and policy files. For example, to allow avahi-daemon to use the system bus,
223 @var{services} must be equal to @code{(list avahi)}."
224 (service dbus-root-service-type
225 (dbus-configuration (dbus dbus)
226 (services services))))
230 ;;; Polkit privilege management service.
233 (define-record-type* <polkit-configuration>
234 polkit-configuration make-polkit-configuration
235 polkit-configuration?
236 (polkit polkit-configuration-polkit ;<package>
238 (actions polkit-configuration-actions ;list of <package>
241 (define %polkit-accounts
242 (list (user-group (name "polkitd") (system? #t))
247 (comment "Polkit daemon user")
248 (home-directory "/var/empty")
249 (shell "/run/current-system/profile/sbin/nologin"))))
251 (define %polkit-pam-services
252 (list (unix-pam-service "polkit-1")))
254 (define (polkit-directory packages)
255 "Return a directory containing an @file{actions} and possibly a
256 @file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
257 (with-imported-modules '((guix build union))
258 (computed-file "etc-polkit-1"
260 (use-modules (guix build union) (srfi srfi-26))
262 (union-build #$output
263 (map (cut string-append <>
265 (list #$@packages)))))))
267 (define polkit-etc-files
269 (($ <polkit-configuration> polkit packages)
270 `(("polkit-1" ,(polkit-directory (cons polkit packages)))))))
272 (define polkit-setuid-programs
274 (($ <polkit-configuration> polkit)
275 (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
276 (file-append polkit "/bin/pkexec")))))
278 (define polkit-service-type
279 (service-type (name 'polkit)
281 (list (service-extension account-service-type
282 (const %polkit-accounts))
283 (service-extension pam-root-service-type
284 (const %polkit-pam-services))
285 (service-extension dbus-root-service-type
288 polkit-configuration-polkit))
289 (service-extension etc-service-type
291 (service-extension setuid-program-service-type
292 polkit-setuid-programs)))
294 ;; Extensions are lists of packages that provide polkit rules
295 ;; or actions under share/polkit-1/{actions,rules.d}.
296 (compose concatenate)
297 (extend (lambda (config actions)
298 (polkit-configuration
301 (append (polkit-configuration-actions config)
304 (default-value (polkit-configuration))))
306 (define* (polkit-service #:key (polkit polkit))
307 "Return a service that runs the
308 @uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege
309 management service}, which allows system administrators to grant access to
310 privileged operations in a structured way. By querying the Polkit service, a
311 privileged system component can know when it should grant additional
312 capabilities to ordinary users. For example, an ordinary user can be granted
313 the capability to suspend the system if the user is logged in locally."
314 (service polkit-service-type
315 (polkit-configuration (polkit polkit))))
317 ;;; dbus.scm ends here