Merge branch 'master' into staging

11 files changed, 420 insertions, 105 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d560ad5a13..04bc991356 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1570,6 +1570,9 @@ proxy of 'guix-daemon'...~%")
                     ;; the 'set-http-proxy' action.
                     (or (getenv "http_proxy") #$http-proxy))
 
+                  ;; Start the guix-daemon from a container, when supported,
+                  ;; to solve an installation issue. See the comment below for
+                  ;; more details.
                   (fork+exec-command/container
                    (cons* #$(file-append guix "/bin/guix-daemon")
                           "--build-users-group" #$build-group
@@ -1600,6 +1603,8 @@ proxy of 'guix-daemon'...~%")
                    ;; operate from within the same MNT namespace as the
                    ;; installation container. In that case only, enter the
                    ;; namespace of the process PID passed as start argument.
+                   ;; Otherwise, for symmetry purposes enter the caller
+                   ;; namespaces which is a no-op.
                    #:pid (match args
                            ((pid) (string->number pid))
                            (else (getpid)))
@@ -1648,10 +1653,15 @@ proxy of 'guix-daemon'...~%")
      ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs,
      ;; chown leads to an entire copy of the tree, which is a bad idea.
 
-     ;; Optionally authorize substitute server keys.
-     (if authorize-key?
-         (substitute-key-authorization keys guix)
-         #~#f))))
+     ;; Generate a key pair and optionally authorize substitute server keys.
+     #~(begin
+         (unless (file-exists? "/etc/guix/signing-key.pub")
+           (system* #$(file-append guix "/bin/guix") "archive"
+                    "--generate-key"))
+
+         #$(if authorize-key?
+               (substitute-key-authorization keys guix)
+               #~#f)))))
 
 (define* (references-file item #:optional (name "references"))
   "Return a file that contains the list of references of ITEM."
diff --git a/gnu/services/certbot.scm b/gnu/services/certbot.scm
index 5643340799..1c67ff63f1 100644
--- a/gnu/services/certbot.scm
+++ b/gnu/services/certbot.scm
@@ -71,7 +71,8 @@
                        (default "/var/www"))
   (certificates        certbot-configuration-certificates
                        (default '()))
-  (email               certbot-configuration-email)
+  (email               certbot-configuration-email
+                       (default #f))
   (server              certbot-configuration-server
                        (default #f))
   (rsa-key-size        certbot-configuration-rsa-key-size
@@ -99,12 +100,14 @@
                    (if challenge
                      (append
                       (list name certbot "certonly" "-n" "--agree-tos"
-                            "-m" email
                             "--manual"
                             (string-append "--preferred-challenges=" challenge)
                             "--cert-name" name
                             "--manual-public-ip-logging-ok"
                             "-d" (string-join domains ","))
+                      (if email
+                          `("--email" ,email)
+                          '("--register-unsafely-without-email"))
                       (if server `("--server" ,server) '())
                       (if rsa-key-size `("--rsa-key-size" ,rsa-key-size) '())
                       (if authentication-hook
@@ -114,10 +117,12 @@
                       (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 email
+                          `("--email" ,email)
+                          '("--register-unsafely-without-email"))
                       (if server `("--server" ,server) '())
                       (if rsa-key-size `("--rsa-key-size" ,rsa-key-size) '())
                       (if deploy-hook `("--deploy-hook" ,deploy-hook) '()))))))
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 0f4f0f9948..a50f583807 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -54,6 +54,11 @@
                     (default "/var/log/cuirass.log"))
   (web-log-file     cuirass-configuration-web-log-file ;string
                     (default "/var/log/cuirass-web.log"))
+  (queries-log-file cuirass-configuration-queries-log-file ;string
+                    (default #f))
+  (web-queries-log-file
+                    cuirass-configuration-web-queries-log-file ;string
+                    (default #f))
   (cache-directory  cuirass-configuration-cache-directory ;string (dir-name)
                     (default "/var/cache/cuirass"))
   (ttl              cuirass-configuration-ttl     ;integer
@@ -87,6 +92,9 @@
         (cache-directory  (cuirass-configuration-cache-directory config))
         (web-log-file     (cuirass-configuration-web-log-file config))
         (log-file         (cuirass-configuration-log-file config))
+        (queries-log-file (cuirass-configuration-queries-log-file config))
+        (web-queries-log-file
+                          (cuirass-configuration-web-queries-log-file config))
         (user             (cuirass-configuration-user config))
         (group            (cuirass-configuration-group config))
         (interval         (cuirass-configuration-interval config))
@@ -111,6 +119,10 @@
                            "--database" #$database
                            "--ttl" #$(string-append (number->string ttl) "s")
                            "--interval" #$(number->string interval)
+                           #$@(if queries-log-file
+                                  (list (string-append "--log-queries="
+                                                       queries-log-file))
+                                  '())
                            #$@(if use-substitutes? '("--use-substitutes") '())
                            #$@(if one-shot? '("--one-shot") '())
                            #$@(if fallback? '("--fallback") '())
@@ -140,6 +152,10 @@
                            "--port" #$(number->string port)
                            "--listen" #$host
                            "--interval" #$(number->string interval)
+                           #$@(if web-queries-log-file
+                                  (list (string-append "--log-queries="
+                                                       web-queries-log-file))
+                                  '())
                            #$@(if use-substitutes? '("--use-substitutes") '())
                            #$@(if fallback? '("--fallback") '())
                            #$@extra-options)
@@ -170,6 +186,9 @@
         (db    (dirname (cuirass-configuration-database config)))
         (user  (cuirass-configuration-user config))
         (log   "/var/log/cuirass")
+        (queries-log-file (cuirass-configuration-queries-log-file config))
+        (web-queries-log-file
+         (cuirass-configuration-web-queries-log-file config))
         (group (cuirass-configuration-group config)))
     (with-imported-modules '((guix build utils))
       #~(begin
@@ -183,14 +202,33 @@
                 (gid (group:gid (getgr #$group))))
             (chown #$cache uid gid)
             (chown #$db uid gid)
-            (chown #$log uid gid))))))
+            (chown #$log uid gid)
+
+            (let ((queries-log-file #$queries-log-file))
+              (when queries-log-file
+                (call-with-output-file queries-log-file (const #t))
+                (chown #$queries-log-file uid gid)))
+
+            (let ((web-queries-log-file #$web-queries-log-file))
+              (when web-queries-log-file
+                (call-with-output-file web-queries-log-file (const #t))
+                (chown web-queries-log-file uid gid))))))))
 
 (define (cuirass-log-rotations config)
   "Return the list of log rotations that corresponds to CONFIG."
-  (list (log-rotation
-         (files (list (cuirass-configuration-log-file config)))
-         (frequency 'weekly)
-         (options '("rotate 40")))))              ;worth keeping
+  (let ((queries-log-file (cuirass-configuration-queries-log-file config))
+        (web-queries-log-file
+         (cuirass-configuration-web-queries-log-file config)))
+    (list (log-rotation
+           (files `(,(cuirass-configuration-log-file config)
+                    ,@(if queries-log-file
+                          (list queries-log-file)
+                          '())
+                    ,@(if web-queries-log-file
+                          (list web-queries-log-file)
+                          '())))
+           (frequency 'weekly)
+           (options '("rotate 40"))))))              ;worth keeping
 
 (define cuirass-service-type
   (service-type
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index bdbea5dddf..3a3fd8fd1b 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
-;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2017 Nikita <nikita@n0.is>
 ;;; Copyright © 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
@@ -54,6 +54,7 @@
   #:use-module (gnu packages linux)
   #:use-module (gnu packages libusb)
   #:use-module (gnu packages mate)
+  #:use-module (gnu packages nfs)
   #:use-module (gnu packages enlightenment)
   #:use-module (guix deprecation)
   #:use-module (guix records)
@@ -470,6 +471,7 @@ site} for more information."
                                   ,(bluetooth-directory config)))))
           (service-extension shepherd-root-service-type
                              (compose list bluetooth-shepherd-service))))
+   (default-value (bluetooth-configuration))
    (description "Run the @command{bluetoothd} daemon, which manages all the
 Bluetooth devices and provides a number of D-Bus interfaces.")))
 
@@ -595,64 +597,66 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
 (define-record-type* <elogind-configuration> elogind-configuration
   make-elogind-configuration
   elogind-configuration?
-  (elogind                         elogind-package
-                                   (default elogind))
-  (kill-user-processes?            elogind-kill-user-processes?
-                                   (default #f))
-  (kill-only-users                 elogind-kill-only-users
-                                   (default '()))
-  (kill-exclude-users              elogind-kill-exclude-users
-                                   (default '("root")))
-  (inhibit-delay-max-seconds       elogind-inhibit-delay-max-seconds
-                                   (default 5))
-  (handle-power-key                elogind-handle-power-key
-                                   (default 'poweroff))
-  (handle-suspend-key              elogind-handle-suspend-key
-                                   (default 'suspend))
-  (handle-hibernate-key            elogind-handle-hibernate-key
-                                   ;; (default 'hibernate)
-                                   ;; XXX Ignore it for now, since we don't
-                                   ;; yet handle resume-from-hibernation in
-                                   ;; our initrd.
-                                   (default 'ignore))
-  (handle-lid-switch               elogind-handle-lid-switch
-                                   (default 'suspend))
-  (handle-lid-switch-docked        elogind-handle-lid-switch-docked
-                                   (default 'ignore))
-  (power-key-ignore-inhibited?     elogind-power-key-ignore-inhibited?
-                                   (default #f))
-  (suspend-key-ignore-inhibited?   elogind-suspend-key-ignore-inhibited?
-                                   (default #f))
-  (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
-                                   (default #f))
-  (lid-switch-ignore-inhibited?    elogind-lid-switch-ignore-inhibited?
-                                   (default #t))
-  (holdoff-timeout-seconds         elogind-holdoff-timeout-seconds
-                                   (default 30))
-  (idle-action                     elogind-idle-action
-                                   (default 'ignore))
-  (idle-action-seconds             elogind-idle-action-seconds
-                                   (default (* 30 60)))
-  (runtime-directory-size-percent  elogind-runtime-directory-size-percent
-                                   (default 10))
-  (runtime-directory-size          elogind-runtime-directory-size
-                                   (default #f))
-  (remove-ipc?                     elogind-remove-ipc?
-                                   (default #t))
-
-  (suspend-state                   elogind-suspend-state
-                                   (default '("mem" "standby" "freeze")))
-  (suspend-mode                    elogind-suspend-mode
-                                   (default '()))
-  (hibernate-state                 elogind-hibernate-state
-                                   (default '("disk")))
-  (hibernate-mode                  elogind-hibernate-mode
-                                   (default '("platform" "shutdown")))
-  (hybrid-sleep-state              elogind-hybrid-sleep-state
-                                   (default '("disk")))
-  (hybrid-sleep-mode               elogind-hybrid-sleep-mode
-                                   (default
-                                     '("suspend" "platform" "shutdown"))))
+  (elogind                          elogind-package
+                                    (default elogind))
+  (kill-user-processes?             elogind-kill-user-processes?
+                                    (default #f))
+  (kill-only-users                  elogind-kill-only-users
+                                    (default '()))
+  (kill-exclude-users               elogind-kill-exclude-users
+                                    (default '("root")))
+  (inhibit-delay-max-seconds        elogind-inhibit-delay-max-seconds
+                                    (default 5))
+  (handle-power-key                 elogind-handle-power-key
+                                    (default 'poweroff))
+  (handle-suspend-key               elogind-handle-suspend-key
+                                    (default 'suspend))
+  (handle-hibernate-key             elogind-handle-hibernate-key
+                                    ;; (default 'hibernate)
+                                    ;; XXX Ignore it for now, since we don't
+                                    ;; yet handle resume-from-hibernation in
+                                    ;; our initrd.
+                                    (default 'ignore))
+  (handle-lid-switch                elogind-handle-lid-switch
+                                    (default 'suspend))
+  (handle-lid-switch-docked         elogind-handle-lid-switch-docked
+                                    (default 'ignore))
+  (handle-lid-switch-external-power elogind-handle-lid-switch-external-power
+                                    (default 'ignore))
+  (power-key-ignore-inhibited?      elogind-power-key-ignore-inhibited?
+                                    (default #f))
+  (suspend-key-ignore-inhibited?    elogind-suspend-key-ignore-inhibited?
+                                    (default #f))
+  (hibernate-key-ignore-inhibited?  elogind-hibernate-key-ignore-inhibited?
+                                    (default #f))
+  (lid-switch-ignore-inhibited?     elogind-lid-switch-ignore-inhibited?
+                                    (default #t))
+  (holdoff-timeout-seconds          elogind-holdoff-timeout-seconds
+                                    (default 30))
+  (idle-action                      elogind-idle-action
+                                    (default 'ignore))
+  (idle-action-seconds              elogind-idle-action-seconds
+                                    (default (* 30 60)))
+  (runtime-directory-size-percent   elogind-runtime-directory-size-percent
+                                    (default 10))
+  (runtime-directory-size           elogind-runtime-directory-size
+                                    (default #f))
+  (remove-ipc?                      elogind-remove-ipc?
+                                    (default #t))
+
+  (suspend-state                    elogind-suspend-state
+                                    (default '("mem" "standby" "freeze")))
+  (suspend-mode                     elogind-suspend-mode
+                                    (default '()))
+  (hibernate-state                  elogind-hibernate-state
+                                    (default '("disk")))
+  (hibernate-mode                   elogind-hibernate-mode
+                                    (default '("platform" "shutdown")))
+  (hybrid-sleep-state               elogind-hybrid-sleep-state
+                                    (default '("disk")))
+  (hybrid-sleep-mode                elogind-hybrid-sleep-mode
+                                    (default
+                                      '("suspend" "platform" "shutdown"))))
 
 (define (elogind-configuration-file config)
   (define (yesno x)
@@ -704,6 +708,7 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
    ("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
    ("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
    ("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
+   ("HandleLidSwitchExternalPower" (handle-action elogind-handle-lid-switch-external-power))
    ("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
    ("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
    ("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
@@ -1202,6 +1207,12 @@ or setting its password with passwd.")))
          ;; perform administrative tasks (similar to "sudo").
          polkit-wheel-service
 
+         ;; Allow desktop users to also mount NTFS and NFS file systems
+         ;; without root.
+         (simple-service 'mount-setuid-helpers setuid-program-service-type
+                         (list (file-append nfs-utils "/sbin/mount.nfs")
+                               (file-append ntfs-3g "/sbin/mount.ntfs-3g")))
+
          ;; The global fontconfig cache directory can sometimes contain
          ;; stale entries, possibly referencing fonts that have been GC'd,
          ;; so mount it read-only.
diff --git a/gnu/services/dict.scm b/gnu/services/dict.scm
index 519ed3eca2..a97ad8f608 100644
--- a/gnu/services/dict.scm
+++ b/gnu/services/dict.scm
@@ -187,7 +187,7 @@ of DICT server (@pxref{Dicod,,, dico, GNU Dico Manual}).
 
 The optional @var{config} argument specifies the configuration for
 @command{dicod}, which should be a @code{<dicod-configuration>} object, by
-default it serves the GNU Collaborative International Dictonary of English.
+default it serves the GNU Collaborative International Dictionary of English.
 
 You can add @command{open localhost} to your @file{~/.dico} file to make
 @code{localhost} the default server for @command{dico}
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 380a942ed2..e23014213b 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,6 +46,9 @@
   (docker
    (package docker)
    "Docker daemon package.")
+  (docker-cli
+   (package docker-cli)
+   "Docker client package.")
   (containerd
    (package containerd)
    "containerd package.")
@@ -117,9 +122,11 @@ loop-back communications.")
                            #$@(if debug?
                                   '("--debug" "--log-level=debug")
                                   '())
-                           (if #$enable-proxy? "--userland-proxy" "")
-                           "--userland-proxy-path" (string-append #$proxy
-                                                                  "/bin/proxy")
+                           #$@(if enable-proxy?
+                                  (list "--userland-proxy=true"
+                                        #~(string-append
+                                           "--userland-proxy-path=" #$proxy "/bin/proxy"))
+                                  '("--userland-proxy=false"))
                            (if #$enable-iptables?
                                "--iptables"
                                "--iptables=false"))
@@ -133,6 +140,9 @@ loop-back communications.")
 bundles in Docker containers.")
                 (extensions
                  (list
+                  ;; Make sure the 'docker' command is available.
+                  (service-extension profile-service-type
+                                     (compose list docker-configuration-docker-cli))
                   (service-extension activation-service-type
                                      %docker-activation)
                   (service-extension shepherd-root-service-type
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index ec42663a11..72c7779596 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -196,7 +196,7 @@ representation."
 (define-record-type* <zram-device-configuration>
   zram-device-configuration make-zram-device-configuration
   zram-device-configuration?
-  (size                     zram-device-configration-size
+  (size                     zram-device-configuration-size
                             (default "1G"))     ; string or integer
   (compression-algorithm    zram-device-configuration-compression-algorithm
                             (default 'lzo))     ; symbol
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 11b41f2bf6..8f2f3914cf 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Pierre-Antoine Rouby <contact@parouby.fr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -813,14 +813,15 @@ string, you could instantiate a prosody service like this:
   (match-lambda
     (($ <bitlbee-configuration> bitlbee interface port
                                 plugins extra-settings)
-     (let ((conf (mixed-text-file "bitlbee.conf"
+     (let* ((plugins (directory-union "bitlbee-plugins" plugins))
+            (conf    (mixed-text-file "bitlbee.conf"
                                   "
   [settings]
   User = bitlbee
   ConfigDir = /var/lib/bitlbee
   DaemonInterface = " interface "
   DaemonPort = " (number->string port) "
-  PluginDir = " (directory-union "bitlbee-plugins" plugins) "/lib/bitlbee
+  PluginDir = " plugins "/lib/bitlbee
 " extra-settings)))
 
        (with-imported-modules (source-module-closure
@@ -840,6 +841,11 @@ string, you could instantiate a prosody service like this:
                           (list #$(file-append bitlbee "/sbin/bitlbee")
                                 "-n" "-F" "-u" "bitlbee" "-c" #$conf)
 
+                          ;; Allow 'bitlbee-purple' to use libpurple plugins.
+                          #:environment-variables
+                          (list (string-append "PURPLE_PLUGIN_PATH="
+                                               #$plugins "/lib/purple-2"))
+
                           #:pid-file "/var/run/bitlbee.pid"
                           #:mappings (list (file-system-mapping
                                             (source "/var/lib/bitlbee")
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index e45b116218..64f54e787f 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1324,7 +1324,7 @@ whatever the thing is supposed to do).")))
   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
                       (default wpa-supplicant))
   (requirement        wpa-supplicant-configuration-requirement    ;list of symbols
-                      (default '(user-processes dbus-system loopback syslogd)))
+                      (default '(user-processes loopback syslogd)))
   (pid-file           wpa-supplicant-configuration-pid-file       ;string
                       (default "/var/run/wpa_supplicant.pid"))
   (dbus?              wpa-supplicant-configuration-dbus?          ;Boolean
@@ -1343,7 +1343,9 @@ whatever the thing is supposed to do).")))
      (list (shepherd-service
             (documentation "Run the WPA supplicant daemon")
             (provision '(wpa-supplicant))
-            (requirement requirement)
+            (requirement (if dbus?
+                             (cons 'dbus-system requirement)
+                             requirement))
             (start #~(make-forkexec-constructor
                       (list (string-append #$wpa-supplicant
                                            "/sbin/wpa_supplicant")
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index ced21c0742..1891db0487 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 pinoaffe <pinoaffe@airmail.cc>
+;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (gnu packages admin)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu services web)
   #:use-module (gnu system pam)
   #:use-module (gnu system shadow)
   #:use-module (guix gexp)
@@ -50,7 +52,12 @@
 
             autossh-configuration
             autossh-configuration?
-            autossh-service-type))
+            autossh-service-type
+
+            webssh-configuration
+            webssh-configuration?
+            webssh-service-type
+            %webssh-configuration-nginx))
 
 ;;; Commentary:
 ;;;
@@ -732,4 +739,126 @@ object."
                              autossh-service-activation)))
    (default-value (autossh-configuration))))
 
+
+;;;
+;;; WebSSH
+;;;
+
+(define-record-type* <webssh-configuration>
+  webssh-configuration make-webssh-configuration
+  webssh-configuration?
+  (package     webssh-configuration-package     ;package
+               (default webssh))
+  (user-name   webssh-configuration-user-name   ;string
+               (default "webssh"))
+  (group-name  webssh-configuration-group-name  ;string
+               (default "webssh"))
+  (policy      webssh-configuration-policy      ;symbol
+               (default #f))
+  (known-hosts webssh-configuration-known-hosts ;list of strings
+               (default #f))
+  (port        webssh-configuration-port        ;number
+               (default #f))
+  (address     webssh-configuration-address     ;string
+               (default #f))
+  (log-file    webssh-configuration-log-file    ;string
+               (default "/var/log/webssh.log"))
+  (log-level   webssh-configuration-log-level   ;symbol
+               (default #f)))
+
+(define %webssh-configuration-nginx
+  (nginx-server-configuration
+   (listen '("80"))
+   (locations
+    (list (nginx-location-configuration
+           (uri "/")
+           (body '("proxy_pass http://127.0.0.1:8888;"
+                   "proxy_http_version 1.1;"
+                   "proxy_read_timeout 300;"
+                   "proxy_set_header Upgrade $http_upgrade;"
+                   "proxy_set_header Connection \"upgrade\";"
+                   "proxy_set_header Host $http_host;"
+                   "proxy_set_header X-Real-IP $remote_addr;"
+                   "proxy_set_header X-Real-PORT $remote_port;")))))))
+
+(define webssh-account
+  ;; Return the user accounts and user groups for CONFIG.
+  (match-lambda
+    (($ <webssh-configuration> _ user-name group-name _ _ _ _ _ _)
+     (list (user-group
+            (name group-name))
+           (user-account
+            (name user-name)
+            (group group-name)
+            (comment "webssh privilege separation user")
+            (home-directory (string-append "/var/run/" user-name))
+            (shell #~(string-append #$shadow "/sbin/nologin")))))))
+
+(define webssh-activation
+  ;; Return the activation GEXP for CONFIG.
+  (match-lambda
+    (($ <webssh-configuration> _ user-name group-name policy known-hosts _ _
+                               log-file _)
+     (with-imported-modules '((guix build utils))
+       #~(begin
+           (let* ((home-dir (string-append "/var/run/" #$user-name))
+                  (ssh-dir (string-append home-dir "/.ssh"))
+                  (known-hosts-file (string-append ssh-dir "/known_hosts")))
+             (call-with-output-file #$log-file (const #t))
+             (mkdir-p ssh-dir)
+             (case '#$policy
+               ((reject)
+                (if '#$known-hosts
+                    (call-with-output-file known-hosts-file
+                      (lambda (port)
+                        (for-each (lambda (host) (display host port) (newline port))
+                                  '#$known-hosts)))
+                    (display-hint (G_ "webssh: reject policy requires `known-hosts'.")))))
+             (for-each (lambda (file)
+                         (chown file
+                                (passwd:uid (getpw #$user-name))
+                                (group:gid (getpw #$group-name))))
+                       (list #$log-file ssh-dir known-hosts-file))
+             (chmod ssh-dir #o700)))))))
+
+(define webssh-shepherd-service
+  (match-lambda
+    (($ <webssh-configuration> package user-name group-name policy _ port
+                               address log-file log-level)
+     (list (shepherd-service
+            (provision '(webssh))
+            (documentation "Run webssh daemon.")
+            (start #~(make-forkexec-constructor
+                      `(,(string-append #$webssh "/bin/wssh")
+                        ,(string-append "--log-file-prefix=" #$log-file)
+                        ,@(case '#$log-level
+                            ((debug) '("--logging=debug"))
+                            (else '()))
+                        ,@(case '#$policy
+                            ((reject) '("--policy=reject"))
+                            (else '()))
+                        ,@(if #$port
+                              (list (string-append "--port=" (number->string #$port)))
+                              '())
+                        ,@(if #$address
+                              (list (string-append "--address=" #$address))
+                              '()))
+                      #:user #$user-name
+                      #:group #$group-name))
+            (stop #~(make-kill-destructor)))))))
+
+(define webssh-service-type
+  (service-type
+   (name 'webssh)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             webssh-shepherd-service)
+          (service-extension account-service-type
+                             webssh-account)
+          (service-extension activation-service-type
+                             webssh-activation)))
+   (default-value (webssh-configuration))
+   (description
+    "Run the webssh.")))
+
 ;;; ssh.scm ends here
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 20e104f48c..79d88f2b8a 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -23,6 +23,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages package-management)
   #:use-module (gnu packages ssh)
   #:use-module (gnu packages virtualization)
   #:use-module (gnu services base)
@@ -840,8 +841,12 @@ can only be accessed by their host.")))
 that will be listening to receive secret keys on port 1004, TCP."
   (operating-system
     (inherit os)
-    (services (cons (service secret-service-type 1004)
-                    (operating-system-user-services os)))))
+    ;; Arrange so that the secret service activation snippet shows up before
+    ;; the OpenSSH and Guix activation snippets.  That way, we receive OpenSSH
+    ;; and Guix keys before the activation snippets try to generate fresh keys
+    ;; for nothing.
+    (services (append (operating-system-user-services os)
+                      (list (service secret-service-type 1004))))))
 
 
 ;;;
@@ -900,6 +905,7 @@ is added to the OS specified in CONFIG."
     (system-image
      (image
       (inherit hurd-disk-image)
+      (format 'compressed-qcow2)
       (size disk-size)
       (operating-system os)))))
 
@@ -937,13 +943,19 @@ is added to the OS specified in CONFIG."
         (provisions  '(hurd-vm childhurd)))
 
     (define vm-command
-      #~(list
-         (string-append #$qemu "/bin/qemu-system-i386")
-         #$@(if (file-exists? "/dev/kvm") '("--enable-kvm") '())
-         "-m" (number->string #$memory-size)
-         #$@net-options
-         #$@options
-         "--hda" #+image))
+      #~(append (list #$(file-append qemu "/bin/qemu-system-i386")
+                      "-m" (number->string #$memory-size)
+                      #$@net-options
+                      #$@options
+                      "--hda" #+image
+
+                      ;; Cause the service to be respawned if the guest
+                      ;; reboots (it can reboot for instance if it did not
+                      ;; receive valid secrets, or if it crashed.)
+                      "--no-reboot")
+                (if (file-exists? "/dev/kvm")
+                    '("--enable-kvm")
+                    '())))
 
     (list
      (shepherd-service
@@ -959,28 +971,120 @@ is added to the OS specified in CONFIG."
        (with-imported-modules
            (source-module-closure '((gnu build secret-service)
                                     (guix build utils)))
-         #~(let ((spawn (make-forkexec-constructor #$vm-command)))
-             (lambda _
-               (let ((pid (spawn))
-                     (port #$(hurd-vm-port config %hurd-vm-secrets-port))
-                     (root #$(hurd-vm-configuration-secret-root config)))
-                 (catch #t
-                   (lambda _
-                     (secret-service-send-secrets port root))
-                   (lambda (key . args)
-                     (kill (- pid) SIGTERM)
-                     (apply throw key args)))
-                 pid)))))
+         #~(lambda ()
+             (let ((pid  (fork+exec-command #$vm-command
+                                            #:user "childhurd"
+                                            ;; XXX TODO: use "childhurd" after
+                                            ;; updating Shepherd
+                                            #:group "kvm"
+                                            #:environment-variables
+                                            ;; QEMU tries to write to /var/tmp
+                                            ;; by default.
+                                            '("TMPDIR=/tmp")))
+                   (port #$(hurd-vm-port config %hurd-vm-secrets-port))
+                   (root #$(hurd-vm-configuration-secret-root config)))
+               (catch #t
+                 (lambda _
+                   ;; XXX: 'secret-service-send-secrets' won't complete until
+                   ;; the guest has booted and its secret service server is
+                   ;; running, which could take 20+ seconds during which PID 1
+                   ;; is stuck waiting.
+                   (if (secret-service-send-secrets port root)
+                       pid
+                       (begin
+                         (kill (- pid) SIGTERM)
+                         #f)))
+                 (lambda (key . args)
+                   (kill (- pid) SIGTERM)
+                   (apply throw key args)))))))
       (modules `((gnu build secret-service)
                  (guix build utils)
                  ,@%default-modules))
       (stop  #~(make-kill-destructor))))))
 
+(define %hurd-vm-accounts
+  (list (user-group (name "childhurd") (system? #t))
+        (user-account
+         (name "childhurd")
+         (group "childhurd")
+         (supplementary-groups '("kvm"))
+         (comment "Privilege separation user for the childhurd")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin"))
+         (system? #t))))
+
+(define (initialize-hurd-vm-substitutes)
+  "Initialize the Hurd VM's key pair and ACL and store it on the host."
+  (define run
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (ice-9 match))
+
+          (define host-key
+            "/etc/guix/signing-key.pub")
+
+          (define host-acl
+            "/etc/guix/acl")
+
+          (match (command-line)
+            ((_ guest-config-directory)
+             (setenv "GUIX_CONFIGURATION_DIRECTORY"
+                     guest-config-directory)
+             (invoke #+(file-append guix "/bin/guix") "archive"
+                     "--generate-key")
+
+             (when (file-exists? host-acl)
+               ;; Copy the host ACL.
+               (copy-file host-acl
+                          (string-append guest-config-directory
+                                         "/acl")))
+
+             (when (file-exists? host-key)
+               ;; Add the host key to the childhurd's ACL.
+               (let ((key (open-fdes host-key O_RDONLY)))
+                 (close-fdes 0)
+                 (dup2 key 0)
+                 (execl #+(file-append guix "/bin/guix")
+                        "guix" "archive" "--authorize"))))))))
+
+  (program-file "initialize-hurd-vm-substitutes" run))
+
+(define (hurd-vm-activation config)
+  "Return a gexp to activate the Hurd VM according to CONFIG."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (define secret-directory
+          #$(hurd-vm-configuration-secret-root config))
+
+        (define ssh-directory
+          (string-append secret-directory "/etc/ssh"))
+
+        (define guix-directory
+          (string-append secret-directory "/etc/guix"))
+
+        (unless (file-exists? ssh-directory)
+          ;; Generate SSH host keys under SSH-DIRECTORY.
+          (mkdir-p ssh-directory)
+          (invoke #$(file-append openssh "/bin/ssh-keygen")
+                  "-A" "-f" secret-directory))
+
+        (unless (file-exists? guix-directory)
+          (invoke #$(initialize-hurd-vm-substitutes)
+                  guix-directory)))))
+
 (define hurd-vm-service-type
   (service-type
    (name 'hurd-vm)
    (extensions (list (service-extension shepherd-root-service-type
-                                        hurd-vm-shepherd-service)))
+                                        hurd-vm-shepherd-service)
+                     (service-extension account-service-type
+                                        (const %hurd-vm-accounts))
+                     (service-extension activation-service-type
+                                        hurd-vm-activation)))
    (default-value (hurd-vm-configuration))
    (description
-    "Provide a Virtual Machine running the GNU/Hurd.")))
+    "Provide a virtual machine (VM) running GNU/Hurd, also known as a
+@dfn{childhurd}.")))