Merge branch 'master' into core-updates

13 files changed, 501 insertions, 216 deletions

diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm
index ab54aaf698..73969a5a6d 100644
--- a/gnu/services/authentication.scm
+++ b/gnu/services/authentication.scm
@@ -42,17 +42,21 @@
             nslcd-configuration?
             nslcd-service-type))
 
-(define-record-type* <fprintd-configuration>
-  fprintd-configuration make-fprintd-configuration
-  fprintd-configuration?
-  (ntp      fprintd-configuration-fprintd
-            (default fprintd)))
+(define-configuration fprintd-configuration
+  (fprintd      (package fprintd)
+                "The fprintd package"))
+
+(define (fprintd-dbus-service config)
+  (list (fprintd-configuration-fprintd config)))
 
 (define fprintd-service-type
   (service-type (name 'fprintd)
                 (extensions
                  (list (service-extension dbus-root-service-type
-                                          list)))
+                                          fprintd-dbus-service)
+                       (service-extension polkit-service-type
+                                          fprintd-dbus-service)))
+                (default-value (fprintd-configuration))
                 (description
                  "Run fprintd, a fingerprint management daemon.")))
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 04b123b833..952f6f9ab2 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -510,13 +510,30 @@ FILE-SYSTEM."
     (cons* sink user-unmount
            (map file-system-shepherd-service file-systems))))
 
+(define (file-system-fstab-entries file-systems)
+  "Return the subset of @var{file-systems} that should have an entry in
+@file{/etc/fstab}."
+  ;; /etc/fstab is about telling fsck(8), mount(8), and umount(8) about
+  ;; relevant file systems they'll have to deal with.  That excludes "pseudo"
+  ;; file systems.
+  ;;
+  ;; In particular, things like GIO (part of GLib) use it to determine the set
+  ;; of mounts, which is then used by graphical file managers and desktop
+  ;; environments to display "volume" icons.  Thus, we really need to exclude
+  ;; those pseudo file systems from the list.
+  (remove (lambda (file-system)
+            (or (member (file-system-type file-system)
+                        %pseudo-file-system-types)
+                (memq 'bind-mount (file-system-flags file-system))))
+          file-systems))
+
 (define file-system-service-type
   (service-type (name 'file-systems)
                 (extensions
                  (list (service-extension shepherd-root-service-type
                                           file-system-shepherd-services)
                        (service-extension fstab-service-type
-                                          identity)
+                                          file-system-fstab-entries)
 
                        ;; Have 'user-processes' depend on 'file-systems'.
                        (service-extension user-processes-service-type
@@ -719,7 +736,8 @@ to add @var{device} to the kernel's entropy pool.  The service will fail if
                                  #$@files))))
       (respawn? #f)))))
 
-(define (console-keymap-service . files)
+(define-deprecated (console-keymap-service #:rest files)
+  #f
   "Return a service to load console keymaps from @var{files}."
   (service console-keymap-service-type files))
 
@@ -1515,19 +1533,9 @@ GID."
 (define (hydra-key-authorization keys guix)
   "Return a gexp with code to register KEYS, a list of files containing 'guix
 archive' public keys, with GUIX."
-  (define aaa
-    ;; XXX: Terrible hack to work around <https://bugs.gnu.org/15602>: this
-    ;; forces (guix config) and (guix utils) to be loaded upfront, so that
-    ;; their run-time symbols are defined.
-    (scheme-file "aaa.scm"
-                 #~(define-module (guix aaa)
-                     #:use-module (guix config)
-                     #:use-module (guix memoization))))
-
   (define default-acl
     (with-extensions (list guile-gcrypt)
       (with-imported-modules `(((guix config) => ,(make-config.scm))
-                               ((guix aaa) => ,aaa)
                                ,@(source-module-closure '((guix pki))
                                                         #:select? not-config?))
         (computed-file "acl"
diff --git a/gnu/services/certbot.scm b/gnu/services/certbot.scm
index 7565bc97ca..ae34ad17bb 100644
--- a/gnu/services/certbot.scm
+++ b/gnu/services/certbot.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 ng0 <ng0@n0.is>
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -50,6 +51,12 @@
                        (default #f))
   (domains             certificate-configuration-domains
                        (default '()))
+  (challenge           certificate-configuration-challenge
+                       (default #f))
+  (authentication-hook certificate-authentication-hook
+                       (default #f))
+  (cleanup-hook        certificate-cleanup-hook
+                       (default #f))
   (deploy-hook         certificate-configuration-deploy-hook
                        (default #f)))
 
@@ -81,17 +88,32 @@
             (commands
              (map
               (match-lambda
-                (($ <certificate-configuration> custom-name domains
+                (($ <certificate-configuration> custom-name domains challenge
+                                                authentication-hook cleanup-hook
                                                 deploy-hook)
                  (let ((name (or custom-name (car domains))))
-                   (append
-                    (list name certbot "certonly" "-n" "--agree-tos"
-                          "-m" email
-                          "--webroot" "-w" webroot
-                          "--cert-name" name
-                          "-d" (string-join domains ","))
-                    (if rsa-key-size `("--rsa-key-size" ,rsa-key-size) '())
-                    (if deploy-hook `("--deploy-hook" ,deploy-hook) '())))))
+                   (if challenge
+                     (append
+                      (list name certbot "certonly" "-n" "--agree-tos"
+                            "-m" email
+                            "--manual"
+                            (string-append "--preferred-challenges=" challenge)
+                            "--cert-name" name
+                            "-d" (string-join domains ","))
+                      (if rsa-key-size `("--rsa-key-size" ,rsa-key-size) '())
+                      (if authentication-hook
+                          `("--manual-auth-hook" ,authentication-hook)
+                          '())
+                      (if cleanup-hook `("--manual-cleanup-hook" ,cleanup-hook) '())
+                      (if deploy-hook `("--deploy-hook" ,deploy-hook) '()))
+                     (append
+                      (list name certbot "certonly" "-n" "--agree-tos"
+                            "-m" email
+                            "--webroot" "-w" webroot
+                            "--cert-name" name
+                            "-d" (string-join domains ","))
+                      (if rsa-key-size `("--rsa-key-size" ,rsa-key-size) '())
+                      (if deploy-hook `("--deploy-hook" ,deploy-hook) '()))))))
               certificates)))
        (program-file
         "certbot-command"
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 606ee0c2f5..35d7ff3c9c 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -26,6 +26,7 @@
   #:use-module (gnu packages polkit)
   #:use-module (gnu packages admin)
   #:use-module (guix gexp)
+  #:use-module ((guix packages) #:select (package-name))
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
@@ -33,6 +34,7 @@
             dbus-configuration?
             dbus-root-service-type
             dbus-service
+            wrapped-dbus-service
 
             polkit-service-type
             polkit-service))
@@ -229,6 +231,52 @@ and policy files.  For example, to allow avahi-daemon to use the system bus,
            (dbus-configuration (dbus dbus)
                                (services services))))
 
+(define (wrapped-dbus-service service program variables)
+  "Return a wrapper for @var{service}, a package containing a D-Bus service,
+where @var{program} is wrapped such that @var{variables}, a list of name/value
+tuples, are all set as environment variables when the bus daemon launches it."
+  (define wrapper
+    (program-file (string-append (package-name service) "-program-wrapper")
+                  #~(begin
+                      (use-modules (ice-9 match))
+
+                      (for-each (match-lambda
+                                  ((variable value)
+                                   (setenv variable value)))
+                                '#$variables)
+
+                      (apply execl (string-append #$service "/" #$program)
+                             (string-append #$service "/" #$program)
+                             (cdr (command-line))))))
+
+  (define build
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+
+          (define service-directory
+            "/share/dbus-1/system-services")
+
+          (mkdir-p (dirname (string-append #$output
+                                           service-directory)))
+          (copy-recursively (string-append #$service
+                                           service-directory)
+                            (string-append #$output
+                                           service-directory))
+          (symlink (string-append #$service "/etc") ;for etc/dbus-1
+                   (string-append #$output "/etc"))
+
+          (for-each (lambda (file)
+                      (substitute* file
+                        (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
+                          _ original-program arguments)
+                         (string-append "Exec=" #$wrapper arguments
+                                        "\n"))))
+                    (find-files #$output "\\.service$")))))
+
+  (computed-file (string-append (package-name service) "-wrapper")
+                 build))
+
 
 ;;;
 ;;; Polkit privilege management service.
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index b912c208cc..f31dbc112e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -103,6 +103,8 @@
             accountsservice-service-type
             accountsservice-service
 
+            cups-pk-helper-service-type
+
             gnome-desktop-configuration
             gnome-desktop-configuration?
             gnome-desktop-service
@@ -150,46 +152,6 @@
       ((package . _) package))))
 
 
-(define (wrapped-dbus-service service program variable value)
-  "Return a wrapper for @var{service}, a package containing a D-Bus service,
-where @var{program} is wrapped such that environment variable @var{variable}
-is set to @var{value} when the bus daemon launches it."
-  (define wrapper
-    (program-file (string-append (package-name service) "-program-wrapper")
-                  #~(begin
-                      (setenv #$variable #$value)
-                      (apply execl (string-append #$service "/" #$program)
-                             (string-append #$service "/" #$program)
-                             (cdr (command-line))))))
-
-  (define build
-    (with-imported-modules '((guix build utils))
-      #~(begin
-          (use-modules (guix build utils))
-
-          (define service-directory
-            "/share/dbus-1/system-services")
-
-          (mkdir-p (dirname (string-append #$output
-                                           service-directory)))
-          (copy-recursively (string-append #$service
-                                           service-directory)
-                            (string-append #$output
-                                           service-directory))
-          (symlink (string-append #$service "/etc") ;for etc/dbus-1
-                   (string-append #$output "/etc"))
-
-          (for-each (lambda (file)
-                      (substitute* file
-                        (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
-                          _ original-program arguments)
-                         (string-append "Exec=" #$wrapper arguments
-                                        "\n"))))
-                    (find-files #$output "\\.service$")))))
-
-  (computed-file (string-append (package-name service) "-wrapper")
-                 build))
-
 
 ;;;
 ;;; Upower D-Bus service.
@@ -257,8 +219,8 @@ is set to @var{value} when the bus daemon launches it."
 (define (upower-dbus-service config)
   (list (wrapped-dbus-service (upower-configuration-upower config)
                               "libexec/upowerd"
-                              "UPOWER_CONF_FILE_NAME"
-                              (upower-configuration-file config))))
+                              `(("UPOWER_CONF_FILE_NAME"
+                                 ,(upower-configuration-file config))))))
 
 (define (upower-shepherd-service config)
   "Return a shepherd service for UPower with CONFIG."
@@ -389,8 +351,8 @@ users are allowed."
 (define (geoclue-dbus-service config)
   (list (wrapped-dbus-service (geoclue-configuration-geoclue config)
                               "libexec/geoclue"
-                              "GEOCLUE_CONFIG_FILE"
-                              (geoclue-configuration-file config))))
+                              `(("GEOCLUE_CONFIG_FILE"
+                                 ,(geoclue-configuration-file config))))))
 
 (define %geoclue-accounts
   (list (user-group (name "geoclue") (system? #t))
@@ -742,8 +704,8 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
 (define (elogind-dbus-service config)
   (list (wrapped-dbus-service (elogind-package config)
                               "libexec/elogind/elogind"
-                              "ELOGIND_CONF_FILE"
-                              (elogind-configuration-file config))))
+                              `(("ELOGIND_CONF_FILE"
+                                 ,(elogind-configuration-file config))))))
 
 (define (pam-extension-procedure config)
   "Return an extension for PAM-ROOT-SERVICE-TYPE that ensures that all the PAM
@@ -884,9 +846,12 @@ rules."
           (service-extension profile-service-type
                              (compose list
                                       gnome-package))))
+   (default-value (gnome-desktop-configuration))
    (description "Run the GNOME desktop environment.")))
 
-(define* (gnome-desktop-service #:key (config (gnome-desktop-configuration)))
+(define-deprecated (gnome-desktop-service #:key (config
+                                                 (gnome-desktop-configuration)))
+  gnome-desktop-service-type
   "Return a service that adds the @code{gnome} package to the system profile,
 and extends polkit with the actions from @code{gnome-settings-daemon}."
   (service gnome-desktop-service-type config))
@@ -942,10 +907,13 @@ and extends polkit with the actions from @code{mate-settings-daemon}."
                                        "thunar")
                                       xfce-package))
           (service-extension profile-service-type
-                             (compose list
-                                      xfce-package))))))
+                             (compose list xfce-package))))
+   (default-value (xfce-desktop-configuration))
+   (description "Run the Xfce desktop environment.")))
 
-(define* (xfce-desktop-service #:key (config (xfce-desktop-configuration)))
+(define-deprecated (xfce-desktop-service #:key (config
+                                                (xfce-desktop-configuration)))
+  xfce-desktop-service-type
   "Return a service that adds the @code{xfce} package to the system profile,
 and extends polkit with the ability for @code{thunar} to manipulate the file
 system as root from within a user session, after the user has authenticated
@@ -1072,7 +1040,7 @@ dispatches events from it.")))
 
 (define %desktop-services
   ;; List of services typically useful for a "desktop" use case.
-  (cons* (service slim-service-type)
+  (cons* (service gdm-service-type)
 
          ;; Screen lockers are a pretty useful thing and these are small.
          (screen-locker-service slock)
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 1ef754b360..5f37cb0782 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -163,30 +163,40 @@
 (define-record-type* <knot-zone-configuration>
   knot-zone-configuration make-knot-zone-configuration
   knot-zone-configuration?
-  (domain           knot-zone-configuration-domain
-                    (default ""))
-  (file             knot-zone-configuration-file
-                    (default "")) ; the file where this zone is saved.
-  (zone             knot-zone-configuration-zone
-                    (default (zone-file))) ; initial content of the zone file
-  (master           knot-zone-configuration-master
-                    (default '()))
-  (ddns-master      knot-zone-configuration-ddns-master
-                    (default #f))
-  (notify           knot-zone-configuration-notify
-                    (default '()))
-  (acl              knot-zone-configuration-acl
-                    (default '()))
-  (semantic-checks? knot-zone-configuration-semantic-checks?
-                    (default #f))
-  (disable-any?     knot-zone-configuration-disable-any?
-                    (default #f))
-  (zonefile-sync    knot-zone-configuration-zonefile-sync
-                    (default 0))
-  (dnssec-policy    knot-zone-configuration-dnssec-policy
-                    (default #f))
-  (serial-policy    knot-zone-configuration-serial-policy
-                    (default 'increment)))
+  (domain            knot-zone-configuration-domain
+                     (default ""))
+  (file              knot-zone-configuration-file
+                     (default "")) ; the file where this zone is saved.
+  (zone              knot-zone-configuration-zone
+                     (default (zone-file))) ; initial content of the zone file
+  (master            knot-zone-configuration-master
+                     (default '()))
+  (ddns-master       knot-zone-configuration-ddns-master
+                     (default #f))
+  (notify            knot-zone-configuration-notify
+                     (default '()))
+  (acl               knot-zone-configuration-acl
+                     (default '()))
+  (semantic-checks?  knot-zone-configuration-semantic-checks?
+                     (default #f))
+  (disable-any?      knot-zone-configuration-disable-any?
+                     (default #f))
+  (zonefile-sync     knot-zone-configuration-zonefile-sync
+                     (default 0))
+  (zonefile-load     knot-zone-configuration-zonefile-load
+                     (default #f))
+  (journal-content   knot-zone-configuration-journal-content
+                     (default #f))
+  (max-journal-usage knot-zone-configuration-max-journal-usage
+                     (default #f))
+  (max-journal-depth knot-zone-configuration-max-journal-depth
+                     (default #f))
+  (max-zone-size     knot-zone-configuration-max-zone-size
+                     (default #f))
+  (dnssec-policy     knot-zone-configuration-dnssec-policy
+                     (default #f))
+  (serial-policy     knot-zone-configuration-serial-policy
+                     (default 'increment)))
 
 (define-record-type* <knot-remote-configuration>
   knot-remote-configuration make-knot-remote-configuration
@@ -207,6 +217,8 @@
                  (default knot))
   (run-directory knot-configuration-run-directory
                  (default "/var/run/knot"))
+  (includes      knot-configuration-includes
+                 (default '()))
   (listen-v4     knot-configuration-listen-v4
                  (default "0.0.0.0"))
   (listen-v6     knot-configuration-listen-v6
@@ -296,6 +308,8 @@
     (error-out "knot configuration field must be a package."))
   (unless (string? (knot-configuration-run-directory config))
     (error-out "run-directory must be a string."))
+  (unless (list? (knot-configuration-includes config))
+    (error-out "includes must be a list of strings or file-like objects."))
   (unless (list? (knot-configuration-keys config))
     (error-out "keys must be a list of knot-key-configuration."))
   (for-each (lambda (key) (verify-knot-key-configuration key))
@@ -332,7 +346,7 @@
           (fold (lambda (x1 x2)
                   (string-append (if (symbol? x1) (symbol->string x1) x1) ", "
                                  (if (symbol? x2) (symbol->string x2) x2)))
-                (car l) (cdr l))
+                (if (symbol? (car l)) (symbol->string (car l)) (car l)) (cdr l))
           "]"))))
 
 (define (knot-acl-config acls)
@@ -490,6 +504,12 @@
                 (acl (list #$@(knot-zone-configuration-acl zone)))
                 (semantic-checks? #$(knot-zone-configuration-semantic-checks? zone))
                 (disable-any? #$(knot-zone-configuration-disable-any? zone))
+                (zonefile-sync #$(knot-zone-configuration-zonefile-sync zone))
+                (zonefile-load '#$(knot-zone-configuration-zonefile-load zone))
+                (journal-content #$(knot-zone-configuration-journal-content zone))
+                (max-journal-usage #$(knot-zone-configuration-max-journal-usage zone))
+                (max-journal-depth #$(knot-zone-configuration-max-journal-depth zone))
+                (max-zone-size #$(knot-zone-configuration-max-zone-size zone))
                 (dnssec-policy #$(knot-zone-configuration-dnssec-policy zone))
                 (serial-policy '#$(knot-zone-configuration-serial-policy zone)))
             (format #t "    - domain: ~a\n" domain)
@@ -516,6 +536,20 @@
                           (knot-zone-configuration-acl zone))))
             (format #t "      semantic-checks: ~a\n" (if semantic-checks? "on" "off"))
             (format #t "      disable-any: ~a\n" (if disable-any? "on" "off"))
+            (if zonefile-sync
+              (format #t "      zonefile-sync: ~a\n" zonefile-sync))
+            (if zonefile-load
+              (format #t "      zonefile-load: ~a\n"
+                      (symbol->string zonefile-load)))
+            (if journal-content
+              (format #t "      journal-content: ~a\n"
+                      (symbol->string journal-content)))
+            (if max-journal-usage
+              (format #t "      max-journal-usage: ~a\n" max-journal-usage))
+            (if max-journal-depth
+              (format #t "      max-journal-depth: ~a\n" max-journal-depth))
+            (if max-zone-size
+              (format #t "      max-zone-size: ~a\n" max-zone-size))
             (if dnssec-policy
                 (begin
                   (format #t "      dnssec-signing: on\n")
@@ -529,6 +563,9 @@
     #~(begin
         (call-with-output-file #$output
           (lambda (port)
+            (for-each (lambda (inc)
+                        (format port "include: ~a\n" inc))
+                      '#$(knot-configuration-includes config))
             (format port "server:\n")
             (format port "    rundir: ~a\n" #$(knot-configuration-run-directory config))
             (format port "    user: knot\n")
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index a7e8c41d3a..0dabfed4cb 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -64,7 +64,12 @@
             exim-configuration
             exim-configuration?
             exim-service-type
-            %default-exim-config-file))
+            %default-exim-config-file
+
+            imap4d-configuration
+            imap4d-configuration?
+            imap4d-service-type
+            %defualt-imap4d-config-file))
 
 ;;; Commentary:
 ;;;
@@ -1776,3 +1781,41 @@ exim_group = exim
           (service-extension activation-service-type exim-activation)
           (service-extension profile-service-type exim-profile)
           (service-extension mail-aliases-service-type (const '()))))))
+
+
+;;;
+;;; GNU Mailutils IMAP4 Daemon.
+;;;
+
+(define %default-imap4d-config-file
+  (plain-file "imap4d.conf" "server localhost {};\n"))
+
+(define-record-type* <imap4d-configuration>
+  imap4d-configuration make-imap4d-configuration imap4d-configuration?
+  (package     imap4d-configuration-package
+               (default mailutils))
+  (config-file imap4d-configuration-config-file
+               (default %default-imap4d-config-file)))
+
+(define imap4d-shepherd-service
+  (match-lambda
+    (($ <imap4d-configuration> package config-file)
+     (list (shepherd-service
+            (provision '(imap4d))
+            (requirement '(networking syslogd))
+            (documentation "Run the imap4d daemon.")
+            (start (let ((imap4d (file-append package "/sbin/imap4d")))
+                     #~(make-forkexec-constructor
+                        (list #$imap4d "--daemon" "--foreground"
+                              "--config-file" #$config-file))))
+            (stop #~(make-kill-destructor)))))))
+
+(define imap4d-service-type
+  (service-type
+   (name 'imap4d)
+   (description
+    "Run the GNU @command{imap4d} to serve e-mail messages through IMAP.")
+   (extensions
+    (list (service-extension
+           shepherd-root-service-type imap4d-shepherd-service)))
+   (default-value (imap4d-configuration))))
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index cab129e0c3..03b2c6e1ec 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -985,7 +985,14 @@ wireless networking."))))
                       (list (string-append #$connman
                                            "/sbin/connmand")
                             "-n" "-r"
-                            #$@(if disable-vpn? '("--noplugin=vpn") '()))))
+                            #$@(if disable-vpn? '("--noplugin=vpn") '()))
+
+                      ;; As connman(8) notes, when passing '-n', connman
+                      ;; "directs log output to the controlling terminal in
+                      ;; addition to syslog."  Redirect stdout and stderr
+                      ;; to avoid spamming the console (XXX: for some reason
+                      ;; redirecting to /dev/null doesn't work.)
+                      #:log-file "/var/log/connman.log"))
             (stop #~(make-kill-destructor)))))))
 
 (define connman-service-type
@@ -1060,12 +1067,13 @@ networking."))))
      (list (shepherd-service
             (documentation "Run the WPA supplicant daemon")
             (provision '(wpa-supplicant))
-            (requirement '(user-processes dbus-system loopback))
+            (requirement '(user-processes dbus-system loopback syslogd))
             (start #~(make-forkexec-constructor
                       (list (string-append #$wpa-supplicant
                                            "/sbin/wpa_supplicant")
                             (string-append "-P" #$pid-file)
                             "-B"        ;run in background
+                            "-s"        ;log to syslogd
                             #$@(if dbus?
                                    #~("-u")
                                    #~())
@@ -1154,7 +1162,8 @@ implements authentication, key negotiation and more for wireless networks.")
    (description
     "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
 switch designed to enable massive network automation through programmatic
-extension.")))
+extension.")
+   (default-value (openvswitch-configuration))))
 
 ;;;
 ;;; iptables
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index 2ebfe22016..b433c59e12 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Jesse Gildersleve <jessejohngildersleve@protonmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -83,8 +85,8 @@
   (sessions-directory     sddm-configuration-sessions-directory
                           (default "/run/current-system/profile/share/wayland-sessions"))
   ;; [X11]
-  (xorg-server-path       sddm-configuration-xorg-server-path
-                          (default (xorg-start-command)))
+  (xorg-configuration     sddm-configuration-xorg
+                          (default (xorg-configuration)))
   (xauth-path             sddm-configuration-xauth-path
                           (default (file-append xauth "/bin/xauth")))
   (xephyr-path            sddm-configuration-xephyr-path
@@ -99,8 +101,6 @@
                           (default "/run/current-system/profile/share/xsessions"))
   (minimum-vt             sddm-configuration-minimum-vt
                           (default 7))
-  (xserver-arguments      sddm-configuration-xserver-arguments
-                          (default "-nolisten tcp"))
 
   ;; [Autologin]
   (auto-login-user        sddm-configuration-auto-login-user
@@ -140,7 +140,7 @@ SessionCommand="       (sddm-configuration-session-command config)             "
 SessionDir="           (sddm-configuration-sessions-directory config)          "
 
 [X11]
-ServerPath="           (sddm-configuration-xorg-server-path config)            "
+ServerPath="           (xorg-start-command (sddm-configuration-xorg config))   "
 XauthPath="            (sddm-configuration-xauth-path config)                  "
 XephyrPath="           (sddm-configuration-xephyr-path config)                 "
 DisplayCommand="       (sddm-configuration-xdisplay-start config)              "
@@ -148,7 +148,9 @@ DisplayStopCommand="   (sddm-configuration-xdisplay-stop config)               "
 SessionCommand="       (sddm-configuration-xsession-command config)            "
 SessionDir="           (sddm-configuration-xsessions-directory config)         "
 MinimumVT="            (number->string (sddm-configuration-minimum-vt config)) "
-ServerArguments="      (sddm-configuration-xserver-arguments config)           "
+ServerArguments="      (string-join
+                        (xorg-configuration-server-arguments
+                         (sddm-configuration-xorg config)))           "
 
 [Autologin]
 User="                 (sddm-configuration-auto-login-user config)             "
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 12d649f542..45c67e04eb 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
 ;;;
@@ -44,6 +44,7 @@
             shepherd-service-provision
             shepherd-service-canonical-name
             shepherd-service-requirement
+            shepherd-service-one-shot?
             shepherd-service-respawn?
             shepherd-service-start
             shepherd-service-stop
@@ -59,7 +60,6 @@
             %default-modules
 
             shepherd-service-file
-            %containerized-shepherd-service
 
             shepherd-service-lookup-procedure
             shepherd-service-back-edges
@@ -149,6 +149,8 @@ DEFAULT is given, use it as the service's default value."
   (provision     shepherd-service-provision)           ;list of symbols
   (requirement   shepherd-service-requirement          ;list of symbols
                  (default '()))
+  (one-shot?     shepherd-service-one-shot?            ;Boolean
+                 (default #f))
   (respawn?      shepherd-service-respawn?             ;Boolean
                  (default #t))
   (start         shepherd-service-start)               ;g-expression (procedure)
@@ -238,6 +240,11 @@ stored."
                        #:docstring '#$(shepherd-service-documentation service)
                        #:provides '#$(shepherd-service-provision service)
                        #:requires '#$(shepherd-service-requirement service)
+
+                       ;; The 'one-shot?' slot is new in Shepherd 0.6.0.
+                       ;; Older versions ignore it.
+                       #:one-shot? '#$(shepherd-service-one-shot? service)
+
                        #:respawn? '#$(shepherd-service-respawn? service)
                        #:start #$(shepherd-service-start service)
                        #:stop #$(shepherd-service-stop service)
@@ -338,21 +345,6 @@ symbols provided/required by a service."
   (lambda (service)
     (vhash-foldq* cons '() service edges)))
 
-(define %containerized-shepherd-service
-  ;; XXX: This service works around a bug in the Shepherd 0.5.0: shepherd
-  ;; calls reboot(2) (via 'disable-reboot-on-ctrl-alt-del') when it starts,
-  ;; but in a container that fails with EINVAL.  This was fixed in Shepherd
-  ;; commit 92e806bac1abaeeaf5d60f0ab50d1ae85ba6a62f.
-  (simple-service 'containerized-shepherd
-                  shepherd-root-service-type
-                  (list (shepherd-service
-                         (provision '(containerized-shepherd))
-                         (start #~(lambda ()
-                                    (set! (@@ (shepherd)
-                                              disable-reboot-on-ctrl-alt-del)
-                                      (const #t))
-                                    #t))))))
-
 (define (shepherd-service-upgrade live target)
   "Return two values: the subset of LIVE (a list of <live-service>) that needs
 to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 362a7f1490..25db783420 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -617,7 +617,8 @@ of user-name/file-like tuples."
                  (list (service-extension shepherd-root-service-type
                                           dropbear-shepherd-service)
                        (service-extension activation-service-type
-                                          dropbear-activation)))))
+                                          dropbear-activation)))
+                (default-value (dropbear-configuration))))
 
 (define* (dropbear-service #:optional (config (dropbear-configuration)))
   "Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index b6ebe90774..84294db53b 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -34,7 +34,6 @@
   #:use-module (gnu packages admin)
   #:use-module (gnu packages web)
   #:use-module (gnu packages php)
-  #:use-module (gnu packages guile)
   #:use-module (gnu packages logging)
   #:use-module (guix records)
   #:use-module (guix modules)
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index f2a3c28c90..44dcec4ec9 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,8 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
+  #:use-module (gnu system keyboard)
+  #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module ((gnu packages base) #:select (canonical-package))
   #:use-module (gnu packages guile)
@@ -33,6 +36,7 @@
   #:use-module (gnu packages gl)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages display-managers)
+  #:use-module (gnu packages freedesktop)
   #:use-module (gnu packages gnustep)
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages admin)
@@ -48,7 +52,16 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (xorg-configuration-file
+  #:export (xorg-configuration
+            xorg-configuration?
+            xorg-configuration-modules
+            xorg-configuration-fonts
+            xorg-configuration-drivers
+            xorg-configuration-resolutions
+            xorg-configuration-extra-config
+            xorg-configuration-server
+            xorg-configuration-server-arguments
+
             %default-xorg-modules
             %default-xorg-fonts
             xorg-wrapper
@@ -69,7 +82,8 @@
             slim-configuration-xauth
             slim-configuration-shepherd
             slim-configuration-auto-login-session
-            slim-configuration-startx
+            slim-configuration-xorg
+            slim-configuration-sessreg
 
             slim-service-type
             slim-service
@@ -79,9 +93,14 @@
             screen-locker-service-type
             screen-locker-service
 
+            localed-configuration
+            localed-configuration?
+            localed-service-type
+
             gdm-configuration
             gdm-service-type
-            gdm-service))
+            gdm-service
+            set-xorg-configuration))
 
 ;;; Commentary:
 ;;;
@@ -122,33 +141,38 @@
                      "/share/fonts/X11/misc")
         (file-append font-adobe75dpi "/share/fonts/X11/75dpi")))
 
-(define* (xorg-configuration-file #:key
-                                  (modules %default-xorg-modules)
-                                  (fonts %default-xorg-fonts)
-                                  (drivers '()) (resolutions '())
-                                  (extra-config '()))
-  "Return a configuration file for the Xorg server containing search paths for
-all the common drivers.
-
-@var{modules} must be a list of @dfn{module packages} loaded by the Xorg
-server---e.g., @code{xf86-video-vesa}, @code{xf86-input-keyboard}, and so on.
-@var{fonts} must be a list of font directories to add to the server's
-@dfn{font path}.
-
-@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
-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))}.
-
-Last, @var{extra-config} is a list of strings or objects appended to the
-configuration file.  It is used to pass extra text to be
-added verbatim to the configuration file."
+(define %default-xorg-server-arguments
+  ;; Default command-line arguments for X.
+  '("-nolisten" "tcp"))
+
+;; Configuration of an Xorg server.
+(define-record-type* <xorg-configuration>
+  xorg-configuration make-xorg-configuration
+  xorg-configuration?
+  (modules          xorg-configuration-modules    ;list of packages
+                    (default %default-xorg-modules))
+  (fonts            xorg-configuration-fonts      ;list of packges
+                    (default %default-xorg-fonts))
+  (drivers          xorg-configuration-drivers    ;list of strings
+                    (default '()))
+  (resolutions      xorg-configuration-resolutions ;list of tuples
+                    (default '()))
+  (keyboard-layout  xorg-configuration-keyboard-layout ;#f | <keyboard-layout>
+                    (default #f))
+  (extra-config     xorg-configuration-extra-config ;list of strings
+                    (default '()))
+  (server           xorg-configuration-server     ;package
+                    (default xorg-server))
+  (server-arguments xorg-configuration-server-arguments ;list of strings
+                    (default %default-xorg-server-arguments)))
+
+(define (xorg-configuration->file config)
+  "Compute an Xorg configuration file corresponding to CONFIG, an
+<xorg-configuration> record."
   (define all-modules
     ;; 'xorg-server' provides 'fbdevhw.so' etc.
-    (append modules (list xorg-server)))
+    (append (xorg-configuration-modules config)
+            (list xorg-server)))
 
   (define build
     #~(begin
@@ -159,7 +183,7 @@ added verbatim to the configuration file."
         (call-with-output-file #$output
           (lambda (port)
             (define drivers
-              '#$drivers)
+              '#$(xorg-configuration-drivers config))
 
             (define (device-section driver)
               (string-append "
@@ -183,6 +207,31 @@ Section \"Screen\"
   EndSubSection
 EndSection"))
 
+            (define (input-class-section layout variant model options)
+              (string-append "
+Section \"InputClass\"
+  Identifier \"evdev keyboard catchall\"
+  MatchIsKeyboard \"on\"
+  Option \"XkbLayout\" " (object->string layout)
+  (if variant
+      (string-append "  Option \"XkbVariant\" \""
+                     variant "\"")
+      "")
+  (if model
+      (string-append "  Option \"XkbModel\" \""
+                     model "\"")
+      "")
+  (match options
+    (()
+     "")
+    (_
+     (string-append "  Option \"XkbOptions\" \""
+                    (string-join options ",") "\""))) "
+
+  MatchDevicePath \"/dev/input/event*\"
+  Driver \"evdev\"
+EndSection\n"))
+
             (define (expand modules)
               ;; Append to MODULES the relevant /lib/xorg/modules
               ;; sub-directories.
@@ -201,7 +250,7 @@ EndSection"))
             (display "Section \"Files\"\n" port)
             (for-each (lambda (font)
                         (format port "  FontPath \"~a\"~%" font))
-                      '#$fonts)
+                      '#$(xorg-configuration-fonts config))
             (for-each (lambda (module)
                         (format port
                                 "  ModulePath \"~a\"~%"
@@ -221,19 +270,32 @@ EndSection\n" port)
                      port)
             (newline port)
             (display (string-join
-                      (map (cut screen-section <> '#$resolutions)
+                      (map (cut screen-section <>
+                                '#$(xorg-configuration-resolutions config))
                            drivers)
                       "\n")
                      port)
             (newline port)
 
+            (let ((layout  #$(and=> (xorg-configuration-keyboard-layout config)
+                                    keyboard-layout-name))
+                  (variant #$(and=> (xorg-configuration-keyboard-layout config)
+                                    keyboard-layout-variant))
+                  (model   #$(and=> (xorg-configuration-keyboard-layout config)
+                                    keyboard-layout-model))
+                  (options '#$(and=> (xorg-configuration-keyboard-layout config)
+                                     keyboard-layout-options)))
+              (when layout
+                (display (input-class-section layout variant model options)
+                         port)
+                (newline port)))
+
             (for-each (lambda (config)
                         (display config port))
-                      '#$extra-config)))))
+                      '#$(xorg-configuration-extra-config config))))))
 
   (computed-file "xserver.conf" build))
 
-
 (define (xorg-configuration-directory modules)
   "Return a directory that contains the @code{.conf} files for X.org that
 includes the @code{share/X11/xorg.conf.d} directories of each package listed
@@ -260,61 +322,43 @@ in @var{modules}."
                                  files)
                        #t))))
 
-(define* (xorg-wrapper #:key
-                       (guile (canonical-package guile-2.0))
-                       (modules %default-xorg-modules)
-                       (configuration-file (xorg-configuration-file
-                                            #:modules modules))
-                       (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.  The resulting script should be used
-in place of @code{/usr/bin/X}."
+(define* (xorg-wrapper #:optional (config (xorg-configuration)))
+  "Return a derivation that builds a script to start the X server with the
+given @var{config}.  The resulting script should be used in place of
+@code{/usr/bin/X}."
   (define exp
     ;; Write a small wrapper around the X server.
     #~(begin
         (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
         (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
 
-        (let ((X (string-append #$xorg-server "/bin/X")))
+        (let ((X (string-append #$(xorg-configuration-server config) "/bin/X")))
           (apply execl X X
                  "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
-                 "-config" #$configuration-file
-                 "-configdir" #$(xorg-configuration-directory modules)
+                 "-config" #$(xorg-configuration->file config)
+                 "-configdir" #$(xorg-configuration-directory
+                                 (xorg-configuration-modules config))
                  (cdr (command-line))))))
 
   (program-file "X-wrapper" exp))
 
-(define* (xorg-start-command #:key
-                             (guile (canonical-package guile-2.0))
-                             (modules %default-xorg-modules)
-                             (fonts %default-xorg-fonts)
-                             (configuration-file
-                              (xorg-configuration-file #:modules modules
-                                                       #:fonts fonts))
-                             (xorg-server xorg-server)
-                             (xserver-arguments '("-nolisten" "tcp")))
-  "Return a @code{startx} script in which @var{modules}, a list of X module
-packages, and @var{fonts}, a list of X font directories, are available.  See
-@code{xorg-wrapper} for more details on the arguments.  The result should be
-used in place of @code{startx}."
+(define* (xorg-start-command #:optional (config (xorg-configuration)))
+  "Return a @code{startx} script in which the modules, fonts, etc. specified
+in @var{config}, are available.  The result should be used in place of
+@code{startx}."
   (define X
-    (xorg-wrapper #:guile guile
-                  #:configuration-file configuration-file
-                  #:modules modules
-                  #:xorg-server xorg-server))
+    (xorg-wrapper config))
+
   (define exp
     ;; Write a small wrapper around the X server.
     #~(apply execl #$X #$X ;; Second #$X is for argv[0].
-             "-logverbose" "-verbose" "-terminate" #$@xserver-arguments
+             "-logverbose" "-verbose" "-terminate"
+             #$@(xorg-configuration-server-arguments config)
               (cdr (command-line))))
 
   (program-file "startx" exp))
 
-(define* (xinitrc #:key
-                  (guile (canonical-package guile-2.0))
-                  fallback-session)
+(define* (xinitrc #:key fallback-session)
   "Return a system-wide xinitrc script that starts the specified X session,
 which should be passed to this script as the first argument.  If not, the
 @var{fallback-session} will be used or, if @var{fallback-session} is false, a
@@ -442,8 +486,8 @@ desktop session from the system or user profile will be used."
             (default shepherd))
   (auto-login-session slim-configuration-auto-login-session
                       (default #f))
-  (startx slim-configuration-startx
-          (default (xorg-start-command)))
+  (xorg-configuration slim-configuration-xorg
+                      (default (xorg-configuration)))
   (sessreg slim-configuration-sessreg
            (default sessreg)))
 
@@ -458,9 +502,8 @@ desktop session from the system or user profile will be used."
   (define slim.cfg
     (let ((xinitrc (xinitrc #:fallback-session
                             (slim-configuration-auto-login-session config)))
-          (slim    (slim-configuration-slim config))
           (xauth   (slim-configuration-xauth config))
-          (startx  (slim-configuration-startx config))
+          (startx  (xorg-start-command (slim-configuration-xorg config)))
           (shepherd   (slim-configuration-shepherd config))
           (theme-name (slim-configuration-theme-name config))
           (sessreg (slim-configuration-sessreg config)))
@@ -503,7 +546,9 @@ reboot_cmd " shepherd "/sbin/reboot\n"
               (false-if-exception (delete-file "/var/run/slim.lock"))
 
               (fork+exec-command
-               (list (string-append #$slim "/bin/slim") "-nodaemon")
+               (list (string-append #$(slim-configuration-slim config)
+                                    "/bin/slim")
+                     "-nodaemon")
                #:environment-variables
                (list (string-append "SLIM_CFGFILE=" #$slim.cfg)
                      #$@(if theme
@@ -567,8 +612,7 @@ theme."
             (auto-login? auto-login?) (default-user default-user)
             (theme theme) (theme-name theme-name)
             (xauth xauth) (shepherd shepherd)
-            (auto-login-session auto-login-session)
-            (startx startx))))
+            (auto-login-session auto-login-session))))
 
 
 ;;;
@@ -617,6 +661,88 @@ makes the good ol' XlockMore usable."
                           (file-append package "/bin/" program)
                           allow-empty-passwords?)))
 
+
+;;;
+;;; Locale service.
+;;;
+
+(define-record-type* <localed-configuration>
+  localed-configuration make-localed-configuration
+  localed-configuration?
+  (localed         localed-configuration-localed
+                   (default localed))
+  (keyboard-layout localed-configuration-keyboard-layout
+                   (default #f)))
+
+(define (localed-dbus-service config)
+  "Return the 'localed' D-Bus service for @var{config}, a
+@code{<localed-configuration>} record."
+  (define keyboard-layout
+    (localed-configuration-keyboard-layout config))
+
+  ;; The primary purpose of 'localed' is to tell GDM what the "current" Xorg
+  ;; keyboard layout is.  If 'localed' is missing, or if it's unable to
+  ;; determine the current XKB layout, then GDM forcefully installs its
+  ;; default XKB config (US English).  Here we communicate the configured
+  ;; layout through environment variables.
+
+  (if keyboard-layout
+      (let* ((layout  (keyboard-layout-name keyboard-layout))
+             (variant (keyboard-layout-variant keyboard-layout))
+             (model   (keyboard-layout-model keyboard-layout))
+             (options (keyboard-layout-options keyboard-layout)))
+        (list (wrapped-dbus-service
+               (localed-configuration-localed config)
+               "libexec/localed/localed"
+               `(("GUIX_XKB_LAYOUT" ,layout)
+                 ,@(if variant
+                       `(("GUIX_XKB_VARIANT" ,variant))
+                       '())
+                 ,@(if model
+                       `(("GUIX_XKB_MODEL" ,model))
+                       '())
+                 ,@(if (null? options)
+                       '()
+                       `(("GUIX_XKB_OPTIONS"
+                          ,(string-join options ","))))))))
+      '()))
+
+(define localed-service-type
+  (let ((package (lambda (config)
+                   ;; Don't bother if the user didn't specify any keyboard
+                   ;; layout.
+                   (if (localed-configuration-keyboard-layout config)
+                       (list (localed-configuration-localed config))
+                       '()))))
+    (service-type (name 'localed)
+                  (extensions
+                   (list (service-extension dbus-root-service-type
+                                            localed-dbus-service)
+                         (service-extension udev-service-type package)
+                         (service-extension polkit-service-type package)
+
+                         ;; Add 'localectl' to the profile.
+                         (service-extension profile-service-type package)))
+
+                  ;; This service can be extended, typically by the X login
+                  ;; manager, to communicate the chosen Xorg keyboard layout.
+                  (compose (lambda (extensions)
+                             (find keyboard-layout? extensions)))
+                  (extend (lambda (config keyboard-layout)
+                            (localed-configuration
+                             (inherit config)
+                             (keyboard-layout keyboard-layout))))
+                  (description
+                   "Run the locale daemon, @command{localed}, which can be used
+to control the system locale and keyboard mapping from user programs such as
+the GNOME desktop environment.")
+                  (default-value (localed-configuration)))))
+
+
+;;;
+;;; GNOME Desktop Manager.
+;;;
+
 (define %gdm-accounts
   (list (user-group (name "gdm") (system? #t))
         (user-account
@@ -647,8 +773,8 @@ makes the good ol' XlockMore usable."
   (default-user gdm-configuration-default-user (default #f))
   (gnome-shell-assets gdm-configuration-gnome-shell-assets
                       (default (list adwaita-icon-theme font-cantarell)))
-  (x-server gdm-configuration-x-server
-            (default (xorg-wrapper)))
+  (xorg-configuration gdm-configuration-xorg
+                      (default (xorg-configuration)))
   (x-session gdm-configuration-x-session
              (default (xinitrc))))
 
@@ -720,7 +846,8 @@ makes the good ol' XlockMore usable."
                             #$(gdm-configuration-dbus-daemon config))
                            (string-append
                             "GDM_X_SERVER="
-                            #$(gdm-configuration-x-server config))
+                            #$(xorg-wrapper
+                               (gdm-configuration-xorg config)))
                            (string-append
                             "GDM_X_SESSION="
                             #$(gdm-configuration-x-session config))
@@ -750,15 +877,31 @@ makes the good ol' XlockMore usable."
                                           gdm-configuration-gnome-shell-assets)
                        (service-extension dbus-root-service-type
                                           (compose list
-                                                   gdm-configuration-gdm))))
+                                                   gdm-configuration-gdm))
+                       (service-extension localed-service-type
+                                          (compose
+                                           xorg-configuration-keyboard-layout
+                                           gdm-configuration-xorg))))
+
+                ;; For convenience, this service can be extended with an
+                ;; <xorg-configuration> record.  Take the first one that
+                ;; comes.
+                (compose (lambda (extensions)
+                           (match extensions
+                             (() #f)
+                             ((config . _) config))))
+                (extend (lambda (config xorg-configuration)
+                          (if xorg-configuration
+                              (gdm-configuration
+                               (inherit config)
+                               (xorg-configuration xorg-configuration))
+                              config)))
+
                 (default-value (gdm-configuration))
                 (description
                  "Run the GNOME Desktop Manager (GDM), a program that allows
 you to log in in a graphical session, whether or not you use GNOME.")))
 
-;; This service isn't working yet; it gets as far as starting to run the
-;; greeter from gnome-shell but doesn't get any further.  It is here because
-;; it doesn't hurt anyone and perhaps it inspires someone to fix it :)
 (define-deprecated (gdm-service #:key (gdm gdm)
                                 (allow-empty-passwords? #t)
                                 (x-server (xorg-wrapper)))
@@ -785,7 +928,16 @@ password."
   (service gdm-service-type
            (gdm-configuration
             (gdm gdm)
-            (allow-empty-passwords? allow-empty-passwords?)
-            (x-server x-server))))
+            (allow-empty-passwords? allow-empty-passwords?))))
+
+(define* (set-xorg-configuration config
+                                 #:optional
+                                 (login-manager-service-type
+                                  gdm-service-type))
+  "Tell the log-in manager (of type @var{login-manager-service-type}) to use
+@var{config}, an <xorg-configuration> record."
+  (simple-service 'set-xorg-configuration
+                  login-manager-service-type
+                  config))
 
 ;;; xorg.scm ends here