services: 'polkit-service-type' can now be extended.

* gnu/packages/polkit.scm (polkit)[source]: Adjust snippet so that rules
  and actions are looked for under /etc/polkit-1.
* gnu/services/desktop.scm (<polkit-configuration>): New record type.
  (polkit-directory, polkit-etc-files, polkit-setuid-programs): New
  procedures.
  (polkit-service-type)[compose, extend]: New fields.
  (polkit-service): Refine docstring.
  (colord-service-type): Extend POLKIT-SERVICE-TYPE.
  (elogind-configuration-file): Extend POLKIT-SERVICE-TYPE.
* doc/guix.texi (Desktop Services): Update 'polkit-service'
  documentation.

2 files changed, 118 insertions, 66 deletions

diff --git a/gnu/packages/polkit.scm b/gnu/packages/polkit.scm
index 13db7b6e65..4cafb45d92 100644
--- a/gnu/packages/polkit.scm
+++ b/gnu/packages/polkit.scm
@@ -65,18 +65,16 @@
                  (substitute* "src/polkitbackend/polkitbackendjsauthority.c"
                    (("systemd") "elogind"))
 
-                 (substitute* "src/polkitagent/polkitagentsession.c"
-                   (("PACKAGE_PREFIX \"/lib/polkit-1/polkit-agent-helper-1\"")
-                    "\"/run/setuid-programs/polkit-agent-helper-1\""))
+                 ;; GuixSD's polkit service stores actions under
+                 ;; /etc/polkit-1/actions.
                  (substitute* "src/polkitbackend/polkitbackendinteractiveauthority.c"
                    (("PACKAGE_DATA_DIR \"/polkit-1/actions\"")
-                    "\"/run/current-system/profile/share/polkit-1/actions\""))
-                 (substitute* "src/polkitbackend/polkitbackendjsauthority.c"
-                   (("PACKAGE_SYSCONF_DIR \"/polkit-1/rules.d\"")
-                    "\"/run/current-system/profile/etc/polkit-1/rules.d\""))
-                 (substitute* "src/polkitbackend/polkitbackendjsauthority.c"
-                   (("PACKAGE_DATA_DIR \"/polkit-1/rules.d\"")
-                    "\"/run/current-system/profile/share/polkit-1/rules.d\""))))))
+                    "PACKAGE_SYSCONF_DIR \"/polkit-1/actions\""))
+
+                 ;; Set the setuid helper's real location.
+                 (substitute* "src/polkitagent/polkitagentsession.c"
+                   (("PACKAGE_PREFIX \"/lib/polkit-1/polkit-agent-helper-1\"")
+                    "\"/run/setuid-programs/polkit-agent-helper-1\""))))))
     (build-system gnu-build-system)
     (inputs
      `(("expat" ,expat)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 166895663f..af4fe53dd0 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -226,52 +226,6 @@ levels, with the given configuration settings.  It implements the
 
 
 ;;;
-;;; Colord D-Bus service.
-;;;
-
-(define %colord-activation
-  #~(begin
-      (use-modules (guix build utils))
-      (mkdir-p "/var/lib/colord")
-      (let ((user (getpwnam "colord")))
-        (chown "/var/lib/colord"
-               (passwd:uid user) (passwd:gid user)))))
-
-(define %colord-accounts
-  (list (user-group (name "colord") (system? #t))
-        (user-account
-         (name "colord")
-         (group "colord")
-         (system? #t)
-         (comment "colord daemon user")
-         (home-directory "/var/empty")
-         (shell #~(string-append #$shadow "/sbin/nologin")))))
-
-(define colord-service-type
-  (service-type (name 'colord)
-                (extensions
-                 (list (service-extension account-service-type
-                                          (const %colord-accounts))
-                       (service-extension activation-service-type
-                                          (const %colord-activation))
-
-                       ;; Colord is a D-Bus service that dbus-daemon can
-                       ;; activate.
-                       (service-extension dbus-root-service-type list)
-
-                       ;; Colord provides "color device" rules for udev.
-                       (service-extension udev-service-type list)))))
-
-(define* (colord-service #:key (colord colord))
-  "Return a service that runs @command{colord}, a system service with a D-Bus
-interface to manage the color profiles of input and output devices such as
-screens and scanners.  It is notably used by the GNOME Color Manager graphical
-tool.  See @uref{http://www.freedesktop.org/software/colord/, the colord web
-site} for more information."
-  (service colord-service-type colord))
-
-
-;;;
 ;;; GeoClue D-Bus service.
 ;;;
 
@@ -383,6 +337,14 @@ site} for more information."
 ;;; 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
@@ -396,9 +358,31 @@ site} for more information."
 (define %polkit-pam-services
   (list (unix-pam-service "polkitd")))
 
+(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}."
+  (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))))
+                 #:modules '((guix build union))))
+
+(define polkit-etc-files
+  (match-lambda
+    (($ <polkit-configuration> polkit packages)
+     `(("polkit-1" ,(polkit-directory packages))))))
+
+(define polkit-setuid-programs
+  (match-lambda
+    (($ <polkit-configuration> polkit)
+     (list #~(string-append #$polkit
+                            "/lib/polkit-1/polkit-agent-helper-1")))))
+
 (define polkit-service-type
-  ;; TODO: Make it extensible so it can collect policy files from other
-  ;; services.
   (service-type (name 'polkit)
                 (extensions
                  (list (service-extension account-service-type
@@ -406,15 +390,83 @@ site} for more information."
                        (service-extension pam-root-service-type
                                           (const %polkit-pam-services))
                        (service-extension dbus-root-service-type
-                                          list)))))
+                                          (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)))))))
 
 (define* (polkit-service #:key (polkit polkit))
-  "Return a service that runs the @command{polkit} privilege management
-service.  By querying the @command{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))
+  "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))))
+
+
+;;;
+;;; Colord D-Bus service.
+;;;
+
+(define %colord-activation
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/lib/colord")
+      (let ((user (getpwnam "colord")))
+        (chown "/var/lib/colord"
+               (passwd:uid user) (passwd:gid user)))))
+
+(define %colord-accounts
+  (list (user-group (name "colord") (system? #t))
+        (user-account
+         (name "colord")
+         (group "colord")
+         (system? #t)
+         (comment "colord daemon user")
+         (home-directory "/var/empty")
+         (shell #~(string-append #$shadow "/sbin/nologin")))))
+
+(define colord-service-type
+  (service-type (name 'colord)
+                (extensions
+                 (list (service-extension account-service-type
+                                          (const %colord-accounts))
+                       (service-extension activation-service-type
+                                          (const %colord-activation))
+
+                       ;; Colord is a D-Bus service that dbus-daemon can
+                       ;; activate.
+                       (service-extension dbus-root-service-type list)
+
+                       ;; Colord provides "color device" rules for udev.
+                       (service-extension udev-service-type list)
+
+                       ;; It provides polkit "actions".
+                       (service-extension polkit-service-type list)))))
+
+(define* (colord-service #:key (colord colord))
+  "Return a service that runs @command{colord}, a system service with a D-Bus
+interface to manage the color profiles of input and output devices such as
+screens and scanners.  It is notably used by the GNOME Color Manager graphical
+tool.  See @uref{http://www.freedesktop.org/software/colord/, the colord web
+site} for more information."
+  (service colord-service-type colord))
 
 
 ;;;
@@ -581,7 +633,9 @@ the system if the user is logged in locally."
                                           (compose list elogind-package))
                        (service-extension udev-service-type
                                           (compose list elogind-package))
-                       ;; TODO: Extend polkit(?) and PAM.
+                       (service-extension polkit-service-type
+                                          (compose list elogind-package))
+                       ;; TODO: Extend PAM with pam_elogind.so.
                        ))))
 
 (define* (elogind-service #:key (config (elogind-configuration)))