summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/avahi.scm2
-rw-r--r--gnu/services/base.scm19
-rw-r--r--gnu/services/colord.scm72
-rw-r--r--gnu/services/databases.scm121
-rw-r--r--gnu/services/dbus.scm127
-rw-r--r--gnu/services/desktop.scm300
-rw-r--r--gnu/services/networking.scm34
-rw-r--r--gnu/services/upower.scm122
-rw-r--r--gnu/services/xorg.scm73
9 files changed, 520 insertions, 350 deletions
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm
index 0a56f3d7f6..a3ca5ab6fb 100644
--- a/gnu/services/avahi.scm
+++ b/gnu/services/avahi.scm
@@ -63,7 +63,7 @@
                         (domains-to-browse '()))
   "Return a service that runs @command{avahi-daemon}, a system-wide
 mDNS/DNS-SD responder that allows for service discovery and
-\"zero-configuration\" host name lookups.
+\"zero-configuration\" host name lookups (see @uref{http://avahi.org/}).
 
 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 d0a2e8c848..d5744204d9 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -46,6 +47,7 @@
             swap-service
             user-processes-service
             host-name-service
+            console-keymap-service
             console-font-service
             udev-service
             mingetty-service
@@ -313,6 +315,19 @@ stopped before 'kill' is called."
           (else
            (zero? (cdr (waitpid pid))))))))
 
+(define (console-keymap-service file)
+  "Return a service to load console keymap from @var{file}."
+  (with-monad %store-monad
+    (return
+     (service
+      (documentation
+       (string-append "Load console keymap (loadkeys)."))
+      (provision '(console-keymap))
+      (start #~(lambda _
+                 (zero? (system* (string-append #$kbd "/bin/loadkeys")
+                                 #$file))))
+      (respawn? #f)))))
+
 (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16"))
   "Return a service that sets up Unicode support in @var{tty} and loads
 @var{font} for that tty (fonts are per virtual console in Linux.)"
@@ -836,10 +851,10 @@ gexp, to open it, and evaluate @var{close} to close it."
              (requirement `(udev ,@requirement))
              (documentation "Enable the given swap device.")
              (start #~(lambda ()
-                        (swapon #$device)
+                        (restart-on-EINTR (swapon #$device))
                         #t))
              (stop #~(lambda _
-                       (swapoff #$device)
+                       (restart-on-EINTR (swapoff #$device))
                        #f))
              (respawn? #f)))))
 
diff --git a/gnu/services/colord.scm b/gnu/services/colord.scm
deleted file mode 100644
index 588436002c..0000000000
--- a/gnu/services/colord.scm
+++ /dev/null
@@ -1,72 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (gnu services colord)
-  #:use-module (gnu services)
-  #:use-module (gnu system shadow)
-  #:use-module (gnu packages gnome)
-  #:use-module (ice-9 match)
-  #:use-module (guix monads)
-  #:use-module (guix store)
-  #:use-module (guix gexp)
-  #:export (colord-service))
-
-;;; Commentary:
-;;;
-;;; This module provides service definitions for the colord color management
-;;; service.
-;;;
-;;; Code:
-
-(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."
-  (with-monad %store-monad
-    (return
-     (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))
-      (activate #~(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)))))
-
-      (user-groups (list (user-group
-                          (name "colord")
-                          (system? #t))))
-      (user-accounts (list (user-account
-                            (name "colord")
-                            (group "colord")
-                            (system? #t)
-                            (comment "colord daemon user")
-                            (home-directory "/var/empty")
-                            (shell
-                             "/run/current-system/profile/sbin/nologin"))))))))
-
-;;; colord.scm ends here
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
new file mode 100644
index 0000000000..18f41e74da
--- /dev/null
+++ b/gnu/services/databases.scm
@@ -0,0 +1,121 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services databases)
+  #:use-module (gnu services)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages databases)
+  #:use-module (guix records)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (guix gexp)
+  #:export (postgresql-service))
+
+;;; Commentary:
+;;;
+;;; Database services.
+;;;
+;;; Code:
+
+(define %default-postgres-hba
+  (text-file "pg_hba.conf"
+             "
+local	all	all			trust
+host	all	all	127.0.0.1/32 	trust
+host	all	all	::1/128 	trust"))
+
+(define %default-postgres-ident
+  (text-file "pg_ident.conf"
+             "# MAPNAME       SYSTEM-USERNAME         PG-USERNAME"))
+
+(define %default-postgres-config
+  (mlet %store-monad ((hba %default-postgres-hba)
+                      (ident %default-postgres-ident))
+    (text-file* "postgresql.conf"
+                ;; The daemon will not start without these.
+                "hba_file = '" hba "'\n"
+                "ident_file = '" ident "'\n")))
+
+(define* (postgresql-service #:key (postgresql postgresql)
+                             (config-file %default-postgres-config)
+                             (data-directory "/var/lib/postgresql/data"))
+  "Return a service that runs @var{postgresql}, the PostgreSQL database server.
+
+The PostgreSQL daemon loads its runtime configuration from @var{config-file}
+and stores the database cluster in @var{data-directory}."
+  ;; Wrapper script that switches to the 'postgres' user before launching
+  ;; daemon.
+  (define start-script
+    (mlet %store-monad ((config-file config-file))
+      (gexp->script "start-postgres"
+                    #~(let ((user (getpwnam "postgres"))
+                            (postgres (string-append #$postgresql
+                                                     "/bin/postgres")))
+                        (setgid (passwd:gid user))
+                        (setuid (passwd:uid user))
+                        (system* postgres
+                                 (string-append "--config-file=" #$config-file)
+                                 "-D" #$data-directory)))))
+
+  (define activate
+    #~(begin
+        (use-modules (guix build utils)
+                     (ice-9 match))
+
+        (let ((user (getpwnam "postgres"))
+              (initdb (string-append #$postgresql "/bin/initdb")))
+          ;; Create db state directory.
+          (mkdir-p #$data-directory)
+          (chown #$data-directory (passwd:uid user) (passwd:gid user))
+
+          ;; Drop privileges and init state directory in a new
+          ;; process.  Wait for it to finish before proceeding.
+          (match (primitive-fork)
+            (0
+             ;; Exit with a non-zero status code if an exception is thrown.
+             (dynamic-wind
+               (const #t)
+               (lambda ()
+                 (setgid (passwd:gid user))
+                 (setuid (passwd:uid user))
+                 (primitive-exit (system* initdb "-D" #$data-directory)))
+               (lambda ()
+                 (primitive-exit 1))))
+            (pid (waitpid pid))))))
+
+  (mlet %store-monad ((start-script start-script))
+    (return
+     (service
+      (provision '(postgres))
+      (documentation "Run the PostgreSQL daemon.")
+      (requirement '(user-processes loopback))
+      (start #~(make-forkexec-constructor #$start-script))
+      (stop #~(make-kill-destructor))
+      (activate activate)
+      (user-groups (list (user-group
+                          (name "postgres")
+                          (system? #t))))
+      (user-accounts (list (user-account
+                            (name "postgres")
+                            (group "postgres")
+                            (system? #t)
+                            (comment "PostgreSQL server user")
+                            (home-directory "/var/empty")
+                            (shell
+                             #~(string-append #$shadow "/sbin/nologin")))))))))
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
deleted file mode 100644
index 8f3b350951..0000000000
--- a/gnu/services/dbus.scm
+++ /dev/null
@@ -1,127 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (gnu services dbus)
-  #:use-module (gnu services)
-  #:use-module (gnu system shadow)
-  #:use-module (gnu packages glib)
-  #:use-module (gnu packages admin)
-  #:use-module (guix monads)
-  #:use-module (guix store)
-  #:use-module (guix gexp)
-  #:export (dbus-service))
-
-;;; Commentary:
-;;;
-;;; This module supports the configuration of the D-Bus message bus
-;;; (http://dbus.freedesktop.org/).  D-Bus is an inter-process communication
-;;; facility.  Its "system bus" is used to allow system services to
-;;; communicate and be notified of system-wide events.
-;;;
-;;; Code:
-
-(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
-@var{services}."
-  (define build
-    #~(begin
-        (use-modules (sxml simple)
-                     (srfi srfi-1))
-
-        (define (services->sxml services)
-          ;; Return the SXML 'includedir' clauses for DIRS.
-          `(busconfig
-            ,@(append-map (lambda (dir)
-                            `((includedir
-                               ,(string-append dir "/etc/dbus-1/system.d"))
-                              (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"))
-
-        ;; 'system-local.conf' is automatically included by the default
-        ;; 'system.conf', so this is where we stuff our own things.
-        (call-with-output-file (string-append #$output "/system-local.conf")
-          (lambda (port)
-            (sxml->xml (services->sxml (list #$@services))
-                       port)))))
-
-  (gexp->derivation "dbus-configuration" build))
-
-(define* (dbus-service services #:key (dbus dbus))
-  "Return a service that runs the system bus, using @var{dbus}, with support
-for @var{services}.
-
-@var{services} must be a list of packages that provide an
-@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
-and policy files.  For example, to allow avahi-daemon to use the system bus,
-@var{services} must be equal to @code{(list avahi)}."
-  (mlet %store-monad ((conf (dbus-configuration-directory dbus services)))
-    (return
-     (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))
-      (user-groups (list (user-group
-                          (name "messagebus")
-                          (system? #t))))
-      (user-accounts (list (user-account
-                            (name "messagebus")
-                            (group "messagebus")
-                            (system? #t)
-                            (comment "D-Bus system bus user")
-                            (home-directory "/var/run/dbus")
-                            (shell
-                             #~(string-append #$shadow "/sbin/nologin")))))
-      (activate #~(begin
-                    (use-modules (guix build utils))
-
-                    (mkdir-p "/var/run/dbus")
-
-                    (let ((user (getpwnam "messagebus")))
-                      (chown "/var/run/dbus"
-                             (passwd:uid user) (passwd:gid user)))
-
-                    (unless (file-exists? "/etc/machine-id")
-                      (format #t "creating /etc/machine-id...~%")
-                      (let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
-                        ;; XXX: We can't use 'system' because the initrd's
-                        ;; guile system(3) only works when 'sh' is in $PATH.
-                        (let ((pid (primitive-fork)))
-                          (if (zero? pid)
-                              (call-with-output-file "/etc/machine-id"
-                                (lambda (port)
-                                  (close-fdes 1)
-                                  (dup2 (port->fdes port) 1)
-                                  (execl prog)))
-                              (waitpid pid)))))))))))
-
-;;; dbus.scm ends here
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
new file mode 100644
index 0000000000..910dc1f9e0
--- /dev/null
+++ b/gnu/services/desktop.scm
@@ -0,0 +1,300 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services desktop)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services avahi)
+  #:use-module (gnu services xorg)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages glib)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages gnome)
+  #:use-module (gnu packages avahi)
+  #:use-module (gnu packages wicd)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (guix gexp)
+  #:use-module (ice-9 match)
+  #:export (dbus-service
+            upower-service
+            colord-service
+            %desktop-services))
+
+;;; Commentary:
+;;;
+;;; This module contains service definitions for a "desktop" environment.
+;;;
+;;; Code:
+
+
+;;;
+;;; D-Bus.
+;;;
+
+(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
+@var{services}."
+  (define build
+    #~(begin
+        (use-modules (sxml simple)
+                     (srfi srfi-1))
+
+        (define (services->sxml services)
+          ;; Return the SXML 'includedir' clauses for DIRS.
+          `(busconfig
+            ,@(append-map (lambda (dir)
+                            `((includedir
+                               ,(string-append dir "/etc/dbus-1/system.d"))
+                              (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"))
+
+        ;; 'system-local.conf' is automatically included by the default
+        ;; 'system.conf', so this is where we stuff our own things.
+        (call-with-output-file (string-append #$output "/system-local.conf")
+          (lambda (port)
+            (sxml->xml (services->sxml (list #$@services))
+                       port)))))
+
+  (gexp->derivation "dbus-configuration" build))
+
+(define* (dbus-service services #:key (dbus dbus))
+  "Return a service that runs the \"system bus\", using @var{dbus}, with
+support for @var{services}.
+
+@uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication
+facility.  Its system bus is used to allow system services to communicate and
+be notified of system-wide events.
+
+@var{services} must be a list of packages that provide an
+@file{etc/dbus-1/system.d} directory containing additional D-Bus configuration
+and policy files.  For example, to allow avahi-daemon to use the system bus,
+@var{services} must be equal to @code{(list avahi)}."
+  (mlet %store-monad ((conf (dbus-configuration-directory dbus services)))
+    (return
+     (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))
+      (user-groups (list (user-group
+                          (name "messagebus")
+                          (system? #t))))
+      (user-accounts (list (user-account
+                            (name "messagebus")
+                            (group "messagebus")
+                            (system? #t)
+                            (comment "D-Bus system bus user")
+                            (home-directory "/var/run/dbus")
+                            (shell
+                             #~(string-append #$shadow "/sbin/nologin")))))
+      (activate #~(begin
+                    (use-modules (guix build utils))
+
+                    (mkdir-p "/var/run/dbus")
+
+                    (let ((user (getpwnam "messagebus")))
+                      (chown "/var/run/dbus"
+                             (passwd:uid user) (passwd:gid user)))
+
+                    (unless (file-exists? "/etc/machine-id")
+                      (format #t "creating /etc/machine-id...~%")
+                      (let ((prog (string-append #$dbus "/bin/dbus-uuidgen")))
+                        ;; XXX: We can't use 'system' because the initrd's
+                        ;; guile system(3) only works when 'sh' is in $PATH.
+                        (let ((pid (primitive-fork)))
+                          (if (zero? pid)
+                              (call-with-output-file "/etc/machine-id"
+                                (lambda (port)
+                                  (close-fdes 1)
+                                  (dup2 (port->fdes port) 1)
+                                  (execl prog)))
+                              (waitpid pid)))))))))))
+
+
+;;;
+;;; Upower D-Bus service.
+;;;
+
+(define* (upower-configuration-file #:key watts-up-pro? poll-batteries?
+                                    ignore-lid? use-percentage-for-policy?
+                                    percentage-low percentage-critical
+                                    percentage-action time-low
+                                    time-critical time-action
+                                    critical-power-action)
+  "Return an upower-daemon configuration file."
+  (define (bool value)
+    (if value "true\n" "false\n"))
+
+  (text-file "UPower.conf"
+             (string-append
+              "[UPower]\n"
+              "EnableWattsUpPro=" (bool watts-up-pro?)
+              "NoPollBatteries=" (bool (not poll-batteries?))
+              "IgnoreLid=" (bool ignore-lid?)
+              "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
+              "PercentageLow=" (number->string percentage-low) "\n"
+              "PercentageCritical=" (number->string percentage-critical) "\n"
+              "PercentageAction=" (number->string percentage-action) "\n"
+              "TimeLow=" (number->string time-low) "\n"
+              "TimeCritical=" (number->string time-critical) "\n"
+              "TimeAction=" (number->string time-action) "\n"
+              "CriticalPowerAction=" (match critical-power-action
+                                       ('hybrid-sleep "HybridSleep")
+                                       ('hibernate "Hibernate")
+                                       ('power-off "PowerOff"))
+              "\n")))
+
+(define* (upower-service #:key (upower upower)
+                         (watts-up-pro? #f)
+                         (poll-batteries? #t)
+                         (ignore-lid? #f)
+                         (use-percentage-for-policy? #f)
+                         (percentage-low 10)
+                         (percentage-critical 3)
+                         (percentage-action 2)
+                         (time-low 1200)
+                         (time-critical 300)
+                         (time-action 120)
+                         (critical-power-action 'hybrid-sleep))
+  "Return a service that runs @uref{http://upower.freedesktop.org/,
+@command{upowerd}}, a system-wide monitor for power consumption and battery
+levels, with the given configuration settings.  It implements the
+@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME."
+  (mlet %store-monad ((config (upower-configuration-file
+                               #:watts-up-pro? watts-up-pro?
+                               #:poll-batteries? poll-batteries?
+                               #:ignore-lid? ignore-lid?
+                               #:use-percentage-for-policy? use-percentage-for-policy?
+                               #:percentage-low percentage-low
+                               #:percentage-critical percentage-critical
+                               #:percentage-action percentage-action
+                               #:time-low time-low
+                               #:time-critical time-critical
+                               #:time-action time-action
+                               #:critical-power-action critical-power-action)))
+    (return
+     (service
+      (documentation "Run the UPower power and battery monitor.")
+      (provision '(upower-daemon))
+      (requirement '(dbus-system udev))
+
+      (start #~(make-forkexec-constructor
+                (list (string-append #$upower "/libexec/upowerd"))
+                #:environment-variables
+                (list (string-append "UPOWER_CONF_FILE_NAME=" #$config))))
+      (stop #~(make-kill-destructor))
+      (activate #~(begin
+                    (use-modules (guix build utils))
+                    (mkdir-p "/var/lib/upower")
+                    (let ((user (getpwnam "upower")))
+                      (chown "/var/lib/upower"
+                             (passwd:uid user) (passwd:gid user)))))
+
+      (user-groups (list (user-group
+                          (name "upower")
+                          (system? #t))))
+      (user-accounts (list (user-account
+                            (name "upower")
+                            (group "upower")
+                            (system? #t)
+                            (comment "UPower daemon user")
+                            (home-directory "/var/empty")
+                            (shell
+                             #~(string-append #$shadow "/sbin/nologin")))))))))
+
+
+;;;
+;;; Colord D-Bus service.
+;;;
+
+(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."
+  (with-monad %store-monad
+    (return
+     (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))
+      (activate #~(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)))))
+
+      (user-groups (list (user-group
+                          (name "colord")
+                          (system? #t))))
+      (user-accounts (list (user-account
+                            (name "colord")
+                            (group "colord")
+                            (system? #t)
+                            (comment "colord daemon user")
+                            (home-directory "/var/empty")
+                            (shell
+                             #~(string-append #$shadow "/sbin/nologin")))))))))
+
+(define %desktop-services
+  ;; List of services typically useful for a "desktop" use case.
+  (cons* (slim-service)
+
+         (avahi-service)
+         (wicd-service)
+         (upower-service)
+         (colord-service)
+         (dbus-service (list avahi wicd upower colord))
+
+         (ntp-service)
+         (lsh-service)
+
+         (map (lambda (mservice)
+                ;; Provide an nscd ready to use nss-mdns.
+                (mlet %store-monad ((service mservice))
+                  (if (memq 'nscd (service-provision service))
+                      (nscd-service (nscd-configuration)
+                                    #:name-services (list nss-mdns))
+                      mservice)))
+              %base-services)))
+
+;;; desktop.scm ends here
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index f9d262d977..102202c853 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -170,15 +170,33 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
                         ;; up*.  However, the relevant interfaces are
                         ;; typically down at this point.  Thus we perform our
                         ;; own interface discovery here.
-                        (let* ((valid? (negate loopback-network-interface?))
-                               (ifaces (filter valid?
-                                               (all-network-interfaces)))
-                               (pid    (fork+exec-command
-                                        (cons* #$dhclient "-nw"
-                                               "-pf" #$pid-file
-                                               ifaces))))
+                        (define valid?
+                          (negate loopback-network-interface?))
+                        (define ifaces
+                          (filter valid? (all-network-interfaces)))
+
+                        ;; XXX: Make sure the interfaces are up so that
+                        ;; 'dhclient' can actually send/receive over them.
+                        (for-each set-network-interface-up ifaces)
+
+                        (false-if-exception (delete-file #$pid-file))
+                        (let ((pid (fork+exec-command
+                                    (cons* #$dhclient "-nw"
+                                           "-pf" #$pid-file ifaces))))
                           (and (zero? (cdr (waitpid pid)))
-                               (call-with-input-file #$pid-file read)))))
+                               (let loop ()
+                                 (catch 'system-error
+                                   (lambda ()
+                                     (call-with-input-file #$pid-file read))
+                                   (lambda args
+                                     ;; 'dhclient' returned before PID-FILE
+                                     ;; was created, so try again.
+                                     (let ((errno (system-error-errno args)))
+                                       (if (= ENOENT errno)
+                                           (begin
+                                             (sleep 1)
+                                             (loop))
+                                           (apply throw args))))))))))
              (stop #~(make-kill-destructor))))))
 
 (define %ntp-servers
diff --git a/gnu/services/upower.scm b/gnu/services/upower.scm
deleted file mode 100644
index 3654c812f1..0000000000
--- a/gnu/services/upower.scm
+++ /dev/null
@@ -1,122 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (gnu services upower)
-  #:use-module (gnu services)
-  #:use-module (gnu system shadow)
-  #:use-module (gnu packages gnome)
-  #:use-module (ice-9 match)
-  #:use-module (guix monads)
-  #:use-module (guix store)
-  #:use-module (guix gexp)
-  #:export (upower-service))
-
-;;; Commentary:
-;;;
-;;; This module provides service definitions for the UPower power and battery
-;;; monitoring service.
-;;;
-;;; Code:
-
-(define* (configuration-file #:key watts-up-pro? poll-batteries? ignore-lid?
-                             use-percentage-for-policy? percentage-low
-                             percentage-critical percentage-action
-                             time-low time-critical time-action
-                             critical-power-action)
-  "Return an upower-daemon configuration file."
-  (define (bool value)
-    (if value "true\n" "false\n"))
-
-  (text-file "UPower.conf"
-             (string-append
-              "[UPower]\n"
-              "EnableWattsUpPro=" (bool watts-up-pro?)
-              "NoPollBatteries=" (bool (not poll-batteries?))
-              "IgnoreLid=" (bool ignore-lid?)
-              "UsePercentageForPolicy=" (bool use-percentage-for-policy?)
-              "PercentageLow=" (number->string percentage-low) "\n"
-              "PercentageCritical=" (number->string percentage-critical) "\n"
-              "PercentageAction=" (number->string percentage-action) "\n"
-              "TimeLow=" (number->string time-low) "\n"
-              "TimeCritical=" (number->string time-critical) "\n"
-              "TimeAction=" (number->string time-action) "\n"
-              "CriticalPowerAction=" (match critical-power-action
-                                       ('hybrid-sleep "HybridSleep")
-                                       ('hibernate "Hibernate")
-                                       ('power-off "PowerOff"))
-              "\n")))
-
-(define* (upower-service #:key (upower upower)
-                         (watts-up-pro? #f)
-                         (poll-batteries? #t)
-                         (ignore-lid? #f)
-                         (use-percentage-for-policy? #f)
-                         (percentage-low 10)
-                         (percentage-critical 3)
-                         (percentage-action 2)
-                         (time-low 1200)
-                         (time-critical 300)
-                         (time-action 120)
-                         (critical-power-action 'hybrid-sleep))
-  "Return a service that runs @uref{http://upower.freedesktop.org/,
-@command{upowerd}}, a system-wide monitor for power consumption and battery
-levels, with the given configuration settings.  It implements the
-@code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME."
-  (mlet %store-monad ((config (configuration-file
-                               #:watts-up-pro? watts-up-pro?
-                               #:poll-batteries? poll-batteries?
-                               #:ignore-lid? ignore-lid?
-                               #:use-percentage-for-policy? use-percentage-for-policy?
-                               #:percentage-low percentage-low
-                               #:percentage-critical percentage-critical
-                               #:percentage-action percentage-action
-                               #:time-low time-low
-                               #:time-critical time-critical
-                               #:time-action time-action
-                               #:critical-power-action critical-power-action)))
-    (return
-     (service
-      (documentation "Run the UPower power and battery monitor.")
-      (provision '(upower-daemon))
-      (requirement '(dbus-system udev))
-
-      (start #~(make-forkexec-constructor
-                (list (string-append #$upower "/libexec/upowerd"))
-                #:environment-variables
-                (list (string-append "UPOWER_CONF_FILE_NAME=" #$config))))
-      (stop #~(make-kill-destructor))
-      (activate #~(begin
-                    (use-modules (guix build utils))
-                    (mkdir-p "/var/lib/upower")
-                    (let ((user (getpwnam "upower")))
-                      (chown "/var/lib/upower"
-                             (passwd:uid user) (passwd:gid user)))))
-
-      (user-groups (list (user-group
-                          (name "upower")
-                          (system? #t))))
-      (user-accounts (list (user-account
-                            (name "upower")
-                            (group "upower")
-                            (system? #t)
-                            (comment "UPower daemon user")
-                            (home-directory "/var/empty")
-                            (shell
-                             "/run/current-system/profile/sbin/nologin"))))))))
-
-;;; upower.scm ends here
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index c687b46bc2..9ee88170e4 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -37,7 +37,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (xorg-start-command
+  #:export (xorg-configuration-file
+            xorg-start-command
             %default-slim-theme
             %default-slim-theme-name
             slim-service))
@@ -48,12 +49,10 @@
 ;;;
 ;;; Code:
 
-(define* (xorg-start-command #:key
-                             (guile (canonical-package guile-2.0))
-                             (xorg-server xorg-server)
-                             (drivers '()) (resolutions '()))
-  "Return a derivation that builds a @var{guile} script to start the X server
-from @var{xorg-server}.  Usually the X server is started by a login manager.
+(define* (xorg-configuration-file #:key (drivers '()) (resolutions '())
+                                  (extra-config '()))
+  "Return a configuration file for the Xorg server containing search paths for
+all the common drivers.
 
 @var{drivers} must be either the empty list, in which case Xorg chooses a
 graphics driver automatically, or a list of driver names that will be tried in
@@ -61,8 +60,11 @@ this order---e.g., @code{(\"modesetting\" \"vesa\")}.
 
 Likewise, when @var{resolutions} is the empty list, Xorg chooses an
 appropriate screen resolution; otherwise, it must be a list of
-resolutions---e.g., @code{((1024 768) (640 480))}."
+resolutions---e.g., @code{((1024 768) (640 480))}.
 
+Last, @var{extra-config} is a list of strings or objects appended to the
+@code{text-file*} argument list.  It is used to pass extra text to be added
+verbatim to the configuration file."
   (define (device-section driver)
     (string-append "
 Section \"Device\"
@@ -78,15 +80,14 @@ Section \"Screen\"
   SubSection \"Display\"
     Modes "
   (string-join (map (match-lambda
-                     ((x y)
-                      (string-append "\"" (number->string x)
-                                     "x" (number->string y) "\"")))
+                      ((x y)
+                       (string-append "\"" (number->string x)
+                                      "x" (number->string y) "\"")))
                     resolutions)) "
   EndSubSection
 EndSection"))
 
-  (define (xserver.conf)
-    (text-file* "xserver.conf" "
+  (apply text-file* "xserver.conf" "
 Section \"Files\"
   FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\"
   ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
@@ -98,6 +99,12 @@ Section \"Files\"
   ModulePath \"" xf86-video-nouveau "/lib/xorg/modules/drivers\"
   ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\"
   ModulePath \"" xf86-video-sis "/lib/xorg/modules/drivers\"
+
+  # Libinput is the new thing and is recommended over evdev/synaptics
+  # by those who know:
+  # <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
+  ModulePath \"" xf86-input-libinput "/lib/xorg/modules/input\"
+
   ModulePath \"" xf86-input-evdev "/lib/xorg/modules/input\"
   ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
   ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
@@ -111,12 +118,27 @@ Section \"ServerFlags\"
   Option \"AllowMouseOpenFail\" \"on\"
 EndSection
 "
-  (string-join (map device-section drivers) "\n")
+  (string-join (map device-section drivers) "\n") "\n"
   (string-join (map (cut screen-section <> resolutions)
                     drivers)
-               "\n")))
+               "\n")
+
+  "\n"
+  extra-config))
 
-  (mlet %store-monad ((config (xserver.conf)))
+(define* (xorg-start-command #:key
+                             (guile (canonical-package guile-2.0))
+                             configuration-file
+                             (xorg-server xorg-server))
+  "Return a derivation that builds a @var{guile} script to start the X server
+from @var{xorg-server}.  @var{configuration-file} is the server configuration
+file or a derivation that builds it; when omitted, the result of
+@code{xorg-configuration-file} is used.
+
+Usually the X server is started by a login manager."
+  (mlet %store-monad ((config (if configuration-file
+                                  (return configuration-file)
+                                  (xorg-configuration-file))))
     (define script
       ;; Write a small wrapper around the X server.
       #~(begin
@@ -192,7 +214,7 @@ which should be passed to this script as the first argument.  If not, the
 (define %default-slim-theme-name
   ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that
   ;; contains the actual theme files.
-  "0.8")
+  "0.x")
 
 (define* (slim-service #:key (slim slim)
                        (allow-empty-passwords? #t) auto-login?
@@ -207,6 +229,19 @@ which should be passed to this script as the first argument.  If not, the
 turn starts the X display server with @var{startx}, a command as returned by
 @code{xorg-start-command}.
 
+@cindex X session
+
+SLiM automatically looks for session types described by the @file{.desktop}
+files in @file{/run/current-system/profile/share/xsessions} and allows users
+to choose a session from the log-in screen using @kbd{F1}.  Packages such as
+@var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files;
+adding them to the system-wide set of packages automatically makes them
+available at the log-in screen.
+
+In addition, @file{~/.xsession} files are honored.  When available,
+@file{~/.xsession} must be an executable that starts a window manager
+and/or other X clients.
+
 When @var{allow-empty-passwords?} is true, allow logins with an empty
 password.  When @var{auto-login?} is true, log in automatically as
 @var{default-user} with @var{auto-login-session}.
@@ -217,7 +252,9 @@ theme to use.  In that case, @var{theme-name} specifies the name of the
 theme."
 
   (define (slim.cfg)
-    (mlet %store-monad ((startx  (or startx (xorg-start-command)))
+    (mlet %store-monad ((startx  (if startx
+                                     (return startx)
+                                     (xorg-start-command)))
                         (xinitrc (xinitrc #:fallback-session
                                           auto-login-session)))
       (text-file* "slim.cfg"  "