Merge branch 'master' into core-updates

13 files changed, 669 insertions, 110 deletions

diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index d8086b78d4..deaf677bd9 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -58,8 +58,8 @@
 }
 "))
 
-(define (simple-rotation-config file)
-  (string-append file " {
+(define (simple-rotation-config files)
+  #~(string-append #$(string-join files ",") " {
         sharedscripts
 }
 "))
@@ -72,7 +72,8 @@
                            (display #$(syslog-rotation-config %rotated-files)
                                     port)
                            (display #$(simple-rotation-config
-                                       "/var/log/shepherd.log")
+                                       '("/var/log/shepherd.log"
+                                         "/var/log/guix-daemon.log"))
                                     port)))))))
 
 (define (default-jobs rottlog)
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm
index 60e9e61f94..29720415fc 100644
--- a/gnu/services/avahi.scm
+++ b/gnu/services/avahi.scm
@@ -107,7 +107,7 @@
            (requirement '(dbus-system networking))
 
            (start #~(make-forkexec-constructor
-                     (list (string-append #$avahi "/sbin/avahi-daemon")
+                     (list #$(file-append avahi "/sbin/avahi-daemon")
                            "--daemonize"
                            #$@(if debug? #~("--debug") #~())
                            "-f" #$config)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index afbecdb47e..1b1ce0d5e8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -37,7 +37,6 @@
   #:use-module ((gnu packages base)
                 #:select (canonical-package glibc))
   #:use-module (gnu packages package-management)
-  #:use-module (gnu packages ssh)
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
@@ -252,6 +251,8 @@ FILE-SYSTEM."
         (device  (file-system-device file-system))
         (type    (file-system-type file-system))
         (title   (file-system-title file-system))
+        (flags   (file-system-flags file-system))
+        (options (file-system-options file-system))
         (check?  (file-system-check? file-system))
         (create? (file-system-create-mount-point? file-system))
         (dependencies (file-system-dependencies file-system)))
@@ -264,35 +265,27 @@ FILE-SYSTEM."
                            ,@(map dependency->shepherd-service-name dependencies)))
             (documentation "Check, mount, and unmount the given file system.")
             (start #~(lambda args
-                       ;; FIXME: Use or factorize with 'mount-file-system'.
-                       (let ((device (canonicalize-device-spec #$device '#$title))
-                             (flags  #$(mount-flags->bit-mask
-                                        (file-system-flags file-system))))
-                         #$(if create?
-                               #~(mkdir-p #$target)
-                               #~#t)
-                         #$(if check?
-                               #~(begin
-                                   ;; Make sure fsck.ext2 & co. can be found.
-                                   (setenv "PATH"
-                                           (string-append
-                                            #$e2fsprogs "/sbin:"
-                                            "/run/current-system/profile/sbin:"
-                                            (getenv "PATH")))
-                                   (check-file-system device #$type))
-                               #~#t)
-
-                         (mount device #$target #$type flags
-                                #$(file-system-options file-system))
-
-                         ;; For read-only bind mounts, an extra remount is
-                         ;; needed, as per <http://lwn.net/Articles/281157/>,
-                         ;; which still applies to Linux 4.0.
-                         (when (and (= MS_BIND (logand flags MS_BIND))
-                                    (= MS_RDONLY (logand flags MS_RDONLY)))
-                           (mount device #$target #$type
-                                  (logior MS_BIND MS_REMOUNT MS_RDONLY))))
-                       #t))
+		       #$(if create?
+                             #~(mkdir-p #$target)
+                             #t)
+
+                       (let (($PATH (getenv "PATH")))
+                         ;; Make sure fsck.ext2 & co. can be found.
+                         (dynamic-wind
+                           (lambda ()
+                             (setenv "PATH"
+                                     (string-append
+                                      #$e2fsprogs "/sbin:"
+                                      "/run/current-system/profile/sbin:"
+                                      $PATH)))
+                           (lambda ()
+                             (mount-file-system
+                              `(#$device #$title #$target #$type #$flags
+                                         #$options #$check?)
+                              #:root "/"))
+                           (lambda ()
+                             (setenv "PATH" $PATH)))
+                         #t)))
             (stop #~(lambda args
                       ;; Normally there are no processes left at this point, so
                       ;; TARGET can be safely unmounted.
@@ -305,7 +298,7 @@ FILE-SYSTEM."
 
             ;; We need an additional module.
             (modules `(((gnu build file-systems)
-                        #:select (check-file-system canonicalize-device-spec))
+                        #:select (mount-file-system))
                        ,@%default-modules)))))))
 
 (define file-system-service-type
@@ -616,7 +609,7 @@ strings or string-valued gexps."
            (dup2 (open-fdes #$tty O_RDONLY) 0)
            (close-fdes 1)
            (dup2 (open-fdes #$tty O_WRONLY) 1)
-           (execl (string-append #$kbd "/bin/unicode_start")
+           (execl #$(file-append kbd "/bin/unicode_start")
                   "unicode_start"))
           (else
            (zero? (cdr (waitpid pid))))))))
@@ -629,7 +622,7 @@ strings or string-valued gexps."
       (documentation (string-append "Load console keymap (loadkeys)."))
       (provision '(console-keymap))
       (start #~(lambda _
-                 (zero? (system* (string-append #$kbd "/bin/loadkeys")
+                 (zero? (system* #$(file-append kbd "/bin/loadkeys")
                                  #$@files))))
       (respawn? #f)))))
 
@@ -661,7 +654,7 @@ strings or string-valued gexps."
              (start #~(lambda _
                         (and #$(unicode-start device)
                              (zero?
-                              (system* (string-append #$kbd "/bin/setfont")
+                              (system* #$(file-append kbd "/bin/setfont")
                                        "-C" #$device #$font)))))
              (stop #~(const #t))
              (respawn? #f)))))
@@ -743,7 +736,7 @@ the message of the day, among other things."
        (requirement '(user-processes host-name udev))
 
        (start  #~(make-forkexec-constructor
-                  (list (string-append #$mingetty "/sbin/mingetty")
+                  (list #$(file-append mingetty "/sbin/mingetty")
                         "--noclear" #$tty
                         #$@(if auto-login
                                #~("--autologin" #$auto-login)
@@ -878,7 +871,7 @@ the tty to run, among other things."
            (provision '(nscd))
            (requirement '(user-processes))
            (start #~(make-forkexec-constructor
-                     (list (string-append #$(nscd-configuration-glibc config)
+                     (list #$(file-append (nscd-configuration-glibc config)
                                           "/sbin/nscd")
                            "-f" #$nscd.conf "--foreground")
 
@@ -1064,7 +1057,7 @@ public key, with GUIX."
              (format #t "registering public key '~a'...~%" key)
              (close-port (current-input-port))
              (dup port 0)
-             (execl (string-append #$guix "/bin/guix")
+             (execl #$(file-append guix "/bin/guix")
                     "guix" "archive" "--authorize")
              (exit 1)))
           (else
@@ -1096,10 +1089,10 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                     (default %default-substitute-urls))
   (extra-options    guix-configuration-extra-options ;list of strings
                     (default '()))
+  (log-file         guix-configuration-log-file   ;string
+                    (default "/var/log/guix-daemon.log"))
   (lsof             guix-configuration-lsof       ;<package>
-                    (default lsof))
-  (lsh              guix-configuration-lsh        ;<package>
-                    (default lsh)))
+                    (default lsof)))
 
 (define %default-guix-configuration
   (guix-configuration))
@@ -1110,14 +1103,14 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
     (($ <guix-configuration> guix build-group build-accounts
                              authorize-key? keys
                              use-substitutes? substitute-urls extra-options
-                             lsof lsh)
+                             log-file lsof)
      (list (shepherd-service
             (documentation "Run the Guix daemon.")
             (provision '(guix-daemon))
             (requirement '(user-processes))
             (start
              #~(make-forkexec-constructor
-                (list (string-append #$guix "/bin/guix-daemon")
+                (list #$(file-append guix "/bin/guix-daemon")
                       "--build-users-group" #$build-group
                       #$@(if use-substitutes?
                              '()
@@ -1125,10 +1118,11 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                       "--substitute-urls" #$(string-join substitute-urls)
                       #$@extra-options)
 
-                ;; Add 'lsof' (for the GC) and 'lsh' (for offloading) to the
-                ;; daemon's $PATH.
+                ;; Add 'lsof' (for the GC) to the daemon's $PATH.
                 #:environment-variables
-                (list (string-append "PATH=" #$lsof "/bin:" #$lsh "/bin"))))
+                (list (string-append "PATH=" #$lsof "/bin"))
+
+                #:log-file #$log-file))
             (stop #~(make-kill-destructor)))))))
 
 (define (guix-accounts config)
@@ -1192,7 +1186,7 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
             (provision '(guix-publish))
             (requirement '(guix-daemon))
             (start #~(make-forkexec-constructor
-                      (list (string-append #$guix "/bin/guix")
+                      (list #$(file-append guix "/bin/guix")
                             "publish" "-u" "guix-publish"
                             "-p" #$(number->string port)
                             (string-append "--listen=" #$host))))
@@ -1346,7 +1340,7 @@ item of @var{packages}."
                     ;; The first one is for udev, the second one for eudev.
                     (setenv "UDEV_CONFIG_FILE" #$udev.conf)
                     (setenv "EUDEV_RULES_DIRECTORY"
-                            (string-append #$rules "/lib/udev/rules.d"))
+                            #$(file-append rules "/lib/udev/rules.d"))
 
                     (let ((pid (primitive-fork)))
                       (case pid
@@ -1359,11 +1353,11 @@ item of @var{packages}."
                          (wait-for-udevd)
 
                          ;; Trigger device node creation.
-                         (system* (string-append #$udev "/bin/udevadm")
+                         (system* #$(file-append udev "/bin/udevadm")
                                   "trigger" "--action=add")
 
                          ;; Wait for things to settle down.
-                         (system* (string-append #$udev "/bin/udevadm")
+                         (system* #$(file-append udev "/bin/udevadm")
                                   "settle")
                          pid)))))
          (stop #~(make-kill-destructor))
@@ -1434,7 +1428,7 @@ extra rules from the packages listed in @var{rules}."
                        ;; 'gpm' runs in the background and sets a PID file.
                        ;; Note that it requires running as "root".
                        (false-if-exception (delete-file "/var/run/gpm.pid"))
-                       (fork+exec-command (list (string-append #$gpm "/sbin/gpm")
+                       (fork+exec-command (list #$(file-append gpm "/sbin/gpm")
                                                 #$@options))
 
                        ;; Wait for the PID file to appear; declare failure if
@@ -1449,7 +1443,7 @@ extra rules from the packages listed in @var{rules}."
 
             (stop #~(lambda (_)
                       ;; Return #f if successfully stopped.
-                      (not (zero? (system* (string-append #$gpm "/sbin/gpm")
+                      (not (zero? (system* #$(file-append gpm "/sbin/gpm")
                                            "-k"))))))))))
 
 (define gpm-service-type
@@ -1478,7 +1472,7 @@ This service is not part of @var{%base-services}."
                            (default kmscon))
   (virtual-terminal        kmscon-configuration-virtual-terminal)
   (login-program           kmscon-configuration-login-program
-                           (default #~(string-append #$shadow "/bin/login")))
+                           (default (file-append shadow "/bin/login")))
   (login-arguments         kmscon-configuration-login-arguments
                            (default '("-p")))
   (hardware-acceleration?  kmscon-configuration-hardware-acceleration?
@@ -1496,7 +1490,7 @@ This service is not part of @var{%base-services}."
 
        (define kmscon-command
          #~(list
-            (string-append #$kmscon "/bin/kmscon") "--login"
+            #$(file-append kmscon "/bin/kmscon") "--login"
             "--vt" #$virtual-terminal
             #$@(if hardware-acceleration? '("--hwaccel") '())
             "--" #$login-program #$@login-arguments))
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 9f28aabc96..94c5f21557 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -30,6 +30,8 @@
             configuration-field-name
             configuration-missing-field
             configuration-field-error
+            configuration-field-serializer
+            configuration-field-getter
             serialize-configuration
             define-configuration
             validate-configuration
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
new file mode 100644
index 0000000000..c15a846bad
--- /dev/null
+++ b/gnu/services/cuirass.scm
@@ -0,0 +1,141 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016, 2017 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 cuirass)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (gnu packages admin)
+  #:autoload   (gnu packages ci) (cuirass)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system shadow)
+  #:export (<cuirass-configuration>
+            cuirass-configuration
+            cuirass-configuration?
+
+            cuirass-service-type))
+
+;;;; Commentary:
+;;;
+;;; This module implements a service that to run instances of Cuirass, a
+;;; continuous integration tool.
+;;;
+;;;; Code:
+
+(define-record-type* <cuirass-configuration>
+  cuirass-configuration make-cuirass-configuration
+  cuirass-configuration?
+  (cuirass          cuirass-configuration-cuirass ;package
+                    (default cuirass))
+  (log-file         cuirass-configuration-log-file ;string
+                    (default "/var/log/cuirass.log"))
+  (cache-directory  cuirass-configuration-cache-directory ;string (dir-name)
+                    (default "/var/cache/cuirass"))
+  (user             cuirass-configuration-user ;string
+                    (default "cuirass"))
+  (group            cuirass-configuration-group ;string
+                    (default "cuirass"))
+  (interval         cuirass-configuration-interval ;integer (seconds)
+                    (default 60))
+  (database         cuirass-configuration-database ;string (file-name)
+                    (default "/var/run/cuirass/cuirass.db"))
+  (specifications   cuirass-configuration-specifications)
+                                  ;gexp that evaluates to specification-alist
+  (use-substitutes? cuirass-configuration-use-substitutes? ;boolean
+                    (default #f))
+  (one-shot?        cuirass-configuration-one-shot? ;boolean
+                    (default #f)))
+
+(define (cuirass-shepherd-service config)
+  "Return a <shepherd-service> for the Cuirass service with CONFIG."
+  (and
+   (cuirass-configuration? config)
+   (let ((cuirass          (cuirass-configuration-cuirass config))
+         (cache-directory  (cuirass-configuration-cache-directory config))
+         (log-file         (cuirass-configuration-log-file config))
+         (user             (cuirass-configuration-user config))
+         (group            (cuirass-configuration-group config))
+         (interval         (cuirass-configuration-interval config))
+         (database         (cuirass-configuration-database config))
+         (specs            (cuirass-configuration-specifications config))
+         (use-substitutes? (cuirass-configuration-use-substitutes? config))
+         (one-shot?        (cuirass-configuration-one-shot? config)))
+     (list (shepherd-service
+            (documentation "Run Cuirass.")
+            (provision '(cuirass))
+            (requirement '(guix-daemon))
+            (start #~(make-forkexec-constructor
+                      (list (string-append #$cuirass "/bin/cuirass")
+                            "--cache-directory" #$cache-directory
+                            "--specifications"
+                            #$(scheme-file "cuirass-specs.scm" specs)
+                            "--database" #$database
+                            "--interval" #$(number->string interval)
+                            #$@(if use-substitutes? '("--use-substitutes") '())
+                            #$@(if one-shot? '("--one-shot") '()))
+                      #:user #$user
+                      #:group #$group
+                      #:log-file #$log-file))
+            (stop #~(make-kill-destructor)))))))
+
+(define (cuirass-account config)
+  "Return the user accounts and user groups for CONFIG."
+  (let ((cuirass-user  (cuirass-configuration-user config))
+        (cuirass-group (cuirass-configuration-group config)))
+    (list (user-group
+           (name cuirass-group)
+           (system? #t))
+          (user-account
+           (name cuirass-user)
+           (group cuirass-group)
+           (system? #t)
+           (comment "Cuirass privilege separation user")
+           (home-directory (string-append "/var/run/" cuirass-user))
+           (shell #~(string-append #$shadow "/sbin/nologin"))))))
+
+(define (cuirass-activation config)
+  "Return the activation code for CONFIG."
+  (let ((cache (cuirass-configuration-cache-directory config))
+        (db    (dirname (cuirass-configuration-database config)))
+        (user  (cuirass-configuration-user config))
+        (group (cuirass-configuration-group config)))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+
+          (mkdir-p #$cache)
+          (mkdir-p #$db)
+
+          (let ((uid (passwd:uid (getpw #$user)))
+                (gid (group:gid (getgr #$group))))
+            (chown #$cache uid gid)
+            (chown #$db uid gid))))))
+
+(define cuirass-service-type
+  (service-type
+   (name 'cuirass)
+   (extensions
+    (list
+     (service-extension profile-service-type      ;for 'info cuirass'
+                        (compose list cuirass-configuration-cuirass))
+     (service-extension activation-service-type cuirass-activation)
+     (service-extension shepherd-root-service-type cuirass-shepherd-service)
+     (service-extension account-service-type cuirass-account)))))
+
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 391046a75f..df1843e438 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -894,7 +894,7 @@ IPP specifications.")
                     (if (file-exists? dst)
                         (format (current-error-port) "warning: ~a exists\n" dst)
                         (symlink src dst))))
-                (find-files (string-append package path))))
+                (find-files (string-append package path) #:stat stat)))
              (list #$@paths)))
           (list #$@packages))
          #t))))
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 1eed85542b..d88c839f7d 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -48,6 +48,10 @@
   postgresql-configuration?
   (postgresql     postgresql-configuration-postgresql ;<package>
                   (default postgresql))
+  (port           postgresql-configuration-port
+                  (default 5432))
+  (locale         postgresql-configuration-locale
+                  (default "en_US.utf8"))
   (config-file    postgresql-configuration-file)
   (data-directory postgresql-configuration-data-directory))
 
@@ -80,13 +84,18 @@ host	all	all	::1/128 	trust"))
 
 (define postgresql-activation
   (match-lambda
-    (($ <postgresql-configuration> postgresql config-file data-directory)
+    (($ <postgresql-configuration> postgresql port locale config-file data-directory)
      #~(begin
          (use-modules (guix build utils)
                       (ice-9 match))
 
          (let ((user (getpwnam "postgres"))
-               (initdb (string-append #$postgresql "/bin/initdb")))
+               (initdb (string-append #$postgresql "/bin/initdb"))
+               (initdb-args
+                (append
+                 (if #$locale
+                     (list (string-append "--locale=" #$locale))
+                     '()))))
            ;; Create db state directory.
            (mkdir-p #$data-directory)
            (chown #$data-directory (passwd:uid user) (passwd:gid user))
@@ -101,14 +110,19 @@ host	all	all	::1/128 	trust"))
                 (lambda ()
                   (setgid (passwd:gid user))
                   (setuid (passwd:uid user))
-                  (primitive-exit (system* initdb "-D" #$data-directory)))
+                  (primitive-exit
+                   (apply system*
+                          initdb
+                          "-D"
+                          #$data-directory
+                          initdb-args)))
                 (lambda ()
                   (primitive-exit 1))))
              (pid (waitpid pid))))))))
 
 (define postgresql-shepherd-service
   (match-lambda
-    (($ <postgresql-configuration> postgresql config-file data-directory)
+    (($ <postgresql-configuration> postgresql port locale config-file data-directory)
      (let ((start-script
             ;; Wrapper script that switches to the 'postgres' user before
             ;; launching daemon.
@@ -121,6 +135,7 @@ host	all	all	::1/128 	trust"))
                               (system* postgres
                                        (string-append "--config-file="
                                                       #$config-file)
+                                       "-p" (number->string #$port)
                                        "-D" #$data-directory)))))
        (list (shepherd-service
               (provision '(postgres))
@@ -140,6 +155,8 @@ host	all	all	::1/128 	trust"))
                                           (const %postgresql-accounts))))))
 
 (define* (postgresql-service #:key (postgresql postgresql)
+                             (port 5432)
+                             (locale "en_US.utf8")
                              (config-file %default-postgres-config)
                              (data-directory "/var/lib/postgresql/data"))
   "Return a service that runs @var{postgresql}, the PostgreSQL database server.
@@ -149,6 +166,8 @@ and stores the database cluster in @var{data-directory}."
   (service postgresql-service-type
            (postgresql-configuration
             (postgresql postgresql)
+            (port port)
+            (locale locale)
             (config-file config-file)
             (data-directory data-directory))))
 
@@ -160,7 +179,8 @@ and stores the database cluster in @var{data-directory}."
 (define-record-type* <mysql-configuration>
   mysql-configuration make-mysql-configuration
   mysql-configuration?
-  (mysql mysql-configuration-mysql (default mariadb)))
+  (mysql mysql-configuration-mysql (default mariadb))
+  (port mysql-configuration-port (default 3306)))
 
 (define %mysql-accounts
   (list (user-group
@@ -175,10 +195,11 @@ and stores the database cluster in @var{data-directory}."
 
 (define mysql-configuration-file
   (match-lambda
-    (($ <mysql-configuration> mysql)
-     (plain-file "my.cnf" "[mysqld]
+    (($ <mysql-configuration> mysql port)
+     (mixed-text-file "my.cnf" "[mysqld]
 datadir=/var/lib/mysql
 socket=/run/mysqld/mysqld.sock
+port=" (number->string port) "
 "))))
 
 (define (%mysql-activation config)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 7555780ade..36049587d3 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -40,6 +40,7 @@
   #:use-module (gnu packages xdisorg)
   #:use-module (gnu packages suckless)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages libusb)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix store)
@@ -753,6 +754,10 @@ with the administrator's password."
          (screen-locker-service slock)
          (screen-locker-service xlockmore "xlock")
 
+         ;; Add udev rules for MTP devices so that non-root users can access
+         ;; them.
+         (simple-service 'mtp udev-service-type (list libmtp))
+
          ;; The D-Bus clique.
          (avahi-service)
          (wicd-service)
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index a56f63082c..cb33a7c53d 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -17,14 +17,388 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services kerberos)
-  #:use-module (gnu packages admin)
   #:use-module (gnu services)
+  #:use-module (gnu services configuration)
   #:use-module (gnu system pam)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
   #:export (pam-krb5-configuration
             pam-krb5-configuration?
-            pam-krb5-service-type))
+            pam-krb5-service-type
+
+            krb5-realm
+            krb5-realm?
+
+            krb5-configuration
+            krb5-configuration?
+            krb5-service-type))
+
+
+
+(define unset-field (list 'unset-field))
+
+(define (predicate/unset pred)
+  (lambda (x) (or (eq? x unset-field) (pred x))))
+
+(define string/unset? (predicate/unset string?))
+(define boolean/unset? (predicate/unset boolean?))
+(define integer/unset? (predicate/unset integer?))
+
+(define (uglify-field-name field-name)
+  "Return FIELD-NAME with all instances of '-' replaced by '_' and any
+trailing '?' removed."
+  (let ((str (symbol->string field-name)))
+    (string-join (string-split (if (string-suffix? "?" str)
+                                   (substring str 0 (1- (string-length str)))
+                                   str)
+                               #\-)
+                 "_")))
+
+(define (serialize-field* field-name val)
+  (format #t "~a = ~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-string/unset field-name val)
+  (unless (eq? val unset-field)
+      (serialize-field* field-name val)))
+
+(define (serialize-integer/unset field-name val)
+  (unless (eq? val unset-field)
+      (serialize-field* field-name val)))
+
+(define (serialize-boolean/unset field-name val)
+  (unless (eq? val unset-field)
+      (serialize-field* field-name
+                        (if val "true" "false"))))
+
+
+;; An end-point is an address such as "192.168.0.1"
+;; or an address port pair ("foobar.example.com" . 109)
+(define (end-point? val)
+  (match val
+    ((? string?) #t)
+    (((? string?) . (? integer?)) #t)
+    (_ #f)))
+
+(define (serialize-end-point field-name val)
+  (serialize-field* field-name
+                    (match val
+                      ((host . port)
+                       ;; The [] are needed in the case of IPv6 addresses
+                       (format #f "[~a]:~a" host port))
+                      (host
+                       (format #f "~a" host)))))
+
+(define (serialize-space-separated-string-list/unset field-name val)
+  (unless (eq? val unset-field)
+      (serialize-field* field-name (string-join val " "))))
+
+(define space-separated-string-list/unset?
+  (predicate/unset space-separated-string-list?))
+
+(define comma-separated-integer-list/unset?
+  (predicate/unset (lambda (val)
+                     (and (list? val)
+                          (and-map (lambda (x) (integer? x))
+                                   val)))))
+
+(define (serialize-comma-separated-integer-list/unset field-name val)
+  (unless (eq? val unset-field)
+      (serialize-field* field-name
+                       (string-drop ; Drop the leading comma
+                        (fold
+                         (lambda (i prev)
+                           (string-append prev "," (number->string i)))
+                         "" val) 1))))
+
+(define file-name? (predicate/unset
+                    (lambda (val)
+                      (string-prefix? "/" val))))
+
+(define (serialize-file-name field-name val)
+  (unless (eq? val unset-field)
+    (serialize-string field-name val)))
+
+(define (non-negative-integer? val)
+  (and (exact-integer? val) (not (negative? val))))
+
+(define (serialize-non-negative-integer/unset field-name val)
+  (unless (eq? val unset-field)
+    (serialize-field* field-name val)))
+
+(define (free-form-fields? val)
+  (match val
+    (() #t)
+    ((((? symbol?) . (? string)) . val) (free-form-fields? val))
+    (_ #f)))
+
+(define (serialize-free-form-fields field-name val)
+  (for-each (match-lambda ((k . v) (serialize-field* k v))) val))
+
+(define non-negative-integer/unset? (predicate/unset non-negative-integer?))
+
+(define (realm-list? val)
+  (and (list? val)
+       (and-map (lambda (x) (krb5-realm? x)) val)))
+
+(define (serialize-realm-list field-name val)
+  (format #t "\n[~a]\n" field-name)
+  (for-each (lambda (realm)
+              (format #t "\n~a = {\n" (krb5-realm-name realm))
+              (for-each (lambda (field)
+                          (unless (eq? 'name (configuration-field-name field))
+                            ((configuration-field-serializer field)
+                             (configuration-field-name field)
+                             ((configuration-field-getter field)
+                              realm)))) krb5-realm-fields)
+
+              (format #t "}\n")) val))
+
+
+
+;; For a more detailed explanation of these fields see man 5 krb5.conf
+(define-configuration krb5-realm
+  (name
+   (string/unset unset-field)
+   "The name of the realm.")
+
+  (kdc
+   (end-point unset-field)
+   "The host and port on which the realm's Key Distribution Server listens.")
+
+  (admin-server
+   (string/unset unset-field)
+   "The Host running the administration server for the realm.")
+
+  (master-kdc
+   (string/unset unset-field)
+   "If an attempt to get credentials fails because of an invalid password, 
+the client software will attempt to contact the master KDC.")
+
+  (kpasswd-server
+   (string/unset unset-field)
+   "The server where password changes are performed.")
+
+  (auth-to-local
+   (free-form-fields '())
+   "Rules to map between principals and local users.")
+
+  (auth-to-local-names
+   (free-form-fields '())
+   "Explicit mappings between principal names and local user names.")
+
+  (http-anchors
+   (free-form-fields '())
+   "Useful only when http proxy is used to access KDC or KPASSWD.")
+
+  ;; The following are useful only for working with V4 services
+  (default-domain
+    (string/unset unset-field)
+    "The domain used to expand host names when translating Kerberos 4 service
+principals to Kerberos 5 principals")
+
+  (v4-instance-convert
+   (free-form-fields '())
+   "Exceptions to the default-domain mapping rule.")
+
+  (v4-realm
+   (string/unset unset-field)
+   "Used  when the V4 realm name and the V5 realm name are not the same, but
+still share the same principal names and passwords"))
+
+
+
+;; For a more detailed explanation of these fields see man 5 krb5.conf
+(define-configuration krb5-configuration
+  (allow-weak-crypto?
+   (boolean/unset unset-field)
+   "If true, permits access to services which only offer weak encryption.")
+
+  (ap-req-checksum-type
+   (non-negative-integer/unset unset-field)
+   "The type of the AP-REQ checksum.")
+
+  (canonicalize?
+   (boolean/unset unset-field)
+   "Should principals in initial ticket requests be canonicalized?")
+
+  (ccache-type
+   (non-negative-integer/unset unset-field)
+   "The format of the credential cache type.")
+
+  (clockskew
+   (non-negative-integer/unset unset-field)
+   "Maximum allowable clock skew in seconds (default 300).")
+
+  (default-ccache-name
+    (file-name unset-field)
+    "The name of the default credential cache.")
+
+  (default-client-keytab-name
+    (file-name unset-field)
+    "The name of the default keytab for client credentials.")
+
+  (default-keytab-name
+    (file-name unset-field)
+    "The name of the default keytab file.")
+
+  (default-realm
+    (string/unset unset-field)
+    "The realm to be accessed if not explicitly specified by clients.")
+
+  (default-tgs-enctypes
+    (free-form-fields '())
+    "Session key encryption types when making TGS-REQ requests.")
+
+  (default-tkt-enctypes
+    (free-form-fields '())
+    "Session key encryption types when making AS-REQ requests.")
+
+  (dns-canonicalize-hostname?
+   (boolean/unset  unset-field)
+   "Whether name lookups will be used to canonicalize host names for use in 
+service principal names.")
+
+  (dns-lookup-kdc?
+   (boolean/unset unset-field)
+ "Should DNS SRV records should be used to locate the KDCs and other servers 
+not appearing in the realm specification")
+
+  (err-fmt
+   (string/unset unset-field)
+   "Custom error message formatting. If not #f error messages will be formatted 
+by substituting a normal error message for %M and an error code for %C in the 
+value.")
+
+  (forwardable?
+   (boolean/unset unset-field)
+   "Should initial tickets be forwardable by default?")
+
+  (ignore-acceptor-hostname?
+   (boolean/unset unset-field)
+   "When accepting GSSAPI or krb5 security contexts for host-based service 
+principals, ignore any hostname passed by the calling application, and allow 
+clients to authenticate to any service principal in the keytab matching the 
+service name and realm name.")
+
+  (k5login-authoritative?
+   (boolean/unset unset-field)
+   "If this flag is true, principals must be listed in a local user's k5login
+file to be granted login access, if a ~/.k5login file exists.")
+
+  (k5login-directory
+   (string/unset unset-field)
+   "If not #f, the library will look for a local user's @file{k5login} file 
+within the named directory (instead of the user's home directory), with a 
+file name corresponding to the local user name.")
+
+  (kcm-mach-service
+   (string/unset unset-field)
+   "The name of the bootstrap service used to contact the KCM daemon for the 
+KCM credential cache type.")
+
+  (kcm-socket
+   (file-name unset-field)
+ "Path to the Unix domain socket used to access the KCM daemon for the KCM 
+credential cache type.")
+
+  (kdc-default-options
+   (non-negative-integer/unset unset-field)
+   "Default KDC options (logored for multiple values) when requesting initial 
+tickets.")
+
+  (kdc-timesync
+   (non-negative-integer/unset unset-field)
+   "Attempt to compensate for clock skew between the KDC and client.")
+
+  (kdc-req-checksum-type
+   (non-negative-integer/unset unset-field)
+   "The type of checksum to use for the KDC requests. Relevant only for DES 
+keys")
+
+  (noaddresses?
+   (boolean/unset unset-field)
+   "If true, initial ticket requests will not be made with address restrictions.
+This enables their use across NATs.")
+
+  (permitted-enctypes
+   (space-separated-string-list/unset unset-field)
+   "All encryption types that are permitted for use in session key encryption.")
+
+  (plugin-base-dir
+   (file-name unset-field)
+   "The directory where krb5 plugins are located.")
+
+  (preferred-preauth-types
+   (comma-separated-integer-list/unset unset-field)
+   "The preferred pre-authentication types which the client will attempt before 
+others.")
+
+  (proxiable?
+   (boolean/unset unset-field)
+   "Should initial tickets be proxiable by default?")
+
+  (rdns?
+   (boolean/unset unset-field)
+   "Should reverse DNS lookup be used in addition to forward name lookup to 
+canonicalize host names for use in service principal names.")
+
+  (realm-try-domains
+   (integer/unset unset-field)
+   "Should a host's domain components should be used to determine the Kerberos 
+realm of the host.")
+
+  (renew-lifetime
+   (non-negative-integer/unset unset-field)
+   "The default renewable lifetime for initial ticket requests.")
+
+  (safe-checksum-type
+   (non-negative-integer/unset unset-field)
+   "The type of checksum to use for the KRB-SAFE requests.")
+
+  (ticket-lifetime
+   (non-negative-integer/unset unset-field)
+   "The default lifetime for initial ticket requests.")
+
+  (udp-preference-limit
+   (non-negative-integer/unset unset-field)
+   "When sending messages to the KDC, the library will try using TCP
+before UDP if the size of the message greater than this limit.")
+
+  (verify-ap-rereq-nofail?
+   (boolean/unset unset-field)
+ "If true, then attempts to verify initial credentials will fail if the client
+machine does not have a keytab.")
+
+  (realms
+   (realm-list '())
+   "The list of realms which clients may access."))
+
+
+(define (krb5-configuration-file config)
+  "Create a Kerberos 5 configuration file based on CONFIG"
+  (mixed-text-file "krb5.conf"
+                   "[libdefaults]\n\n"
+                   (with-output-to-string
+                     (lambda ()
+                       (serialize-configuration config
+                                                krb5-configuration-fields)))))
+
+(define (krb5-etc-service config)
+  (list `("krb5.conf" ,(krb5-configuration-file config))))
+
+
+(define krb5-service-type
+  (service-type (name 'krb5)
+                (extensions
+                 (list (service-extension etc-service-type
+                                          krb5-etc-service)))))
+
+
+
 
 (define-record-type* <pam-krb5-configuration>
   pam-krb5-configuration  make-pam-krb5-configuration
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index bbb9053008..d672ecf687 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -467,6 +467,9 @@ HiddenServicePort ~a ~a~%"
       (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
       (chmod "/var/lib/tor" #o700)
 
+      ;; Make sure /var/lib is accessible to the 'tor' user.
+      (chmod "/var/lib" #o755)
+
       (for-each initialize
                 '#$(map hidden-service-name
                         (tor-configuration-hidden-services config)))))
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index 5bb58bd6f0..2ebfe22016 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -220,7 +220,7 @@ Relogin="              (if (sddm-configuration-relogin? config)
    (name "sddm-greeter")
    (auth
     (list
-     ;; Load environment form /etc/environment and ~/.pam_environment
+     ;; Load environment from /etc/environment and ~/.pam_environment
      (pam-entry
       (control "required")
       (module "pam_env.so"))
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 3273184b9a..d8d5006abf 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -82,7 +82,7 @@
                     (loop (+ 1 fd))))
 
                 ;; Start shepherd.
-                (execl (string-append #$shepherd "/bin/shepherd")
+                (execl #$(file-append shepherd "/bin/shepherd")
                        "shepherd" "--config" #$shepherd-conf)))))
 
 (define shepherd-root-service-type
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 59e1e54e04..db895405a2 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -27,11 +27,12 @@
   #:use-module (gnu packages web)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (nginx-configuration
             nginx-configuration?
-            nginx-vhost-configuration
-            nginx-vhost-configuration?
+            nginx-server-configuration
+            nginx-server-configuration?
             nginx-service
             nginx-service-type))
 
@@ -41,24 +42,24 @@
 ;;;
 ;;; Code:
 
-(define-record-type* <nginx-vhost-configuration>
-  nginx-vhost-configuration make-nginx-vhost-configuration
-  nginx-vhost-configuration?
-  (http-port           nginx-vhost-configuration-http-port
+(define-record-type* <nginx-server-configuration>
+  nginx-server-configuration make-nginx-server-configuration
+  nginx-server-configuration?
+  (http-port           nginx-server-configuration-http-port
                        (default 80))
-  (https-port          nginx-vhost-configuration-https-port
+  (https-port          nginx-server-configuration-https-port
                        (default 443))
-  (server-name         nginx-vhost-configuration-server-name
+  (server-name         nginx-server-configuration-server-name
                        (default (list 'default)))
-  (root                nginx-vhost-configuration-root
+  (root                nginx-server-configuration-root
                        (default "/srv/http"))
-  (index               nginx-vhost-configuration-index
+  (index               nginx-server-configuration-index
                        (default (list "index.html")))
-  (ssl-certificate     nginx-vhost-configuration-ssl-certificate
+  (ssl-certificate     nginx-server-configuration-ssl-certificate
                        (default "/etc/nginx/cert.pem"))
-  (ssl-certificate-key nginx-vhost-configuration-ssl-certificate-key
+  (ssl-certificate-key nginx-server-configuration-ssl-certificate-key
                        (default "/etc/nginx/key.pem"))
-  (server-tokens?      nginx-vhost-configuration-server-tokens?
+  (server-tokens?      nginx-server-configuration-server-tokens?
                        (default #f)))
 
 (define-record-type* <nginx-configuration>
@@ -67,56 +68,57 @@
   (nginx         nginx-configuration-nginx)         ;<package>
   (log-directory nginx-configuration-log-directory) ;string
   (run-directory nginx-configuration-run-directory) ;string
+  (server-blocks nginx-configuration-server-blocks) ;list
   (file          nginx-configuration-file))         ;string | file-like
 
 (define (config-domain-strings names)
  "Return a string denoting the nginx config representation of NAMES, a list
 of domain names."
- (string-concatenate
+ (string-join
   (map (match-lambda
-        ('default "_")
-        ((? string? str) str))
+        ('default "_ ")
+        ((? string? str) (string-append str " ")))
        names)))
 
 (define (config-index-strings names)
  "Return a string denoting the nginx config representation of NAMES, a list
 of index files."
- (string-concatenate
+ (string-join
   (map (match-lambda
-        ((? string? str) str))
+        ((? string? str) (string-append str " ")))
        names)))
 
-(define (default-nginx-vhost-config vhost)
+(define (default-nginx-server-config server)
   (string-append
    "    server {\n"
-   (if (nginx-vhost-configuration-http-port vhost)
+   (if (nginx-server-configuration-http-port server)
        (string-append "      listen "
-                      (number->string (nginx-vhost-configuration-http-port vhost))
+                      (number->string (nginx-server-configuration-http-port server))
                       ";\n")
        "")
-   (if (nginx-vhost-configuration-https-port vhost)
+   (if (nginx-server-configuration-https-port server)
        (string-append "      listen "
-                      (number->string (nginx-vhost-configuration-https-port vhost))
+                      (number->string (nginx-server-configuration-https-port server))
                       " ssl;\n")
        "")
    "      server_name " (config-domain-strings
-                         (nginx-vhost-configuration-server-name vhost))
+                         (nginx-server-configuration-server-name server))
                         ";\n"
-   (if (nginx-vhost-configuration-ssl-certificate vhost)
+   (if (nginx-server-configuration-ssl-certificate server)
        (string-append "      ssl_certificate "
-                      (nginx-vhost-configuration-ssl-certificate vhost) ";\n")
+                      (nginx-server-configuration-ssl-certificate server) ";\n")
        "")
-   (if (nginx-vhost-configuration-ssl-certificate-key vhost)
+   (if (nginx-server-configuration-ssl-certificate-key server)
        (string-append "      ssl_certificate_key "
-                      (nginx-vhost-configuration-ssl-certificate-key vhost) ";\n")
+                      (nginx-server-configuration-ssl-certificate-key server) ";\n")
        "")
-   "      root " (nginx-vhost-configuration-root vhost) ";\n"
-   "      index " (config-index-strings (nginx-vhost-configuration-index vhost)) ";\n"
-   "      server_tokens " (if (nginx-vhost-configuration-server-tokens? vhost)
+   "      root " (nginx-server-configuration-root server) ";\n"
+   "      index " (config-index-strings (nginx-server-configuration-index server)) ";\n"
+   "      server_tokens " (if (nginx-server-configuration-server-tokens? server)
                               "on" "off") ";\n"
    "    }\n"))
 
-(define (default-nginx-config log-directory run-directory vhost-list)
+(define (default-nginx-config log-directory run-directory server-list)
   (plain-file "nginx.conf"
               (string-append
                "user nginx nginx;\n"
@@ -129,7 +131,7 @@ of index files."
                "    uwsgi_temp_path " run-directory "/uwsgi_temp;\n"
                "    scgi_temp_path " run-directory "/scgi_temp;\n"
                "    access_log " log-directory "/access.log;\n"
-               (let ((http (map default-nginx-vhost-config vhost-list)))
+               (let ((http (map default-nginx-server-config server-list)))
                  (do ((http http (cdr http))
                       (block "" (string-append (car http) "\n" block )))
                      ((null? http) block)))
@@ -148,7 +150,8 @@ of index files."
 
 (define nginx-activation
   (match-lambda
-    (($ <nginx-configuration> nginx log-directory run-directory config-file)
+    (($ <nginx-configuration> nginx log-directory run-directory server-blocks
+                              config-file)
      #~(begin
          (use-modules (guix build utils))
 
@@ -164,17 +167,25 @@ of index files."
          (mkdir-p (string-append #$run-directory "/scgi_temp"))
          ;; Check configuration file syntax.
          (system* (string-append #$nginx "/sbin/nginx")
-                  "-c" #$config-file "-t")))))
+                  "-c" #$(or config-file
+                             (default-nginx-config log-directory
+                               run-directory server-blocks))
+                  "-t")))))
 
 (define nginx-shepherd-service
   (match-lambda
-    (($ <nginx-configuration> nginx log-directory run-directory config-file)
+    (($ <nginx-configuration> nginx log-directory run-directory server-blocks
+                              config-file)
      (let* ((nginx-binary (file-append nginx "/sbin/nginx"))
             (nginx-action
              (lambda args
                #~(lambda _
                    (zero?
-                    (system* #$nginx-binary "-c" #$config-file #$@args))))))
+                    (system* #$nginx-binary "-c"
+                             #$(or config-file
+                                   (default-nginx-config log-directory
+                                     run-directory server-blocks))
+                             #$@args))))))
 
        ;; TODO: Add 'reload' action.
        (list (shepherd-service
@@ -192,14 +203,20 @@ of index files."
                        (service-extension activation-service-type
                                           nginx-activation)
                        (service-extension account-service-type
-                                          (const %nginx-accounts))))))
+                                          (const %nginx-accounts))))
+                (compose concatenate)
+                (extend (lambda (config servers)
+                          (nginx-configuration
+                            (inherit config)
+                            (server-blocks
+                              (append (nginx-configuration-server-blocks config)
+                              servers)))))))
 
 (define* (nginx-service #:key (nginx nginx)
                         (log-directory "/var/log/nginx")
                         (run-directory "/var/run/nginx")
-                        (vhost-list (list (nginx-vhost-configuration)))
-                        (config-file
-                         (default-nginx-config log-directory run-directory vhost-list)))
+                        (server-list '())
+                        (config-file #f))
   "Return a service that runs NGINX, the nginx web server.
 
 The nginx daemon loads its runtime configuration from CONFIG-FILE, stores log
@@ -209,4 +226,5 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY."
             (nginx nginx)
             (log-directory log-directory)
             (run-directory run-directory)
+            (server-blocks server-list)
             (file config-file))))