services: rottlog: Add Rottlog to the global profile.
[jackhill/guix/guix.git] / gnu / services / dbus.scm
index 9b0d198..876f56d 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 
 (define-module (gnu services dbus)
   #:use-module (gnu services)
-  #:use-module (gnu services dmd)
+  #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
-  #:use-module ((gnu packages glib) #:select (dbus/activation))
+  #:use-module ((gnu packages glib) #:select (dbus))
   #:use-module (gnu packages admin)
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
-  #:export (dbus-root-service-type
+  #:export (dbus-configuration
+            dbus-configuration?
+            dbus-root-service-type
             dbus-service))
 
 ;;;
@@ -38,7 +40,7 @@
   dbus-configuration make-dbus-configuration
   dbus-configuration?
   (dbus      dbus-configuration-dbus              ;<package>
-             (default dbus/activation))
+             (default dbus))
   (services  dbus-configuration-services          ;list of <package>
              (default '())))
 
   "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))))
+                 (with-imported-modules '((guix build utils))
+                   #~(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))))
 
 (define (dbus-configuration-directory services)
   "Return a directory contains the @code{system-local.conf} file for DBUS that
@@ -125,13 +128,13 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
          (system? #t)
          (comment "D-Bus system bus user")
          (home-directory "/var/run/dbus")
-         (shell #~(string-append #$shadow "/sbin/nologin")))))
+         (shell (file-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")))))
+     (list (file-append dbus "/libexec/dbus-daemon-launch-helper")))))
 
 (define (dbus-activation config)
   "Return an activation gexp for D-Bus using @var{config}."
@@ -159,23 +162,24 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
                     (execl prog)))
                 (waitpid pid)))))))
 
-(define dbus-dmd-service
+(define dbus-shepherd-service
   (match-lambda
     (($ <dbus-configuration> dbus)
-     (list (dmd-service
+     (list (shepherd-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")))
+                            "--nofork" "--system")
+                      #:pid-file "/var/run/dbus/pid"))
             (stop #~(make-kill-destructor)))))))
 
 (define dbus-root-service-type
   (service-type (name 'dbus)
                 (extensions
-                 (list (service-extension dmd-root-service-type
-                                          dbus-dmd-service)
+                 (list (service-extension shepherd-root-service-type
+                                          dbus-shepherd-service)
                        (service-extension activation-service-type
                                           dbus-activation)
                        (service-extension etc-service-type
@@ -198,7 +202,7 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
                             (append (dbus-configuration-services config)
                                     services)))))))
 
-(define* (dbus-service #:key (dbus dbus/activation) (services '()))
+(define* (dbus-service #:key (dbus dbus) (services '()))
   "Return a service that runs the \"system bus\", using @var{dbus}, with
 support for @var{services}.