Merge branch 'master' into core-updates

8 files changed, 821 insertions, 236 deletions

diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm
index 18131fe561..49a737f090 100644
--- a/gnu/services/avahi.scm
+++ b/gnu/services/avahi.scm
@@ -107,19 +107,24 @@
            (stop #~(make-kill-destructor))))))
 
 (define avahi-service-type
-  (service-type (name 'avahi)
-                (extensions
-                 (list (service-extension dmd-root-service-type
-                                          avahi-dmd-service)
-                       (service-extension dbus-root-service-type
-                                          (compose list
-                                                   avahi-configuration-avahi))
-                       (service-extension account-service-type
-                                          (const %avahi-accounts))
-                       (service-extension activation-service-type
-                                          (const %avahi-activation))
-                       (service-extension nscd-service-type
-                                          (const (list nss-mdns)))))))
+  (let ((avahi-package (compose list avahi-configuration-avahi)))
+    (service-type (name 'avahi)
+                  (extensions
+                   (list (service-extension dmd-root-service-type
+                                            avahi-dmd-service)
+                         (service-extension dbus-root-service-type
+                                            avahi-package)
+                         (service-extension account-service-type
+                                            (const %avahi-accounts))
+                         (service-extension activation-service-type
+                                            (const %avahi-activation))
+                         (service-extension nscd-service-type
+                                            (const (list nss-mdns)))
+
+                         ;; Provide 'avahi-browse', 'avahi-resolve', etc. in
+                         ;; the system profile.
+                         (service-extension profile-service-type
+                                            avahi-package))))))
 
 (define* (avahi-service #:key (avahi avahi)
                         host-name
@@ -132,7 +137,9 @@ mDNS/DNS-SD responder that allows for service discovery and
 \"zero-configuration\" host name lookups (see @uref{http://avahi.org/}), and
 extends the name service cache daemon (nscd) so that it can resolve
 @code{.local} host names using
-@uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}.
+@uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}.  Additionally,
+add the @var{avahi} package to the system profile so that commands such as
+@command{avahi-browse} are directly usable.
 
 If @var{host-name} is different from @code{#f}, use that as the host name to
 publish for this machine; otherwise, use the machine's actual host name.
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 336cc4dec9..a86e8e04c7 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,12 +24,12 @@
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
   #:use-module (gnu services networking)
+  #:use-module (gnu system pam)
   #:use-module (gnu system shadow)                ; 'user-account', etc.
-  #:use-module (gnu system linux)                 ; 'pam-service', etc.
   #:use-module (gnu system file-systems)          ; 'file-system', etc.
   #:use-module (gnu packages admin)
   #:use-module ((gnu packages linux)
-                #:select (eudev kbd e2fsprogs lvm2 fuse alsa-utils crda))
+                #:select (eudev kbd e2fsprogs lvm2 fuse alsa-utils crda gpm))
   #:use-module ((gnu packages base)
                 #:select (canonical-package glibc))
   #:use-module (gnu packages package-management)
@@ -48,15 +49,23 @@
             device-mapping-service
             swap-service
             user-processes-service
+            session-environment-service
+            session-environment-service-type
             host-name-service
             console-keymap-service
             console-font-service
+
+            udev-configuration
+            udev-configuration?
+            udev-configuration-rules
             udev-service-type
             udev-service
+            udev-rule
 
             mingetty-configuration
             mingetty-configuration?
             mingetty-service
+            mingetty-service-type
 
             %nscd-default-caches
             %nscd-default-configuration
@@ -74,6 +83,13 @@
             guix-configuration
             guix-configuration?
             guix-service
+            guix-service-type
+            guix-publish-configuration
+            guix-publish-configuration?
+            guix-publish-service
+            guix-publish-service-type
+            gpm-service-type
+            gpm-service
 
             %base-services))
 
@@ -142,6 +158,18 @@ FILE-SYSTEM."
   (symbol-append 'file-system-
                  (string->symbol (file-system-mount-point file-system))))
 
+(define (mapped-device->dmd-service-name md)
+  "Return the symbol that denotes the dmd service of MD, a <mapped-device>."
+  (symbol-append 'device-mapping-
+                 (string->symbol (mapped-device-target md))))
+
+(define dependency->dmd-service-name
+  (match-lambda
+    ((? mapped-device? md)
+     (mapped-device->dmd-service-name md))
+    ((? file-system? fs)
+     (file-system->dmd-service-name fs))))
+
 (define file-system-service-type
   ;; TODO(?): Make this an extensible service that takes <file-system> objects
   ;; and returns a list of <dmd-service>.
@@ -158,7 +186,7 @@ FILE-SYSTEM."
        (dmd-service
         (provision (list (file-system->dmd-service-name file-system)))
         (requirement `(root-file-system
-                       ,@(map file-system->dmd-service-name dependencies)))
+                       ,@(map dependency->dmd-service-name dependencies)))
         (documentation "Check, mount, and unmount the given file system.")
         (start #~(lambda args
                    ;; FIXME: Use or factorize with 'mount-file-system'.
@@ -198,7 +226,14 @@ FILE-SYSTEM."
                   (chdir "/")
 
                   (umount #$target)
-                  #f)))))))
+                  #f))
+
+        ;; We need an additional module.
+        (modules `(((gnu build file-systems)
+                    #:select (check-file-system canonicalize-device-spec))
+                   ,@%default-modules))
+        (imported-modules `((gnu build file-systems)
+                            ,@%default-imported-modules)))))))
 
 (define* (file-system-service file-system)
   "Return a service that mounts @var{file-system}, a @code{<file-system>}
@@ -336,6 +371,39 @@ stopped before 'kill' is called."
 
 
 ;;;
+;;; System-wide environment variables.
+;;;
+
+(define (environment-variables->environment-file vars)
+  "Return a file for pam_env(8) that contains environment variables VARS."
+  (apply mixed-text-file "environment"
+         (append-map (match-lambda
+                       ((key . value)
+                        (list key "=" value "\n")))
+                     vars)))
+
+(define session-environment-service-type
+  (service-type
+   (name 'session-environment)
+   (extensions
+    (list (service-extension
+           etc-service-type
+           (lambda (vars)
+             (list `("environment"
+                     ,(environment-variables->environment-file vars)))))))
+   (compose concatenate)
+   (extend append)))
+
+(define (session-environment-service vars)
+  "Return a service that builds the @file{/etc/environment}, which can be read
+by PAM-aware applications to set environment variables for sessions.
+
+VARS should be an association list in which both the keys and the values are
+strings or string-valued gexps."
+  (service session-environment-service-type vars))
+
+
+;;;
 ;;; Console & co.
 ;;;
 
@@ -691,6 +759,11 @@ If configuration file name @var{config-file} is not specified, use some
 reasonable default settings."
   (service syslog-service-type config-file))
 
+
+;;;
+;;; Guix services.
+;;;
+
 (define* (guix-build-accounts count #:key
                               (group "guixbuild")
                               (first-uid 30001)
@@ -751,6 +824,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                     (default #t))
   (use-substitutes? guix-configuration-use-substitutes? ;Boolean
                     (default #t))
+  (substitute-urls  guix-configuration-substitute-urls ;list of strings
+                    (default %default-substitute-urls))
   (extra-options    guix-configuration-extra-options ;list of strings
                     (default '()))
   (lsof             guix-configuration-lsof       ;<package>
@@ -765,7 +840,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
   "Return a <dmd-service> for the Guix daemon service with CONFIG."
   (match config
     (($ <guix-configuration> guix build-group build-accounts authorize-key?
-                             use-substitutes? extra-options lsof lsh)
+                             use-substitutes? substitute-urls extra-options
+                             lsof lsh)
      (list (dmd-service
             (documentation "Run the Guix daemon.")
             (provision '(guix-daemon))
@@ -777,6 +853,7 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                       #$@(if use-substitutes?
                              '()
                              '("--no-substitutes"))
+                      "--substitute-urls" #$(string-join substitute-urls)
                       #$@extra-options)
 
                 ;; Add 'lsof' (for the GC) and 'lsh' (for offloading) to the
@@ -824,6 +901,58 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
 @var{config}."
   (service guix-service-type config))
 
+
+(define-record-type* <guix-publish-configuration>
+  guix-publish-configuration make-guix-publish-configuration
+  guix-publish-configuration?
+  (guix    guix-publish-configuration-guix        ;package
+           (default guix))
+  (port    guix-publish-configuration-port        ;number
+           (default 80))
+  (host    guix-publish-configuration-host        ;string
+           (default "localhost")))
+
+(define guix-publish-dmd-service
+  (match-lambda
+    (($ <guix-publish-configuration> guix port host)
+     (list (dmd-service
+            (provision '(guix-publish))
+            (requirement '(guix-daemon))
+            (start #~(make-forkexec-constructor
+                      (list (string-append #$guix "/bin/guix")
+                            "publish" "-u" "guix-publish"
+                            "-p" #$(number->string port)
+                            (string-append "--listen=" #$host))))
+            (stop #~(make-kill-destructor)))))))
+
+(define %guix-publish-accounts
+  (list (user-group (name "guix-publish") (system? #t))
+        (user-account
+         (name "guix-publish")
+         (group "guix-publish")
+         (system? #t)
+         (comment "guix publish user")
+         (home-directory "/var/empty")
+         (shell #~(string-append #$shadow "/sbin/nologin")))))
+
+(define guix-publish-service-type
+  (service-type (name 'guix-publish)
+                (extensions
+                 (list (service-extension dmd-root-service-type
+                                          guix-publish-dmd-service)
+                       (service-extension account-service-type
+                                          (const %guix-publish-accounts))))))
+
+(define* (guix-publish-service #:key (guix guix) (port 80) (host "localhost"))
+  "Return a service that runs @command{guix publish} listening on @var{host}
+and @var{port} (@pxref{Invoking guix publish}).
+
+This assumes that @file{/etc/guix} already contains a signing key pair as
+created by @command{guix archive --generate-key} (@pxref{Invoking guix
+archive}).  If that is not the case, the service will fail to start."
+  (service guix-publish-service-type
+           (guix-publish-configuration (guix guix) (port port) (host host))))
+
 
 ;;;
 ;;; Udev.
@@ -864,12 +993,9 @@ item of @var{packages}."
                  #:modules '((guix build union)
                              (guix build utils))))
 
-(define* (kvm-udev-rule)
-  "Return a directory with a udev rule that changes the group of
-@file{/dev/kvm} to \"kvm\" and makes it #o660."
-  ;; Apparently QEMU-KVM used to ship this rule, but now we have to add it by
-  ;; ourselves.
-  (computed-file "kvm-udev-rules"
+(define (udev-rule file-name contents)
+  "Return a directory with a udev rule file FILE-NAME containing CONTENTS."
+  (computed-file file-name
                  #~(begin
                      (use-modules (guix build utils))
 
@@ -878,20 +1004,26 @@ item of @var{packages}."
 
                      (mkdir-p rules.d)
                      (call-with-output-file
-                         (string-append rules.d "/90-kvm.rules")
+                         (string-append rules.d "/" #$file-name)
                        (lambda (port)
-                         ;; Build users are part of the "kvm" group, so we
-                         ;; can fearlessly make /dev/kvm 660 (see
-                         ;; <http://bugs.gnu.org/18994>, for background.)
-                         (display "\
-KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n" port))))
+                         (display #$contents port))))
                  #:modules '((guix build utils))))
 
+(define kvm-udev-rule
+  ;; Return a directory with a udev rule that changes the group of /dev/kvm to
+  ;; "kvm" and makes it #o660.  Apparently QEMU-KVM used to ship this rule,
+  ;; but now we have to add it by ourselves.
+
+  ;; Build users are part of the "kvm" group, so we can fearlessly make
+  ;; /dev/kvm 660 (see <http://bugs.gnu.org/18994>, for background.)
+  (udev-rule "90-kvm.rules"
+             "KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n"))
+
 (define udev-dmd-service
   ;; Return a <dmd-service> for UDEV with RULES.
   (match-lambda
     (($ <udev-configuration> udev rules)
-     (let* ((rules     (udev-rules-union (cons* udev (kvm-udev-rule) rules)))
+     (let* ((rules     (udev-rules-union (cons* udev kvm-udev-rule rules)))
             (udev.conf (computed-file "udev.conf"
                                       #~(call-with-output-file #$output
                                           (lambda (port)
@@ -1034,6 +1166,60 @@ gexp, to open it, and evaluate @var{close} to close it."
   "Return a service that uses @var{device} as a swap device."
   (service swap-service-type device))
 
+
+(define-record-type* <gpm-configuration>
+  gpm-configuration make-gpm-configuration gpm-configuration?
+  (gpm      gpm-configuration-gpm)                ;package
+  (options  gpm-configuration-options))           ;list of strings
+
+(define gpm-dmd-service
+  (match-lambda
+    (($ <gpm-configuration> gpm options)
+     (list (dmd-service
+            (requirement '(udev))
+            (provision '(gpm))
+            (start #~(lambda ()
+                       ;; 'gpm' runs in the background and sets a PID file.
+                       ;; Note that it requires running as "root".
+                       (false-if-exception (delete-file "/var/run/gpm.pid"))
+                       (fork+exec-command (list (string-append #$gpm "/sbin/gpm")
+                                                #$@options))
+
+                       ;; Wait for the PID file to appear; declare failure if
+                       ;; it doesn't show up.
+                       (let loop ((i 3))
+                         (or (file-exists? "/var/run/gpm.pid")
+                             (if (zero? i)
+                                 #f
+                                 (begin
+                                   (sleep 1)
+                                   (loop (1- i))))))))
+
+            (stop #~(lambda (_)
+                      ;; Return #f if successfully stopped.
+                      (not (zero? (system* (string-append #$gpm "/sbin/gpm")
+                                           "-k"))))))))))
+
+(define gpm-service-type
+  (service-type (name 'gpm)
+                (extensions
+                 (list (service-extension dmd-root-service-type
+                                          gpm-dmd-service)))))
+
+(define* (gpm-service #:key (gpm gpm)
+                      (options '("-m" "/dev/input/mice" "-t" "ps2")))
+  "Run @var{gpm}, the general-purpose mouse daemon, with the given
+command-line @var{options}.  GPM allows users to use the mouse in the console,
+notably to select, copy, and paste text.  The default value of @var{options}
+uses the @code{ps2} protocol, which works for both USB and PS/2 mice.
+
+This service is not part of @var{%base-services}."
+  ;; To test in QEMU, use "-usbdevice mouse" and then, in the monitor, use
+  ;; "info mice" and "mouse_set X" to use the right mouse.
+  (service gpm-service-type
+           (gpm-configuration (gpm gpm) (options options))))
+
+
 (define %base-services
   ;; Convenience variable holding the basic services.
   (let ((motd (plain-file "motd" "
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index e4ecd961c5..9b0d198683 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,7 +21,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
   #:use-module (gnu system shadow)
-  #:use-module (gnu packages glib)
+  #:use-module ((gnu packages glib) #:select (dbus/activation))
   #:use-module (gnu packages admin)
   #:use-module (guix gexp)
   #:use-module (guix records)
@@ -37,13 +38,38 @@
   dbus-configuration make-dbus-configuration
   dbus-configuration?
   (dbus      dbus-configuration-dbus              ;<package>
-             (default dbus))
+             (default dbus/activation))
   (services  dbus-configuration-services          ;list of <package>
              (default '())))
 
-(define (dbus-configuration-directory dbus services)
-  "Return a configuration directory for @var{dbus} that includes the
-@code{etc/dbus-1/system.d} directories of each package listed in
+(define (system-service-directory services)
+  "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))))
+
+(define (dbus-configuration-directory services)
+  "Return a directory contains the @code{system-local.conf} file for DBUS that
+includes the @code{etc/dbus-1/system.d} directories of each package listed in
 @var{services}."
   (define build
     #~(begin
@@ -53,24 +79,27 @@
         (define (services->sxml services)
           ;; Return the SXML 'includedir' clauses for DIRS.
           `(busconfig
+            (servicehelper "/run/setuid-programs/dbus-daemon-launch-helper")
+
+            ;; First, the '.service' files of services subject to activation.
+            ;; We use a fixed location under /etc because the setuid helper
+            ;; looks for them in that location and nowhere else.  See
+            ;; <https://bugs.freedesktop.org/show_bug.cgi?id=92458>.
+            (servicedir "/etc/dbus-1/system-services")
+
             ,@(append-map (lambda (dir)
                             `((includedir
                                ,(string-append dir "/etc/dbus-1/system.d"))
-                              (servicedir         ;for '.service' files
-                               ,(string-append dir "/share/dbus-1/services"))
-                              (servicedir       ;likewise, for auto-activation
-                               ,(string-append
-                                 dir
-                                 "/share/dbus-1/system-services"))))
+                              (servicedir       ;for '.service' files
+                               ,(string-append dir "/share/dbus-1/services"))))
                           services)))
 
         (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"))
+        ;; Provide /etc/dbus-1/system-services, which is where the setuid
+        ;; helper looks for system service files.
+        (symlink #$(system-service-directory services)
+                 (string-append #$output "/system-services"))
 
         ;; 'system-local.conf' is automatically included by the default
         ;; 'system.conf', so this is where we stuff our own things.
@@ -81,6 +110,12 @@
 
   (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
   ;; Accounts used by the system bus.
   (list (user-group (name "messagebus") (system? #t))
@@ -92,6 +127,12 @@
          (home-directory "/var/run/dbus")
          (shell #~(string-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")))))
+
 (define (dbus-activation config)
   "Return an activation gexp for D-Bus using @var{config}."
   #~(begin
@@ -120,18 +161,15 @@
 
 (define dbus-dmd-service
   (match-lambda
-    (($ <dbus-configuration> dbus services)
-     (let ((conf (dbus-configuration-directory dbus services)))
-       (list (dmd-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"
-                              (string-append "--config-file=" #$conf
-                                             "/system.conf"))))
-              (stop #~(make-kill-destructor))))))))
+    (($ <dbus-configuration> dbus)
+     (list (dmd-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")))
+            (stop #~(make-kill-destructor)))))))
 
 (define dbus-root-service-type
   (service-type (name 'dbus)
@@ -140,14 +178,15 @@
                                           dbus-dmd-service)
                        (service-extension activation-service-type
                                           dbus-activation)
+                       (service-extension etc-service-type
+                                          dbus-etc-files)
                        (service-extension account-service-type
-                                          (const %dbus-accounts))))
+                                          (const %dbus-accounts))
+                       (service-extension setuid-program-service-type
+                                          dbus-setuid-programs)))
 
                 ;; Extensions consist of lists of packages (representing D-Bus
                 ;; services) that we just concatenate.
-                ;;
-                ;; FIXME: We need 'dbus-daemon-launch-helper' to be
-                ;; setuid-root for auto-activation to work.
                 (compose concatenate)
 
                 ;; The service's parameters field is extended by augmenting
@@ -159,7 +198,7 @@
                             (append (dbus-configuration-services config)
                                     services)))))))
 
-(define* (dbus-service #:key (dbus dbus) (services '()))
+(define* (dbus-service #:key (dbus dbus/activation) (services '()))
   "Return a service that runs the \"system bus\", using @var{dbus}, with
 support for @var{services}.
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 69edc6d9bb..694a8eda7e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -27,13 +27,15 @@
   #:use-module (gnu services xorg)
   #:use-module (gnu services networking)
   #:use-module (gnu system shadow)
-  #:use-module (gnu system linux) ; unix-pam-service
+  #:use-module (gnu system pam)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages avahi)
   #:use-module (gnu packages polkit)
+  #:use-module (gnu packages xdisorg)
+  #:use-module (gnu packages suckless)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix store)
@@ -41,6 +43,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (upower-service
+            udisks-service
             colord-service
             geoclue-application
             %standard-geoclue-applications
@@ -224,65 +227,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-dmd-service colord)
-  "Return a dmd service for COLORD."
-  ;; TODO: Remove when D-Bus activation works.
-  (list (dmd-service
-         (documentation "Run the colord color management service.")
-         (provision '(colord-daemon))
-         (requirement '(dbus-system udev))
-         (start #~(make-forkexec-constructor
-                   (list (string-append #$colord "/libexec/colord"))))
-         (stop #~(make-kill-destructor)))))
-
-(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))
-                       (service-extension dmd-root-service-type
-                                          colord-dmd-service)
-
-                       ;; 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.
 ;;;
 
@@ -343,23 +287,6 @@ users are allowed."
                               "GEOCLUE_CONFIG_FILE"
                               (geoclue-configuration-file config))))
 
-(define (geoclue-dmd-service config)
-  "Return a GeoClue dmd service for CONFIG."
-  ;; TODO: Remove when D-Bus activation works.
-  (let ((geoclue (geoclue-configuration-geoclue config))
-        (config  (geoclue-configuration-file config)))
-    (list (dmd-service
-           (documentation "Run the GeoClue location service.")
-           (provision '(geoclue-daemon))
-           (requirement '(dbus-system))
-
-           (start #~(make-forkexec-constructor
-                     (list (string-append #$geoclue "/libexec/geoclue"))
-                     #:user "geoclue"
-                     #:environment-variables
-                     (list (string-append "GEOCLUE_CONFIG_FILE=" #$config))))
-           (stop #~(make-kill-destructor))))))
-
 (define %geoclue-accounts
   (list (user-group (name "geoclue") (system? #t))
         (user-account
@@ -375,8 +302,6 @@ users are allowed."
                 (extensions
                  (list (service-extension dbus-root-service-type
                                           geoclue-dbus-service)
-                       (service-extension dmd-root-service-type
-                                          geoclue-dmd-service)
                        (service-extension account-service-type
                                           (const %geoclue-accounts))))))
 
@@ -413,6 +338,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
@@ -424,23 +357,34 @@ site} for more information."
          (shell "/run/current-system/profile/sbin/nologin"))))
 
 (define %polkit-pam-services
-  (list (unix-pam-service "polkitd")))
+  (list (unix-pam-service "polkit-1")))
 
-(define (polkit-dmd-service polkit)
-  "Return the <dmd-service> for POLKIT."
-  ;; TODO: Remove when D-Bus activation works.
-  (list (dmd-service
-         (documentation "Run the polkit privilege management service.")
-         (provision '(polkit-daemon))
-         (requirement '(dbus-system))
+(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))))
 
-         (start #~(make-forkexec-constructor
-                   (list (string-append #$polkit "/lib/polkit-1/polkitd"))))
-         (stop #~(make-kill-destructor)))))
+(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")
+           #~(string-append #$polkit "/bin/pkexec")))))
 
 (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
@@ -448,17 +392,118 @@ site} for more information."
                        (service-extension pam-root-service-type
                                           (const %polkit-pam-services))
                        (service-extension dbus-root-service-type
-                                          list)
-                       (service-extension dmd-root-service-type
-                                          polkit-dmd-service)))))
+                                          (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))
+
+
+;;;
+;;; UDisks.
+;;;
+
+(define-record-type* <udisks-configuration>
+  udisks-configuration make-udisks-configuration
+  udisks-configuration?
+  (udisks   udisks-configuration-udisks
+            (default udisks)))
+
+(define udisks-service-type
+  (let ((udisks-package (lambda (config)
+                          (list (udisks-configuration-udisks config)))))
+    (service-type (name 'udisks)
+                  (extensions
+                   (list (service-extension polkit-service-type
+                                            udisks-package)
+                         (service-extension dbus-root-service-type
+                                            udisks-package)
+                         (service-extension udev-service-type
+                                            udisks-package)
+
+                         ;; Profile 'udisksctl' & co. in the system profile.
+                         (service-extension profile-service-type
+                                            udisks-package))))))
+
+(define* (udisks-service #:key (udisks udisks))
+  "Return a service for @uref{http://udisks.freedesktop.org/docs/latest/,
+UDisks}, a @dfn{disk management} daemon that provides user interfaces with
+notifications and ways to mount/unmount disks.  Programs that talk to UDisks
+include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
+  (service udisks-service-type
+           (udisks-configuration (udisks udisks))))
 
 
 ;;;
@@ -601,6 +646,8 @@ the system if the user is logged in locally."
 
 (define (elogind-dmd-service config)
   "Return a dmd service for elogind, using @var{config}."
+  ;; TODO: We could probably rely on service activation but the '.service'
+  ;; file currently contains an erroneous 'Exec' line.
   (let ((config-file (elogind-configuration-file config))
         (elogind     (elogind-package config)))
     (list (dmd-service
@@ -623,7 +670,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)))
@@ -643,9 +692,14 @@ when they log out."
   ;; List of services typically useful for a "desktop" use case.
   (cons* (slim-service)
 
+         ;; Screen lockers are a pretty useful thing and these are small.
+         (screen-locker-service slock)
+         (screen-locker-service xlockmore "xlock")
+
          ;; The D-Bus clique.
          (avahi-service)
          (wicd-service)
+         (udisks-service)
          (upower-service)
          (colord-service)
          (geoclue-service)
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index e87b9e4415..545087acc9 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -45,6 +45,11 @@
             dmd-service-start
             dmd-service-stop
             dmd-service-auto-start?
+            dmd-service-modules
+            dmd-service-imported-modules
+
+            %default-imported-modules
+            %default-modules
 
             dmd-service-back-edges))
 
@@ -99,6 +104,18 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else."
     (list (service-extension dmd-root-service-type
                              (compose list proc))))))
 
+(define %default-imported-modules
+  ;; Default set of modules imported for a service's consumption.
+  '((guix build utils)
+    (guix build syscalls)))
+
+(define %default-modules
+  ;; Default set of modules visible in a service's file.
+  `((dmd service)
+    (oop goops)
+    (guix build utils)
+    (guix build syscalls)))
+
 (define-record-type* <dmd-service>
   dmd-service make-dmd-service
   dmd-service?
@@ -113,64 +130,106 @@ service that extends DMD-ROOT-SERVICE-TYPE and nothing else."
   (stop          dmd-service-stop                 ;g-expression (procedure)
                  (default #~(const #f)))
   (auto-start?   dmd-service-auto-start?          ;Boolean
-                 (default #t)))
+                 (default #t))
+  (modules       dmd-service-modules              ;list of module names
+                 (default %default-modules))
+  (imported-modules dmd-service-imported-modules  ;list of module names
+                    (default %default-imported-modules)))
 
 
-(define (assert-no-duplicates services)
-  "Raise an error if SERVICES provide the same dmd service more than once.
+(define (assert-valid-graph services)
+  "Raise an error if SERVICES does not define a valid dmd service graph, for
+instance if a service requires a nonexistent service, or if more than one
+service uses a given name.
 
-This is a constraint that dmd's 'register-service' verifies but we'd better
-verify it here statically than wait until PID 1 halts with an assertion
+These are constraints that dmd's 'register-service' verifies but we'd better
+verify them here statically than wait until PID 1 halts with an assertion
 failure."
-  (fold (lambda (service set)
-          (define (assert-unique symbol)
-            (when (set-contains? set symbol)
-              (raise (condition
-                      (&message
-                       (message
-                        (format #f (_ "service '~a' provided more than once")
-                                symbol)))))))
-
-          (for-each assert-unique (dmd-service-provision service))
-          (fold set-insert set (dmd-service-provision service)))
-        (setq)
-        services))
+  (define provisions
+    ;; The set of provisions (symbols).  Bail out if a symbol is given more
+    ;; than once.
+    (fold (lambda (service set)
+            (define (assert-unique symbol)
+              (when (set-contains? set symbol)
+                (raise (condition
+                        (&message
+                         (message
+                          (format #f (_ "service '~a' provided more than once")
+                                  symbol)))))))
+
+            (for-each assert-unique (dmd-service-provision service))
+            (fold set-insert set (dmd-service-provision service)))
+          (setq 'dmd)
+          services))
+
+  (define (assert-satisfied-requirements service)
+    ;; Bail out if the requirements of SERVICE aren't satisfied.
+    (for-each (lambda (requirement)
+                (unless (set-contains? provisions requirement)
+                  (raise (condition
+                          (&message
+                           (message
+                            (format #f (_ "service '~a' requires '~a', \
+which is undefined")
+                                    (match (dmd-service-provision service)
+                                      ((head . _) head)
+                                      (_          service))
+                                    requirement)))))))
+              (dmd-service-requirement service)))
+
+  (for-each assert-satisfied-requirements services))
+
+(define (dmd-service-file-name service)
+  "Return the file name where the initialization code for SERVICE is to be
+stored."
+  (let ((provisions (string-join (map symbol->string
+                                      (dmd-service-provision service)))))
+    (string-append "dmd-"
+                   (string-map (match-lambda
+                                 (#\/ #\-)
+                                 (chr chr))
+                               provisions)
+                   ".scm")))
+
+(define (dmd-service-file service)
+  "Return a file defining SERVICE."
+  (gexp->file (dmd-service-file-name service)
+              #~(begin
+                  (use-modules #$@(dmd-service-modules service))
+
+                  (make <service>
+                    #:docstring '#$(dmd-service-documentation service)
+                    #:provides '#$(dmd-service-provision service)
+                    #:requires '#$(dmd-service-requirement service)
+                    #:respawn? '#$(dmd-service-respawn? service)
+                    #:start #$(dmd-service-start service)
+                    #:stop #$(dmd-service-stop service)))))
 
 (define (dmd-configuration-file services)
   "Return the dmd configuration file for SERVICES."
   (define modules
-    ;; Extra modules visible to dmd.conf.
-    '((guix build syscalls)
-      (gnu build file-systems)
-      (guix build utils)))
+    (delete-duplicates
+     (append-map dmd-service-imported-modules services)))
 
-  (assert-no-duplicates services)
+  (assert-valid-graph services)
 
   (mlet %store-monad ((modules  (imported-modules modules))
-                      (compiled (compiled-modules modules)))
+                      (compiled (compiled-modules modules))
+                      (files    (mapm %store-monad dmd-service-file services)))
     (define config
       #~(begin
           (eval-when (expand load eval)
             (set! %load-path (cons #$modules %load-path))
             (set! %load-compiled-path
-                  (cons #$compiled %load-compiled-path)))
-
-          (use-modules (ice-9 ftw)
-                       (guix build syscalls)
-                       (guix build utils)
-                       ((gnu build file-systems)
-                        #:select (check-file-system canonicalize-device-spec)))
-
-          (register-services
-           #$@(map (lambda (service)
-                     #~(make <service>
-                         #:docstring '#$(dmd-service-documentation service)
-                         #:provides '#$(dmd-service-provision service)
-                         #:requires '#$(dmd-service-requirement service)
-                         #:respawn? '#$(dmd-service-respawn? service)
-                         #:start #$(dmd-service-start service)
-                         #:stop #$(dmd-service-stop service)))
-                   services))
+              (cons #$compiled %load-compiled-path)))
+
+          (use-modules (system repl error-handling))
+
+          ;; Arrange to spawn a REPL if loading one of FILES fails.  This is
+          ;; better than a kernel panic.
+          (call-with-error-handling
+            (lambda ()
+              (apply register-services (map primitive-load '#$files))))
 
           ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
           (setenv "PATH" "/run/current-system/profile/bin")
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 003d5a5010..ce21b1d9ff 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -22,15 +22,18 @@
   #:use-module (gnu services dmd)
   #:use-module (gnu services dbus)
   #:use-module (gnu system shadow)
-  #:use-module (gnu system linux)                 ;PAM
+  #:use-module (gnu system pam)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages tor)
   #:use-module (gnu packages messaging)
   #:use-module (gnu packages ntp)
   #:use-module (gnu packages wicd)
+  #:use-module (gnu packages gnome)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (%facebook-host-aliases
@@ -38,9 +41,11 @@
             dhcp-client-service
             %ntp-servers
             ntp-service
+            tor-hidden-service
             tor-service
             bitlbee-service
-            wicd-service))
+            wicd-service
+            network-manager-service))
 
 ;;; Commentary:
 ;;;
@@ -305,6 +310,15 @@ keep the system clock synchronized with that of @var{servers}."
 ;;; Tor.
 ;;;
 
+(define-record-type* <tor-configuration>
+  tor-configuration make-tor-configuration
+  tor-configuration?
+  (tor              tor-configuration-tor
+                    (default tor))
+  (config-file      tor-configuration-config-file)
+  (hidden-services  tor-configuration-hidden-services
+                    (default '())))
+
 (define %tor-accounts
   ;; User account and groups for Tor.
   (list (user-group (name "tor") (system? #t))
@@ -316,20 +330,93 @@ keep the system clock synchronized with that of @var{servers}."
          (home-directory "/var/empty")
          (shell #~(string-append #$shadow "/sbin/nologin")))))
 
-(define (tor-dmd-service tor)
+(define-record-type <hidden-service>
+  (hidden-service name mapping)
+  hidden-service?
+  (name    hidden-service-name)                   ;string
+  (mapping hidden-service-mapping))               ;list of port/address tuples
+
+(define (tor-configuration->torrc config)
+  "Return a 'torrc' file for CONFIG."
+  (match config
+    (($ <tor-configuration> tor config-file services)
+     (computed-file
+      "torrc"
+      #~(begin
+          (use-modules (guix build utils)
+                       (ice-9 match))
+
+          (call-with-output-file #$output
+            (lambda (port)
+              (display "\
+# The beginning was automatically added.
+User tor
+DataDirectory /var/lib/tor
+Log notice syslog\n" port)
+
+              (for-each (match-lambda
+                          ((service (ports hosts) ...)
+                           (format port "\
+HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
+                                   service)
+                           (for-each (lambda (tcp-port host)
+                                       (format port "\
+HiddenServicePort ~a ~a~%"
+                                               tcp-port host))
+                                     ports hosts)))
+                        '#$(map (match-lambda
+                                  (($ <hidden-service> name mapping)
+                                   (cons name mapping)))
+                                services))
+
+              ;; Append the user's config file.
+              (call-with-input-file #$config-file
+                (lambda (input)
+                  (dump-port input port)))
+              #t)))
+      #:modules '((guix build utils))))))
+
+(define (tor-dmd-service config)
   "Return a <dmd-service> running TOR."
-  (let ((torrc (plain-file "torrc" "User tor\n")))
-    (list (dmd-service
-           (provision '(tor))
+  (match config
+    (($ <tor-configuration> tor)
+     (let ((torrc (tor-configuration->torrc config)))
+       (list (dmd-service
+              (provision '(tor))
+
+              ;; Tor needs at least one network interface to be up, hence the
+              ;; dependency on 'loopback'.
+              (requirement '(user-processes loopback syslogd))
+
+              (start #~(make-forkexec-constructor
+                        (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
+              (stop #~(make-kill-destructor))
+              (documentation "Run the Tor anonymous network overlay.")))))))
+
+(define (tor-hidden-service-activation config)
+  "Return the activation gexp for SERVICES, a list of hidden services."
+  #~(begin
+      (use-modules (guix build utils))
+
+      (define %user
+        (getpw "tor"))
 
-           ;; Tor needs at least one network interface to be up, hence the
-           ;; dependency on 'loopback'.
-           (requirement '(user-processes loopback))
+      (define (initialize service)
+        (let ((directory (string-append "/var/lib/tor/hidden-services/"
+                                        service)))
+          (mkdir-p directory)
+          (chown directory (passwd:uid %user) (passwd:gid %user))
 
-           (start #~(make-forkexec-constructor
-                     (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
-           (stop #~(make-kill-destructor))
-           (documentation "Run the Tor anonymous network overlay.")))))
+          ;; The daemon bails out if we give wider permissions.
+          (chmod directory #o700)))
+
+      (mkdir-p "/var/lib/tor")
+      (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
+      (chmod "/var/lib/tor" #o700)
+
+      (for-each initialize
+                '#$(map hidden-service-name
+                        (tor-configuration-hidden-services config)))))
 
 (define tor-service-type
   (service-type (name 'tor)
@@ -337,14 +424,59 @@ keep the system clock synchronized with that of @var{servers}."
                  (list (service-extension dmd-root-service-type
                                           tor-dmd-service)
                        (service-extension account-service-type
-                                          (const %tor-accounts))))))
+                                          (const %tor-accounts))
+                       (service-extension activation-service-type
+                                          tor-hidden-service-activation)))
+
+                ;; This can be extended with hidden services.
+                (compose concatenate)
+                (extend (lambda (config services)
+                          (tor-configuration
+                           (inherit config)
+                           (hidden-services
+                            (append (tor-configuration-hidden-services config)
+                                    services)))))))
+
+(define* (tor-service #:optional
+                      (config-file (plain-file "empty" ""))
+                      #:key (tor tor))
+  "Return a service to run the @uref{https://torproject.org, Tor} anonymous
+networking daemon.
+
+The daemon runs as the @code{tor} unprivileged user.  It is passed
+@var{config-file}, a file-like object, with an additional @code{User tor} line
+and lines for hidden services added via @code{tor-hidden-service}.  Run
+@command{man tor} for information about the configuration file."
+  (service tor-service-type
+           (tor-configuration (tor tor)
+                              (config-file config-file))))
+
+(define tor-hidden-service-type
+  ;; A type that extends Tor with hidden services.
+  (service-type (name 'tor-hidden-service)
+                (extensions
+                 (list (service-extension tor-service-type list)))))
+
+(define (tor-hidden-service name mapping)
+  "Define a new Tor @dfn{hidden service} called @var{name} and implementing
+@var{mapping}.  @var{mapping} is a list of port/host tuples, such as:
 
-(define* (tor-service #:key (tor tor))
-  "Return a service to run the @uref{https://torproject.org,Tor} daemon.
+@example
+ '((22 \"127.0.0.1:22\")
+   (80 \"127.0.0.1:8080\"))
+@end example
 
-The daemon runs with the default settings (in particular the default exit
-policy) as the @code{tor} unprivileged user."
-  (service tor-service-type tor))
+In this example, port 22 of the hidden service is mapped to local port 22, and
+port 80 is mapped to local port 8080.
+
+This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
+the @file{hostname} file contains the @code{.onion} host name for the hidden
+service.
+
+See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
+project's documentation} for more information."
+  (service tor-hidden-service-type
+           (hidden-service name mapping)))
 
 
 ;;;
@@ -466,11 +598,58 @@ configuration file."
                        (service-extension dbus-root-service-type
                                           list)
                        (service-extension activation-service-type
-                                          (const %wicd-activation))))))
+                                          (const %wicd-activation))
+
+                       ;; Add Wicd to the global profile.
+                       (service-extension profile-service-type list)))))
 
 (define* (wicd-service #:key (wicd wicd))
   "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
-manager that aims to simplify wired and wireless networking."
+management daemon that aims to simplify wired and wireless networking.
+
+This service adds the @var{wicd} package to the global profile, providing
+several commands to interact with the daemon and configure networking:
+@command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
+and @command{wicd-curses} user interfaces."
   (service wicd-service-type wicd))
 
+
+;;;
+;;; NetworkManager
+;;;
+
+(define %network-manager-activation
+  ;; Activation gexp for NetworkManager.
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/etc/NetworkManager/system-connections")))
+
+(define (network-manager-dmd-service network-manager)
+  "Return a dmd service for NETWORK-MANAGER."
+  (list (dmd-service
+         (documentation "Run the NetworkManager.")
+         (provision '(networking))
+         (requirement '(user-processes dbus-system loopback))
+         (start #~(make-forkexec-constructor
+                   (list (string-append #$network-manager
+                                        "/sbin/NetworkManager")
+                         "--no-daemon")))
+         (stop #~(make-kill-destructor)))))
+
+(define network-manager-service-type
+  (service-type (name 'network-manager)
+                (extensions
+                 (list (service-extension dmd-root-service-type
+                                          network-manager-dmd-service)
+                       (service-extension dbus-root-service-type list)
+                       (service-extension activation-service-type
+                                          (const %network-manager-activation))
+                       ;; Add network-manager to the system profile.
+                       (service-extension profile-service-type list)))))
+
+(define* (network-manager-service #:key (network-manager network-manager))
+  "Return a service that runs NetworkManager, a network connection manager
+that attempting to keep active network connectivity when available."
+  (service network-manager-service-type network-manager))
+
 ;;; networking.scm ends here
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index d3a6cfb33a..4b0380e8fd 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -21,8 +21,9 @@
   #:use-module (guix records)
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
-  #:use-module (gnu system linux)                 ; 'pam-service'
+  #:use-module (gnu system pam)
   #:use-module (gnu packages lsh)
+  #:use-module (srfi srfi-26)
   #:export (lsh-service))
 
 ;;; Commentary:
@@ -142,8 +143,8 @@
                 "--tcpip-forward" "--no-tcpip-forward")
             (if (null? interfaces)
                 '()
-                (list (string-append "--interfaces="
-                                     (string-join interfaces ",")))))))
+                (map (cut string-append "--interface=" <>)
+                     interfaces)))))
 
   (define requires
     (if (and daemonic? (lsh-configuration-syslog-output? config))
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 3a57891a96..7fea6829d5 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu artwork)
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
-  #:use-module (gnu system linux)                 ; 'pam-service'
+  #:use-module (gnu system pam)
   #:use-module ((gnu packages base) #:select (canonical-package))
   #:use-module (gnu packages guile)
   #:use-module (gnu packages xorg)
@@ -32,16 +32,23 @@
   #:use-module (gnu packages bash)
   #:use-module (guix gexp)
   #:use-module (guix store)
+  #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (xorg-configuration-file
             xorg-start-command
             %default-slim-theme
             %default-slim-theme-name
-            slim-service))
+            slim-configuration
+            slim-service-type
+            slim-service
+
+            screen-locker-service-type
+            screen-locker-service))
 
 ;;; Commentary:
 ;;;
@@ -304,7 +311,12 @@ reboot_cmd " dmd "/sbin/reboot\n"
                  (list (service-extension dmd-root-service-type
                                           slim-dmd-service)
                        (service-extension pam-root-service-type
-                                          slim-pam-service)))))
+                                          slim-pam-service)
+
+                       ;; Unconditionally add xterm to the system profile, to
+                       ;; avoid bad surprises.
+                       (service-extension profile-service-type
+                                          (const (list xterm)))))))
 
 (define* (slim-service #:key (slim slim)
                        (allow-empty-passwords? #t) auto-login?
@@ -350,4 +362,52 @@ theme."
             (auto-login-session auto-login-session)
             (startx startx))))
 
+
+;;;
+;;; Screen lockers & co.
+;;;
+
+(define-record-type <screen-locker>
+  (screen-locker name program empty?)
+  screen-locker?
+  (name    screen-locker-name)                     ;string
+  (program screen-locker-program)                  ;gexp
+  (empty?  screen-locker-allows-empty-passwords?)) ;Boolean
+
+(define screen-locker-pam-services
+  (match-lambda
+    (($ <screen-locker> name _ empty?)
+     (list (unix-pam-service name
+                             #:allow-empty-passwords? empty?)))))
+
+(define screen-locker-setuid-programs
+  (compose list screen-locker-program))
+
+(define screen-locker-service-type
+  (service-type (name 'screen-locker)
+                (extensions
+                 (list (service-extension pam-root-service-type
+                                          screen-locker-pam-services)
+                       (service-extension setuid-program-service-type
+                                          screen-locker-setuid-programs)))))
+
+(define* (screen-locker-service package
+                                #:optional
+                                (program (package-name package))
+                                #:key allow-empty-passwords?)
+  "Add @var{package}, a package for a screen-locker or screen-saver whose
+command is @var{program}, to the set of setuid programs and add a PAM entry
+for it.  For example:
+
+@lisp
+(screen-locker-service xlockmore \"xlock\")
+@end lisp
+
+makes the good ol' XlockMore usable."
+  (service screen-locker-service-type
+           (screen-locker program
+                          #~(string-append #$package
+                                           #$(string-append "/bin/" program))
+                          allow-empty-passwords?)))
+
 ;;; xorg.scm ends here