Merge branch 'master' into wip-pinebook-pro

23 files changed, 370 insertions, 162 deletions

diff --git a/gnu/installer/connman.scm b/gnu/installer/connman.scm
index 386f431ced..2f33b58453 100644
--- a/gnu/installer/connman.scm
+++ b/gnu/installer/connman.scm
@@ -180,7 +180,7 @@ Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2)
 (define (connman-state)
   "Return the state of connman. The nominal states are 'offline, 'idle,
 'ready, 'oneline.  If an unexpected state is read, 'unknown is
-returned. Finally, an error is raised if the comman output could not be
+returned. Finally, an error is raised if the connman output could not be
 parsed, usually because the connman daemon is not responding."
   (let* ((output (connman "state"))
          (state-keys (parse-keys output)))
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index 685aa81d89..fc0b7803fa 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -26,6 +26,8 @@
   #:use-module (guix build syscalls)
   #:use-module (guix build utils)
   #:use-module (gnu build accounts)
+  #:use-module (gnu build install)
+  #:use-module (gnu build linux-container)
   #:use-module ((gnu system shadow) #:prefix sys:)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
@@ -133,49 +135,32 @@ USERS."
                        (_ #f))))))
               pids)))
 
-(define (umount-cow-store)
-  "Remove the store overlay and the bind-mount on /tmp created by the
-cow-store service.  This procedure is very fragile and a better approach would
-be much appreciated."
-  (catch #t
-    (lambda ()
-      (let ((tmp-dir "/remove"))
-        (syslog "Unmounting cow-store.~%")
-
-        (mkdir-p tmp-dir)
-        (mount (%store-directory) tmp-dir "" MS_MOVE)
-
-        ;; The guix-daemon has possibly opened files from the cow-store,
-        ;; restart it.
-        (restart-service 'guix-daemon)
-
-        (syslog "Killing cow users.")
-
-        ;; Kill all processes started while the cow-store was active (logins
-        ;; on other TTYs for instance).
-        (kill-cow-users tmp-dir)
-
-        ;; Try to umount the store overlay. Some process such as udevd
-        ;; workers might still be active, so do some retries.
-        (let loop ((try 5))
-          (syslog "Umount try ~a~%" (- 5 try))
-          (sleep 1)
-          (let ((umounted? (false-if-exception (umount tmp-dir))))
-            (if (and (not umounted?) (> try 0))
-                (loop (- try 1))
-                (if umounted?
-                    (syslog "Umounted ~a successfully.~%" tmp-dir)
-                    (syslog "Failed to umount ~a.~%" tmp-dir)))))
-
-        (umount "/tmp")))
-    (lambda args
-      (syslog "~a~%" args))))
+(define (call-with-mnt-container thunk)
+  "This is a variant of call-with-container. Run THUNK in a new container
+process, within a separate MNT namespace. The container is not jailed so that
+it can interact with the rest of the system."
+  (let ((pid (run-container "/" '() '(mnt) 1 thunk)))
+    ;; Catch SIGINT and kill the container process.
+    (sigaction SIGINT
+      (lambda (signum)
+        (false-if-exception
+         (kill pid SIGKILL))))
+
+    (match (waitpid pid)
+      ((_ . status) status))))
 
 (define* (install-system locale #:key (users '()))
   "Create /etc/shadow and /etc/passwd on the installation target for USERS.
 Start COW-STORE service on target directory and launch guix install command in
 a subshell.  LOCALE must be the locale name under which that command will run,
 or #f.  Return #t on success and #f on failure."
+  (define backing-directory
+    ;; Sub-directory used as the backing store for copy-on-write.
+    "/tmp/guix-inst")
+
+  (define (assert-exit x)
+    (primitive-exit (if x 0 1)))
+
   (let* ((options         (catch 'system-error
                             (lambda ()
                               ;; If this file exists, it can provide
@@ -188,7 +173,11 @@ or #f.  Return #t on success and #f on failure."
                                         "--fallback")
                                   options
                                   (list (%installer-configuration-file)
-                                        (%installer-target-dir)))))
+                                        (%installer-target-dir))))
+         (database-dir    "/var/guix/db")
+         (database-file   (string-append database-dir "/db.sqlite"))
+         (saved-database  (string-append database-dir "/db.save"))
+         (ret             #f))
     (mkdir-p (%installer-target-dir))
 
     ;; We want to initialize user passwords but we don't want to store them in
@@ -198,27 +187,49 @@ or #f.  Return #t on success and #f on failure."
     ;; passwords that we've put in there.
     (create-user-database users (%installer-target-dir))
 
-    (dynamic-wind
-      (lambda ()
-        (start-service 'cow-store (list (%installer-target-dir))))
-      (lambda ()
-        ;; If there are any connected clients, assume that we are running
-        ;; installation tests. In that case, dump the standard and error
-        ;; outputs to syslog.
-        (if (not (null? (current-clients)))
-            (with-output-to-file "/dev/console"
-              (lambda ()
-                (with-error-to-file "/dev/console"
-                  (lambda ()
-                    (setvbuf (current-output-port) 'none)
-                    (setvbuf (current-error-port) 'none)
-                    (run-command install-command #:locale locale)))))
-            (run-command install-command #:locale locale)))
-      (lambda ()
-        (stop-service 'cow-store)
-        ;; Remove the store overlay created at cow-store service start.
-        ;; Failing to do that will result in further umount calls to fail
-        ;; because the target device is seen as busy. See:
-        ;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
-        (umount-cow-store)
-        #f))))
+    ;; When the store overlay is mounted, other processes such as kmscon, udev
+    ;; and guix-daemon may open files from the store, preventing the
+    ;; underlying install support from being umounted. See:
+    ;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
+    ;;
+    ;; To avoid this situation, mount the store overlay inside a container,
+    ;; and run the installation from within that container.
+    (zero?
+     (call-with-mnt-container
+       (lambda ()
+         (dynamic-wind
+           (lambda ()
+             ;; Save the database, so that it can be restored once the
+             ;; cow-store is umounted.
+             (copy-file database-file saved-database)
+             (mount-cow-store (%installer-target-dir) backing-directory))
+           (lambda ()
+             ;; We need to drag the guix-daemon to the container MNT
+             ;; namespace, so that it can operate on the cow-store.
+             (stop-service 'guix-daemon)
+             (start-service 'guix-daemon (list (number->string (getpid))))
+
+             (setvbuf (current-output-port) 'none)
+             (setvbuf (current-error-port) 'none)
+
+             ;; If there are any connected clients, assume that we are running
+             ;; installation tests. In that case, dump the standard and error
+             ;; outputs to syslog.
+             (set! ret
+                   (if (not (null? (current-clients)))
+                       (with-output-to-file "/dev/console"
+                         (lambda ()
+                           (with-error-to-file "/dev/console"
+                             (lambda ()
+                               (run-command install-command
+                                            #:locale locale)))))
+                       (run-command install-command #:locale locale))))
+           (lambda ()
+             ;; Restart guix-daemon so that it does no keep the MNT namespace
+             ;; alive.
+             (restart-service 'guix-daemon)
+             (copy-file saved-database database-file)
+
+             ;; Finally umount the cow-store and exit the container.
+             (unmount-cow-store (%installer-target-dir) backing-directory)
+             (assert-exit ret))))))))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index a24a152984..4f7fc6f4dc 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -30,6 +30,7 @@
   #:use-module (gnu installer newt page)
   #:use-module (gnu installer newt partition)
   #:use-module (gnu installer newt services)
+  #:use-module (gnu installer newt substitutes)
   #:use-module (gnu installer newt timezone)
   #:use-module (gnu installer newt user)
   #:use-module (gnu installer newt utils)
@@ -46,6 +47,7 @@
   (newt-init)
   (clear-screen)
   (set-screen-size!)
+  (syslog "Display is ~ax~a.~%" (screen-columns) (screen-rows))
   (push-help-line
    (format #f (G_ "Press <F1> for installation parameters."))))
 
@@ -100,6 +102,9 @@ problem. The backtrace is displayed below. Please report it by email to \
 (define (network-page)
   (run-network-page))
 
+(define (substitutes-page)
+  (run-substitutes-page))
+
 (define (hostname-page)
   (run-hostname-page))
 
@@ -107,7 +112,7 @@ problem. The backtrace is displayed below. Please report it by email to \
   (run-user-page))
 
 (define (partition-page)
-  (run-partioning-page))
+  (run-partitioning-page))
 
 (define (services-page)
   (run-services-page))
@@ -129,6 +134,7 @@ problem. The backtrace is displayed below. Please report it by email to \
    (locale-page locale-page)
    (menu-page menu-page)
    (network-page network-page)
+   (substitutes-page substitutes-page)
    (timezone-page timezone-page)
    (hostname-page hostname-page)
    (user-page user-page)
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index ba5e222a37..ecd22efbb2 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -77,7 +77,7 @@ connection is pending."
       #:title (G_ "Ethernet connection")
       #:listbox-items services
       #:listbox-item->text ethernet-service->text
-      #:listbox-height (min (+ (length services) 2) 10)
+      #:listbox-height (min (+ (length services) 2) 5)
       #:button-text (G_ "Exit")
       #:button-callback-procedure
       (lambda _
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index fa8d6fea71..7f6dd9f075 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -29,6 +29,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
+  #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (newt)
   #:export (run-final-page))
 
@@ -39,9 +40,8 @@
       file))
 
 (define* (run-config-display-page #:key locale)
-  (let ((width (%configuration-file-width))
-        (height (nearest-exact-integer
-                 (/ (screen-rows) 2))))
+  (let ((width (max 70 (- (screen-columns) 20)))
+        (height (default-listbox-height)))
     (run-file-textbox-page
      #:info-text (format #f (G_ "\
 We're now ready to proceed with the installation! \
@@ -102,18 +102,24 @@ a specific step, or restart the installer."))
                             #:key (users '()))
   (clear-screen)
   (newt-suspend)
-  ;; XXX: Force loading 'bold' font files before mouting the
-  ;; cow-store. Otherwise, if the file is loaded by kmscon after the cow-store
-  ;; in mounted, it will be necessary to kill kmscon to umount to cow-store.
-  (display
-   (colorize-string
-    (format #f (G_ "Installing Guix System ...~%"))
-    (color BOLD)))
   (let ((install-ok? (install-system locale #:users users)))
     (newt-resume)
     install-ok?))
 
 (define (run-final-page result prev-steps)
+  (define (wait-for-clients)
+    (unless (null? (current-clients))
+      (syslog "waiting with clients before starting final step~%")
+      (send-to-clients '(starting-final-step))
+      (match (select (current-clients) '() '())
+        (((port _ ...) _ _)
+         (read-line port)))))
+
+  ;; Before generating the configuration file, give clients a chance to do
+  ;; things such as changing the swap partition label.
+  (wait-for-clients)
+
+  (syslog "proceeding with final step~%")
   (let* ((configuration   (format-configuration prev-steps result))
          (user-partitions (result-step result 'partition))
          (locale          (result-step result 'locale))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 1b3af2f158..92f7f46f34 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -56,7 +56,7 @@ different layout at any time from the parameters menu.")))
        (else (G_ "Exit")))
      #:button-callback-procedure
      (case context
-       ((param) (const #t))
+       ((param) (const #f))
        (else
         (lambda _
           (raise
@@ -183,7 +183,9 @@ options."
       (compute
        (lambda (result _)
          (let* ((layout (result-step result 'layout))
-                (variants (x11-keymap-layout-variants layout)))
+                (variants (if layout
+                              (x11-keymap-layout-variants layout)
+                              '())))
            ;; Return #f if the layout does not have any variant.
            (and (not (null? variants))
                 (run-variant-page
@@ -196,16 +198,19 @@ options."
                        (gettext (x11-keymap-layout-description layout)
                                 "xkeyboard-config")))))))))))
 
-  (define (format-result result)
-    (let ((layout (x11-keymap-layout-name
-                   (result-step result 'layout)))
-          (variant (and=> (result-step result 'variant)
+  (define (format-result layout variant)
+    (let ((layout (x11-keymap-layout-name layout))
+          (variant (and=> variant
                           (lambda (variant)
                             (gettext (x11-keymap-variant-name variant)
                                      "xkeyboard-config")))))
       (toggleable-latin-layout layout variant)))
-  (format-result
-   (run-installer-steps #:steps keymap-steps)))
+
+  (let* ((result (run-installer-steps #:steps keymap-steps))
+         (layout (result-step result 'layout))
+         (variant (result-step result 'variant)))
+    (and layout
+         (format-result layout variant))))
 
 (define (keyboard-layout->configuration keymap)
   "Return the operating system configuration snippet to install KEYMAP."
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 7108e2960b..bfd89aca2c 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -106,7 +106,7 @@ symbol.")
 territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
 available locales. ISO639-LANGUAGES is an association list associating a
 locale code to a locale name. ISO3166-TERRITORIES is an association list
-associating a territory code with a territory name. The formated locale, under
+associating a territory code with a territory name. The formatted locale, under
 glibc format is returned."
 
   (define (break-on-locale-found locales)
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index 461d5d99c0..4af7143d63 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -80,7 +80,7 @@ network devices were found. Do you want to continue anyway?"))
       #:title (G_ "Internet access")
       #:listbox-items items
       #:listbox-item->text technology->text
-      #:listbox-height (min (+ (length items) 2) 10)
+      #:listbox-height (min (+ (length items) 2) 5)
       #:button-text (G_ "Exit")
       #:button-callback-procedure
       (lambda _
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 1d6b9979b4..4209674c28 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -32,7 +32,9 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (newt)
-  #:export (draw-info-page
+  #:export (default-listbox-height
+
+            draw-info-page
             draw-connecting-page
             run-input-page
             run-error-page
@@ -168,6 +170,10 @@ Like 'run-form', return two values: the exit reason, and an \"argument\"."
         (_
          (values reason argument))))))
 
+(define (default-listbox-height)
+  "Return the default listbox height."
+  (max 5 (- (screen-rows) 20)))
+
 (define (draw-info-page text title)
   "Draw an informative page with the given TEXT as content.  Set the title of
 this page to TITLE."
@@ -339,7 +345,8 @@ of the page is set to TITLE."
                                      (info-textbox-width 50)
                                      listbox-items
                                      listbox-item->text
-                                     (listbox-height 20)
+                                     (listbox-height
+                                      (default-listbox-height))
                                      (listbox-default-item #f)
                                      (listbox-allow-multiple? #f)
                                      (sort-listbox-items? #t)
diff --git a/gnu/installer/newt/parameters.scm b/gnu/installer/newt/parameters.scm
index 95112b5780..8fb1aa3abb 100644
--- a/gnu/installer/newt/parameters.scm
+++ b/gnu/installer/newt/parameters.scm
@@ -20,6 +20,7 @@
   #:use-module (gnu installer proxy)
   #:use-module (gnu installer steps)
   #:use-module (gnu installer newt page)
+  #:use-module (guix build syscalls)
   #:use-module (guix i18n)
   #:use-module (ice-9 match)
   #:use-module (newt)
@@ -40,7 +41,8 @@ empty string, proxy usage will be disabled.")
   (let* ((items
           (list
            (cons (G_ "Change keyboard layout") keyboard-layout-selection)
-           (cons (G_ "Configure HTTP proxy") run-proxy-page)))
+           (cons (G_ "Configure HTTP proxy") run-proxy-page)
+           (cons (G_ "Reboot") reboot)))
          (result
           (run-listbox-selection-page
            #:info-text (G_ "Please choose one of the following parameters or \
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 54d595f54e..81cf68d782 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -25,6 +25,7 @@
   #:use-module (gnu installer newt page)
   #:use-module (gnu installer newt utils)
   #:use-module (guix i18n)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -32,7 +33,7 @@
   #:use-module (srfi srfi-35)
   #:use-module (newt)
   #:use-module (parted)
-  #:export (run-partioning-page))
+  #:export (run-partitioning-page))
 
 (define (button-exit-action)
   "Raise the &installer-step-abort condition."
@@ -56,11 +57,17 @@
                   #:button-callback-procedure button-exit-action)))
     (car result)))
 
-(define (draw-formatting-page)
+(define (draw-formatting-page partitions)
   "Draw a page asking for confirmation, and then indicating that partitions
 are being formatted."
-  (run-confirmation-page (G_ "We are about to format your hard disk.  All \
-its data will be lost.  Do you wish to continue?")
+  ;; TRANSLATORS: The ~{ and ~} format specifiers are used to iterate the list
+  ;; of device names of the user partitions that will be formatted.
+  (run-confirmation-page (format #f (G_ "We are about to write the configured \
+partition table to the disk and format the partitions listed below.  Their \
+data will be lost.  Do you wish to continue?~%~%~{ - ~a~%~}")
+                                 (map user-partition-file-name
+                                      (filter user-partition-need-formatting?
+                                              partitions)))
                          (G_ "Format disk?")
                          #:exit-button-procedure button-exit-action)
   (draw-info-page
@@ -674,7 +681,7 @@ by pressing the Exit button.~%~%")))
                       (G_ "Guided partitioning")
                       (G_ "Manual partitioning"))
           #:info-textbox-width 76         ;we need a lot of room for INFO-TEXT
-          #:listbox-height 12
+          #:listbox-height (max 5 (- (screen-rows) 30))
           #:listbox-items (disk-items)
           #:listbox-item->text cdr
           #:sort-listbox-items? #f
@@ -725,7 +732,7 @@ by pressing the Exit button.~%~%")))
           (run-disk-page result-disks new-user-partitions
                          #:guided? guided?)))))
 
-(define (run-partioning-page)
+(define (run-partitioning-page)
   "Run a page asking the user for a partitioning method."
   (define (run-page devices)
     (let* ((items
@@ -773,9 +780,12 @@ by pressing the Exit button.~%~%")))
          (user-partitions (run-page non-install-devices))
          (user-partitions-with-pass (prompt-luks-passwords
                                      user-partitions))
-         (form (draw-formatting-page)))
+         (form (draw-formatting-page user-partitions)))
     ;; Make sure the disks are not in use before proceeding to formatting.
     (free-parted non-install-devices)
     (format-user-partitions user-partitions-with-pass)
+    (syslog "formatted ~a user partitions~%"
+            (length user-partitions-with-pass))
+
     (destroy-form-and-pop form)
     user-partitions))
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index 4f32d9077b..ae249ba972 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,7 +41,7 @@ choose the one to use on the log-in screen.")
      #:items items
      #:selection (map system-service-recommended? items)
      #:item->text system-service-name             ;no i18n for DE names
-     #:checkbox-tree-height 8
+     #:checkbox-tree-height 9
      #:exit-button-callback-procedure
      (lambda ()
        (raise
@@ -76,6 +77,7 @@ system.")
 We recommend NetworkManager or Connman for a WiFi-capable laptop; the DHCP \
 client may be enough for a server.")
      #:info-textbox-width 70
+     #:listbox-height 7
      #:listbox-items (filter (lambda (service)
                                (eq? 'network-management
                                     (system-service-type service)))
diff --git a/gnu/installer/newt/substitutes.scm b/gnu/installer/newt/substitutes.scm
new file mode 100644
index 0000000000..938cb1a53b
--- /dev/null
+++ b/gnu/installer/newt/substitutes.scm
@@ -0,0 +1,43 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <othacehe@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 installer newt substitutes)
+  #:use-module (gnu installer substitutes)
+  #:use-module (gnu installer utils)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:use-module (ice-9 match)
+  #:export (run-substitutes-page))
+
+(define* (run-substitutes-page)
+  (match (current-clients)
+    (()
+     (case (choice-window
+            (G_ "Substitute server discovery.")
+            (G_ "Enable") (G_ "Disable")
+            (G_ " By turning this option on, you allow Guix to fetch \
+substitutes (pre-built binaries) during installation from servers \
+discovered on your local area network (LAN) in addition to the official \
+server.  This can increase download throughput.
+
+ There are no security risks: only genuine substitutes may be retrieved from \
+those servers.  However, eavesdroppers on your LAN may be able to see what \
+software you are installing."))
+       ((1) (enable-discovery))
+       ((2) (disable-discovery))))
+    (_ #f)))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 1b4b2df816..5f461279e2 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -38,6 +38,9 @@
 (define info-textbox-width (make-parameter 70))
 (define options-listbox-height (make-parameter 5))
 
+(define (display-logo?)
+  (> (screen-rows) 35))
+
 (define* (run-menu-page title info-text logo
                         #:key
                         listbox-items
@@ -55,7 +58,10 @@ we want this page to occupy all the screen space available."
          items))
 
   (let* ((logo-textbox
-          (make-textbox -1 -1 (logo-width) (logo-height) 0))
+          (make-textbox -1 -1
+                        (if (display-logo?) (logo-width) 0)
+                        (if (display-logo?) (logo-height) 0)
+                        0))
          (info-textbox
           (make-reflowed-textbox -1 -1
                                  info-text
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
index 3fd5756b99..f5d8f1fdbf 100644
--- a/gnu/installer/newt/wifi.scm
+++ b/gnu/installer/newt/wifi.scm
@@ -165,7 +165,8 @@ of <service-item> records present in LISTBOX."
 (define service-name-max-length (make-parameter 20))
 
 ;; Height of the listbox displaying wifi services.
-(define wifi-listbox-height (make-parameter 20))
+(define wifi-listbox-height (make-parameter
+                             (default-listbox-height)))
 
 ;; Information textbox width.
 (define info-textbox-width (make-parameter 40))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index ff5f6afd19..9ef263d1f9 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -36,10 +36,12 @@
   #:use-module (guix utils)
   #:use-module (guix i18n)
   #:use-module (parted)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -317,7 +319,7 @@ PARTED-OBJECT field equals PARTITION, return #f if not found."
 fail. See rereadpt function in wipefs.c of util-linux for an explanation."
   ;; Kernel always return EINVAL for BLKRRPART on loopdevices.
   (and (not (string-match "/dev/loop*" file-name))
-       (let loop ((try 4))
+       (let loop ((try 16))
          (usleep 250000)
          (let ((in-use? (device-in-use? file-name)))
            (if (and in-use? (> try 0))
@@ -338,15 +340,12 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
 (define (non-install-devices)
   "Return all the available devices, except the busy one, allegedly the
 install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
-mounted. The install image uses an overlayfs so the install device does not
-appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE?
-from (guix build syscalls) module, who will try to re-read the device's
-partition table to determine whether or not it is already used (like sfdisk
-from util-linux)."
+mounted."
+  ;; FIXME: The install image uses an overlayfs so the install device does not
+  ;; appear as mounted and won't be considered as busy.
   (remove (lambda (device)
             (let ((file-name (device-path device)))
-              (or (device-is-busy? device)
-                  (with-delay-device-in-use? file-name))))
+              (device-is-busy? device)))
           (devices)))
 
 
@@ -526,56 +525,54 @@ determined by MAX-LENGTH-COLUMN procedure."
          (size (user-partition-size user-partition))
          (mount-point (user-partition-mount-point user-partition)))
     `(,@(if has-name?
-            `((name . ,(string-append "Name: " (or name "None"))))
+            `((name . ,(format #f (G_ "Name: ~a")
+                               (or name (G_ "None")))))
             '())
       ,@(if (and has-extended?
                  (freespace-partition? partition)
                  (not (eq? type 'logical)))
-            `((type . ,(string-append "Type: " type-name)))
+            `((type . ,(format #f (G_ "Type: ~a") type-name)))
             '())
       ,@(if (eq? type 'extended)
             '()
-            `((fs-type . ,(string-append "Filesystem type: " fs-type-name))))
+            `((fs-type . ,(format #f (G_ "File system type: ~a")
+                                  fs-type-name))))
       ,@(if (or (eq? type 'extended)
                 (eq? fs-type 'swap)
                 (not has-extended?))
             '()
-            `((bootable . ,(string-append "Bootable flag: "
-                                          (if bootable? "On" "Off")))))
+            `((bootable . ,(format #f (G_ "Bootable flag: ~:[off~;on~]")
+                                   bootable?))))
       ,@(if (and (not has-extended?)
                  (not (eq? fs-type 'swap)))
-            `((esp? . ,(string-append "ESP flag: "
-                                      (if esp? "On" "Off"))))
+            `((esp? . ,(format #f (G_ "ESP flag: ~:[off~;on~]") esp?)))
             '())
       ,@(if (freespace-partition? partition)
             (let ((size-formatted
-                   (or size (unit-format device
+                   (or size (unit-format device   ;XXX: i18n
                                          (partition-length partition)))))
-              `((size . ,(string-append "Size : " size-formatted))))
+              `((size . ,(format #f (G_ "Size: ~a") size-formatted))))
             '())
       ,@(if (or (eq? type 'extended)
                 (eq? fs-type 'swap))
             '()
             `((crypt-label
-               . ,(string-append
-                   "Encryption: "
-                   (if crypt-label
-                       (format #f "Yes (label ~a)" crypt-label)
-                       "No")))))
+               . ,(format #f (G_ "Encryption: ~:[No~a~;Yes (label '~a')~]")
+                          crypt-label (or crypt-label "")))))
       ,@(if (or (freespace-partition? partition)
                 (eq? fs-type 'swap))
             '()
             `((need-formatting?
-               . ,(string-append "Format the partition? : "
-                                 (if need-formatting? "Yes" "No")))))
+               . ,(format #f (G_ "Format the partition? ~:[No~;Yes~]")
+                          need-formatting?))))
       ,@(if (or (eq? type 'extended)
                 (eq? fs-type 'swap))
             '()
             `((mount-point
-               . ,(string-append "Mount point : "
-                                 (or mount-point
-                                     (and esp? (default-esp-mount-point))
-                                     "None"))))))))
+               . ,(format #f (G_ "Mount point: ~a")
+                          (or mount-point
+                              (and esp? (default-esp-mount-point))
+                              (G_ "None")))))))))
 
 
 ;;
@@ -759,11 +756,33 @@ cause them to cross."
                                                       dev-constraint))
               (no-constraint (constraint-any device))
               ;; Try to create a partition with an optimal alignment
-              ;; constraint. If it fails, fallback to creating a partition with
-              ;; no specific constraint.
+              ;; constraint. If it fails, fallback to creating a partition
+              ;; with no specific constraint.
+              (partition-constraint-ok?
+               (disk-add-partition disk partition final-constraint))
+              (partition-no-contraint-ok?
+               (or partition-constraint-ok?
+                   (disk-add-partition disk partition no-constraint)))
               (partition-ok?
-               (or (disk-add-partition disk partition final-constraint)
-                   (disk-add-partition disk partition no-constraint))))
+               (or partition-constraint-ok? partition-no-contraint-ok?)))
+         (syslog "Creating partition:
+~/type: ~a
+~/filesystem-type: ~a
+~/start: ~a
+~/end: ~a
+~/start-range: [~a, ~a]
+~/end-range: [~a, ~a]
+~/constraint: ~a
+~/no-constraint: ~a
+"
+                 partition-type
+                 (filesystem-type-name filesystem-type)
+                 start-sector*
+                 end-sector
+                 (geometry-start start-range) (geometry-end start-range)
+                 (geometry-start end-range) (geometry-end end-range)
+                 partition-constraint-ok?
+                 partition-no-contraint-ok?)
          ;; Set the partition name if supported.
          (when (and partition-ok? has-name? name)
            (partition-set-name partition name))
@@ -911,13 +930,13 @@ exists."
 
     (let* ((start-partition
             (and (not has-extended?)
-                 (not esp-partition)
                  (if (efi-installation?)
-                     (user-partition
-                      (fs-type 'fat32)
-                      (esp? #t)
-                      (size new-esp-size)
-                      (mount-point (default-esp-mount-point)))
+                     (and (not esp-partition)
+                          (user-partition
+                           (fs-type 'fat32)
+                           (esp? #t)
+                           (size new-esp-size)
+                           (mount-point (default-esp-mount-point))))
                      (user-partition
                       (fs-type 'ext4)
                       (bootable? #t)
@@ -1201,13 +1220,13 @@ the FS-TYPE field set to 'swap, return the empty list if none found."
           user-partitions))
 
 (define (start-swapping user-partitions)
-  "Start swaping on <user-partition> records with FS-TYPE equal to 'swap."
+  "Start swapping on <user-partition> records with FS-TYPE equal to 'swap."
   (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
          (swap-devices (map user-partition-file-name swap-user-partitions)))
     (for-each swapon swap-devices)))
 
 (define (stop-swapping user-partitions)
-  "Stop swaping on <user-partition> records with FS-TYPE equal to 'swap."
+  "Stop swapping on <user-partition> records with FS-TYPE equal to 'swap."
   (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
          (swap-devices (map user-partition-file-name swap-user-partitions)))
     (for-each swapoff swap-devices)))
@@ -1327,7 +1346,12 @@ USER-PARTITIONS, or return nothing."
       ,@(initrd-configuration user-partitions)
       ,@(if (null? swap-devices)
             '()
-            `((swap-devices (list ,@swap-devices))))
+            (let* ((uuids (map (lambda (file)
+                                 (uuid->string (read-partition-uuid file)))
+                               swap-devices)))
+              `((swap-devices (list ,@(map (lambda (uuid)
+                                             `(uuid ,uuid))
+                                           uuids))))))
       ,@(if (null? encrypted-partitions)
             '()
             `((mapped-devices
@@ -1364,9 +1388,12 @@ the devices not to be used before returning."
   (let ((device-file-names (map device-path devices)))
     (for-each force-device-sync devices)
     (for-each (lambda (file-name)
-                (let ((in-use? (with-delay-device-in-use? file-name)))
-                  (and in-use?
-                       (error
-                        (format #f (G_ "Device ~a is still in use.")
-                                file-name)))))
+                (let/time ((time in-use?
+                                 (with-delay-device-in-use? file-name)))
+                  (if in-use?
+                      (error
+                       (format #f (G_ "Device ~a is still in use.")
+                               file-name))
+                      (syslog "Syncing ~a took ~a seconds.~%"
+                              file-name (time-second time)))))
               device-file-names)))
diff --git a/gnu/installer/proxy.scm b/gnu/installer/proxy.scm
index befaf3ab0a..86c827294e 100644
--- a/gnu/installer/proxy.scm
+++ b/gnu/installer/proxy.scm
@@ -17,15 +17,11 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu installer proxy)
+  #:use-module (gnu installer utils)
   #:use-module (gnu services herd)
   #:export (set-http-proxy
             clear-http-proxy))
 
-(define-syntax-rule (with-silent-shepherd exp ...)
-  (parameterize ((shepherd-message-port
-                  (%make-void-port "w")))
-    exp ...))
-
 (define (set-http-proxy proxy)
   (with-silent-shepherd
     (with-shepherd-action 'guix-daemon
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 6ebd87f6a6..0b34318c45 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -33,6 +33,7 @@
             installer-locale-page
             installer-menu-page
             installer-network-page
+            installer-substitutes-page
             installer-timezone-page
             installer-hostname-page
             installer-user-page
@@ -73,6 +74,8 @@
   (menu-page installer-menu-page)
   ;; procedure void -> void
   (network-page installer-network-page)
+  ;; procedure void -> void
+  (substitutes-page installer-substitutes-page)
   ;; procedure (zonetab) -> posix-timezone
   (timezone-page installer-timezone-page)
   ;; procedure void -> void
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index dbac79196d..ec5ea30594 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -82,6 +83,11 @@
       (name "ratpoison")
       (packages '((specification->package "ratpoison")
                   (specification->package "xterm"))))
+     (desktop-environment
+      (name "Emacs EXWM")
+      (packages '((specification->package "emacs")
+                  (specification->package "emacs-exwm")
+                  (specification->package "emacs-desktop-environment"))))
 
      ;; Networking.
      (system-service
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 0b6d8e4649..fdcfb0cb4d 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -50,7 +50,6 @@
 
             %installer-configuration-file
             %installer-target-dir
-            %configuration-file-width
             format-configuration
             configuration->file))
 
@@ -88,7 +87,7 @@
                               (rewind-strategy 'previous)
                               (menu-proc (const #f)))
   "Run the COMPUTE procedure of all <installer-step> records in STEPS
-sequencially. If the &installer-step-abort condition is raised, fallback to a
+sequentially.  If the &installer-step-abort condition is raised, fallback to a
 previous install-step, accordingly to the specified REWIND-STRATEGY.
 
 REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
@@ -218,7 +217,6 @@ stored in RESULTS. Return #f otherwise."
 
 (define %installer-configuration-file (make-parameter "/mnt/etc/config.scm"))
 (define %installer-target-dir (make-parameter "/mnt"))
-(define %configuration-file-width (make-parameter 79))
 
 (define (format-configuration steps results)
   "Return the list resulting from the application of the procedure defined in
diff --git a/gnu/installer/substitutes.scm b/gnu/installer/substitutes.scm
new file mode 100644
index 0000000000..c9a7418f89
--- /dev/null
+++ b/gnu/installer/substitutes.scm
@@ -0,0 +1,41 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer substitutes)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu services herd)
+  #:export (enable-discovery
+            disable-discovery))
+
+(define (enable-discovery)
+  (with-silent-shepherd
+    (with-shepherd-action 'guix-daemon
+        ('discover "on")
+        result
+      result)))
+
+(define (disable-discovery)
+  (with-silent-shepherd
+    (with-shepherd-action 'guix-daemon
+        ('discover "off")
+        result
+      result)))
+
+;; Local Variables:
+;; eval: (put 'with-silent-shepherd 'scheme-indent-function 0)
+;; End:
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 58bf0a2700..f318546a2f 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -286,8 +286,9 @@ instrumented for further testing."
                                edit-configuration-file))
   "Converse over PORT to choose the partitioning method.  When ENCRYPTED? is
 true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
-This conversation goes past the final dialog box that shows the configuration
-file, actually starting the installation process."
+This conversation stops when the user partitions have been formatted, right
+before the installer generates the configuration file and shows it in a dialog
+box."
   (converse port
     ((list-selection (title "Partitioning method")
                      (multiple-choices? #f)
@@ -330,15 +331,29 @@ file, actually starting the installation process."
      #t)
     ((info (title "Preparing partitions") _ ...)
      (values))                                    ;nothing to return
-    ((file-dialog (title "Configuration file")
-                  (text _)
-                  (file ,configuration-file))
-     (edit-configuration-file configuration-file))))
+    ((starting-final-step)
+     ;; Do not return anything.  The reply will be sent by
+     ;; 'conclude-installation' and in the meantime the installer just waits
+     ;; for us, giving us a chance to do things such as changing partition
+     ;; UUIDs before it generates the configuration file.
+     (values))))
 
 (define (conclude-installation port)
-  "Conclude the installation by checking over PORT that we get the final
-messages once the 'guix system init' process has completed."
+  "Conclude the installation by checking over PORT that we get the generated
+configuration file, accepting it and starting the installation, and then
+receiving the final messages once the 'guix system init' process has
+completed."
+  ;; Assume the previous message received was 'starting-final-step'; here we
+  ;; send the reply to that message, which lets the installer continue.
+  (write #t port)
+  (newline port)
+  (force-output port)
+
   (converse port
+    ((file-dialog (title "Configuration file")
+                  (text _)
+                  (file ,configuration-file))
+     (edit-configuration-file configuration-file))
     ((pause)                                      ;"Press Enter to continue."
      #t)
     ((installation-complete)                      ;congratulations!
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 5f8fe8ca01..bb97bc5560 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -18,10 +18,12 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu installer utils)
+  #:use-module (gnu services herd)
   #:use-module (guix utils)
   #:use-module (guix build utils)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -36,11 +38,15 @@
 
             syslog-port
             syslog
+            call-with-time
+            let/time
 
             with-server-socket
             current-server-socket
             current-clients
-            send-to-clients))
+            send-to-clients
+
+            with-silent-shepherd))
 
 (define* (read-lines #:optional (port (current-input-port)))
   "Read lines from PORT and return them as a list."
@@ -117,6 +123,17 @@ COMMAND exited successfully, #f otherwise."
 ;;; Logging.
 ;;;
 
+(define (call-with-time thunk kont)
+  "Call THUNK and pass KONT the elapsed time followed by THUNK's return
+values."
+  (let* ((start  (current-time time-monotonic))
+         (result (call-with-values thunk list))
+         (end    (current-time time-monotonic)))
+    (apply kont (time-difference end start) result)))
+
+(define-syntax-rule (let/time ((time result exp)) body ...)
+  (call-with-time (lambda () exp) (lambda (time result) body ...)))
+
 (define (open-syslog-port)
   "Return an open port (a socket) to /dev/log or #f if that wasn't possible."
   (let ((sock (socket AF_UNIX SOCK_DGRAM 0)))
@@ -219,3 +236,9 @@ accepting socket."
 
   (current-clients (reverse remainder))
   exp)
+
+(define-syntax-rule (with-silent-shepherd exp ...)
+  "Evaluate EXP while discarding shepherd messages."
+  (parameterize ((shepherd-message-port
+                  (%make-void-port "w")))
+    exp ...))