Merge remote-tracking branch 'origin/master' into staging

[jackhill/guix/guix.git] / gnu / services / dbus.scm

diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 690561c..1e24d93 100644 (file)
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -21,7 +21,9 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
+  #:use-module (gnu system pam)
   #:use-module ((gnu packages glib) #:select (dbus))
+  #:use-module (gnu packages polkit)
   #:use-module (gnu packages admin)
   #:use-module (guix gexp)
   #:use-module (guix records)
@@ -30,7 +32,10 @@
   #:export (dbus-configuration
             dbus-configuration?
             dbus-root-service-type
-            dbus-service))
+            dbus-service
+
+            polkit-service-type
+            polkit-service))
 
 ;;;
 ;;; D-Bus.
@@ -58,7 +63,7 @@ all the services that may be activated by the daemon."
                                        (find-files
                                         (string-append
                                          service
-                                         "/share/dbus-1/system-services")
+                                         "/share/dbus-1/")
                                         "\\.service$"))
                                      (list #$@services)))
 
@@ -128,13 +133,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}."
@@ -200,7 +205,9 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
                            (inherit config)
                            (services
                             (append (dbus-configuration-services config)
-                                    services)))))))
+                                    services)))))
+
+                (default-value (dbus-configuration))))
 
 (define* (dbus-service #:key (dbus dbus) (services '()))
   "Return a service that runs the \"system bus\", using @var{dbus}, with
@@ -218,4 +225,93 @@ and policy files.  For example, to allow avahi-daemon to use the system bus,
            (dbus-configuration (dbus dbus)
                                (services services))))
 
+\f
+;;;
+;;; Polkit privilege management service.
+;;;
+
+(define-record-type* <polkit-configuration>
+  polkit-configuration make-polkit-configuration
+  polkit-configuration?
+  (polkit   polkit-configuration-polkit           ;<package>
+            (default polkit))
+  (actions  polkit-configuration-actions          ;list of <package>
+            (default '())))
+
+(define %polkit-accounts
+  (list (user-group (name "polkitd") (system? #t))
+        (user-account
+         (name "polkitd")
+         (group "polkitd")
+         (system? #t)
+         (comment "Polkit daemon user")
+         (home-directory "/var/empty")
+         (shell "/run/current-system/profile/sbin/nologin"))))
+
+(define %polkit-pam-services
+  (list (unix-pam-service "polkit-1")))
+
+(define (polkit-directory packages)
+  "Return a directory containing an @file{actions} and possibly a
+@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
+  (with-imported-modules '((guix build union))
+    (computed-file "etc-polkit-1"
+                   #~(begin
+                       (use-modules (guix build union) (srfi srfi-26))
+
+                       (union-build #$output
+                                    (map (cut string-append <>
+                                              "/share/polkit-1")
+                                         (list #$@packages)))))))
+
+(define polkit-etc-files
+  (match-lambda
+    (($ <polkit-configuration> polkit packages)
+     `(("polkit-1" ,(polkit-directory (cons polkit packages)))))))
+
+(define polkit-setuid-programs
+  (match-lambda
+    (($ <polkit-configuration> polkit)
+     (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
+           (file-append polkit "/bin/pkexec")))))
+
+(define polkit-service-type
+  (service-type (name 'polkit)
+                (extensions
+                 (list (service-extension account-service-type
+                                          (const %polkit-accounts))
+                       (service-extension pam-root-service-type
+                                          (const %polkit-pam-services))
+                       (service-extension dbus-root-service-type
+                                          (compose
+                                           list
+                                           polkit-configuration-polkit))
+                       (service-extension etc-service-type
+                                          polkit-etc-files)
+                       (service-extension setuid-program-service-type
+                                          polkit-setuid-programs)))
+
+                ;; Extensions are lists of packages that provide polkit rules
+                ;; or actions under share/polkit-1/{actions,rules.d}.
+                (compose concatenate)
+                (extend (lambda (config actions)
+                          (polkit-configuration
+                           (inherit config)
+                           (actions
+                            (append (polkit-configuration-actions config)
+                                    actions)))))
+
+                (default-value (polkit-configuration))))
+
+(define* (polkit-service #:key (polkit polkit))
+  "Return a service that runs the
+@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege
+management service}, which allows system administrators to grant access to
+privileged operations in a structured way.  By querying the Polkit service, a
+privileged system component can know when it should grant additional
+capabilities to ordinary users.  For example, an ordinary user can be granted
+the capability to suspend the system if the user is logged in locally."
+  (service polkit-service-type
+           (polkit-configuration (polkit polkit))))
+
 ;;; dbus.scm ends here