Merge branch 'version-1.5.0'

Change-Id: I5a36bbdb772c88f71fbe612cf6c445c34088e35c

9 files changed, 338 insertions, 118 deletions

diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index d68fb29e05..53c75839ba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -428,7 +428,11 @@ GRUB configuration and OS-DRV as the stuff in it."
                    "-not" "-wholename" "/System/*"
                    "-not" "-name" "unicode.pf2"
                    "-not" "-name" "bzImage"
-                   "-not" "-name" "*.gz"   ; initrd & all man pages
+                   "-not" "-name" "zImage"
+                   "-not" "-name" "Image"
+                   "-not" "-name" "vmlinuz"
+                   "-not" "-name" "*.gz"   ; initrd
+                   "-not" "-name" "*.zst"  ; all man pages
                    "-not" "-name" "*.png"  ; includes grub-image.png
                    "-exec" "set_filter" "--zisofs"
                    "--")
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 4acad60f21..adc891e4eb 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -367,14 +367,13 @@ purposes."
      'unknown)
     ((channels ...)
      (map (lambda (channel)
-            (let* ((uri (string->uri (channel-url channel)))
-                   (url (if (or (not uri) (eq? 'file (uri-scheme uri)))
-                            "local checkout"
-                            (channel-url channel))))
-             `(channel ,(channel-name channel) ,url ,(channel-commit channel))))
+            ;; NOTE: URL is not logged to synchronize the derivations
+            ;; coming out of pre-inst-env, time-machine and Cuirass
+            ;; for generating release artifacts.
+            `(channel ,(channel-name channel) ,(channel-commit channel)))
           channels))))
 
-(define* (installer-program #:key dry-run?)
+(define* (installer-program #:key dry-run? (guix-for-installer (current-guix)))
   "Return a file-like object that runs the given INSTALLER."
   (define init-gettext
     ;; Initialize gettext support, so that installer messages can be
@@ -423,7 +422,7 @@ purposes."
                            guile-gnutls
                            guile-zlib           ;for (gnu build linux-modules)
                            guile-zstd           ;for (gnu build linux-modules)
-                           (current-guix))
+                           guix-for-installer)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
                                     (gnu services herd)
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index eadaea4967..71977aaa9f 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -197,9 +197,9 @@
   ;; Latest version of Guix, which may or may not correspond to a release.
   ;; Note: the 'update-guix-package.scm' script expects this definition to
   ;; start precisely like this.
-  (let ((version "1.4.0")
-        (commit "21ce6b392ace4c4d22543abc41bd7c22596cd6d2")
-        (revision 47))
+  (let ((version "1.5.0rc1")
+        (commit "2d4ed08662714ea46cfe0b41ca195d1ef845fd1b")
+        (revision 0))
     (package
       (name "guix")
 
@@ -215,7 +215,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "0q4f5aiqld1smjmq0k0y96wrrvn7pizsx8xzqk6m7f9f2qm7pdhc"))
+                  "0z1ixlkzsaj978nh57179871xkzbf8zsf10xkcfs2647iznkx7az"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (build-system gnu-build-system)
       (arguments
@@ -234,10 +234,9 @@
                             (string-append "--with-bash-completion-dir="
                                            (assoc-ref %outputs "out")
                                            "/etc/bash_completion.d")
-                            ;; TODO: Uncomment after guix is updated.
-                            ;; (string-append "--with-apparmor-profile-dir="
-                            ;;                (assoc-ref %outputs "out")
-                            ;;                "/etc/apparmor.d")
+                            (string-append "--with-apparmor-profile-dir="
+                                           (assoc-ref %outputs "out")
+                                           "/etc/apparmor.d")
 
                             ;; Set 'DOT_USER_PROGRAM' to the empty string so
                             ;; we don't keep a reference to Graphviz, whose
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index b32a960bcf..25f44566be 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -64,6 +64,7 @@
   #:use-module ((guix modules) #:select (source-module-closure))
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (guix platform)
   #:use-module (guix records)
   #:use-module (guix deprecation)
   #:use-module (guix utils)
@@ -148,25 +149,36 @@
 ;;;
 ;;; Code:
 
-(define %default-xorg-modules
-  ;; Default list of modules loaded by the server.  When multiple drivers
-  ;; match, the first one in the list is loaded.
-  (list xf86-video-vesa
-        xf86-video-fbdev
-        xf86-video-amdgpu
-        xf86-video-ati
-        xf86-video-cirrus
-        xf86-video-intel
-        xf86-video-mach64
-        xf86-video-nouveau
-        xf86-video-nv
-        xf86-video-sis
+(define* (default-xorg-modules
+           #:optional
+           (system (or (and=>
+                        (%current-target-system)
+                        platform-target->system)
+                       (%current-system))))
+  "Default list of modules loaded by the server.  When multiple drivers match,
+the first one in the list is loaded."
+  ;; Return only supported packages, because some aren't supported
+  ;; on all architectures.
+  (filter (cut supported-package? <> system)
+          (list xf86-video-vesa
+                xf86-video-fbdev
+                xf86-video-amdgpu
+                xf86-video-ati
+                xf86-video-cirrus
+                xf86-video-intel
+                xf86-video-mach64
+                xf86-video-nouveau
+                xf86-video-nv
+                xf86-video-sis
 
-        ;; Libinput is the new thing and is recommended over evdev/synaptics:
-        ;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
-        xf86-input-libinput
-        xf86-input-evdev
-        xf86-input-mouse))
+                ;; Libinput is the new thing and is recommended over evdev/synaptics:
+                ;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
+                xf86-input-libinput
+                xf86-input-evdev
+                xf86-input-mouse)))
+
+(define-syntax %default-xorg-modules
+  (identifier-syntax (default-xorg-modules)))
 
 (define %default-xorg-fonts
   ;; Default list of fonts available to the X server.
diff --git a/gnu/system/examples/vm-image-efi.tmpl b/gnu/system/examples/vm-image-efi.tmpl
new file mode 100644
index 0000000000..d264b27a5f
--- /dev/null
+++ b/gnu/system/examples/vm-image-efi.tmpl
@@ -0,0 +1,145 @@
+;; -*- mode: scheme; -*-
+;; This is an operating system configuration for a VM image.
+;; Modify it as you see fit and instantiate the changes by running:
+;;
+;;   guix system reconfigure /etc/config.scm
+;;
+
+(use-modules (gnu)
+             (guix)
+             (srfi srfi-1)
+             (ice-9 match)
+             (guix channels)
+             (gnu system image))
+(use-service-modules desktop mcron networking spice ssh xorg sddm)
+(use-package-modules bootloaders fonts
+                     package-management xdisorg xorg)
+
+(define vm-image-motd (plain-file "motd" "
+\x1b[1;37mThis is the GNU system.  Welcome!\x1b[0m
+
+This instance of Guix is a template for virtualized environments.
+You can reconfigure the whole system by adjusting /etc/config.scm
+and running:
+
+  guix system reconfigure /etc/config.scm
+
+Run '\x1b[1;37minfo guix\x1b[0m' to browse documentation.
+
+\x1b[1;33mConsider setting a password for the 'root' and 'guest' \
+accounts.\x1b[0m
+"))
+
+(operating-system
+  (host-name "gnu")
+  (timezone "Etc/UTC")
+  (locale "en_US.utf8")
+  (keyboard-layout (keyboard-layout "us" "altgr-intl"))
+
+  ;; Label for the GRUB boot menu.
+  (label (string-append "GNU Guix "
+                        (or (getenv "GUIX_DISPLAYED_VERSION")
+                            (package-version guix))))
+
+  (firmware '())
+
+  ;; On AArch64, support SCSI CDROMs and HDs.
+  (initrd-modules (cons* "sd_mod" "sr_mod"
+                         %base-initrd-modules))
+
+  (bootloader
+    (bootloader-configuration
+      (bootloader grub-efi-bootloader)
+      (targets '("/boot/efi"))
+      (terminal-outputs '(console))))
+  (file-systems (cons* (file-system
+                         (mount-point "/")
+                         (device (file-system-label root-label))
+                         (type "ext4"))
+                       (file-system
+                         (mount-point "/boot/efi")
+                         (device (file-system-label "GNU-ESP"))
+                         (type "vfat"))
+                       %base-file-systems))
+
+  (users (cons (user-account
+                (name "guest")
+                (comment "GNU Guix Live")
+                (password "")           ;no password
+                (group "users")
+                (supplementary-groups '("wheel" "netdev"
+                                        "audio" "video")))
+               %base-user-accounts))
+
+  ;; Our /etc/sudoers file.  Since 'guest' initially has an empty password,
+  ;; allow for password-less sudo.
+  (sudoers-file (plain-file "sudoers" "\
+root ALL=(ALL) ALL
+%wheel ALL=NOPASSWD: ALL\n"))
+
+  (pam-services
+   ;; Explicitly allow for empty passwords.
+   (base-pam-services #:allow-empty-passwords? #t))
+
+  (packages
+   (append (list font-bitstream-vera
+                 ;; Auto-started script providing SPICE dynamic resizing for
+                 ;; Xfce (see:
+                 ;; https://gitlab.xfce.org/xfce/xfce4-settings/-/issues/142).
+                 x-resize)
+           %base-packages))
+
+  (services
+   (append (list (service xfce-desktop-service-type)
+
+                 ;; Choose SLiM, which is lighter than the default GDM.
+                 (service slim-service-type
+                          (slim-configuration
+                           (auto-login? #t)
+                           (default-user "guest")
+                           (xorg-configuration
+                            (xorg-configuration
+                             ;; The QXL virtual GPU driver is added to provide
+                             ;; a better SPICE experience.
+                              (modules (cons xf86-video-qxl
+                                             %default-xorg-modules))
+                             (keyboard-layout keyboard-layout)))))
+
+                 ;; Uncomment the line below to add an SSH server.
+                 ;;(service openssh-service-type)
+
+                 ;; Add support for the SPICE protocol, which enables dynamic
+                 ;; resizing of the guest screen resolution, clipboard
+                 ;; integration with the host, etc.
+                 (service spice-vdagent-service-type)
+
+                 ;; Use the DHCP client service rather than NetworkManager.
+                 (service dhcpcd-service-type))
+
+           ;; Remove some services that don't make sense in a VM.
+           (remove (lambda (service)
+                     (let ((type (service-kind service)))
+                       (or (memq type
+                                 (list gdm-service-type
+                                       sddm-service-type
+                                       wpa-supplicant-service-type
+                                       cups-pk-helper-service-type
+                                       network-manager-service-type
+                                       modem-manager-service-type))
+                           (eq? 'network-manager-applet
+                                (service-type-name type)))))
+                   (modify-services %desktop-services
+                     (login-service-type config =>
+                                         (login-configuration
+                                          (inherit config)
+                                          (motd vm-image-motd)))
+
+                     ;; Install and run the current Guix rather than an older
+                     ;; snapshot.
+                     (guix-service-type config =>
+                                        (guix-configuration
+                                         (inherit config)
+                                         (guix (current-guix))))))))
+
+  ;; Allow resolution of '.local' host names with mDNS.
+  (name-service-switch %mdns-host-lookup-nss))
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index f7c27d23db..2a0e9e21c8 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -10,6 +10,7 @@
              (srfi srfi-1)
              (ice-9 match)
              (guix channels)
+             (gnu packages package-management)
              (gnu system image))
 (use-service-modules desktop mcron networking spice ssh xorg sddm)
 (use-package-modules bootloaders fonts
@@ -30,15 +31,6 @@ Run '\x1b[1;37minfo guix\x1b[0m' to browse documentation.
 accounts.\x1b[0m
 "))
 
-(define (guix-package-commit guix)
-  ;; Extract the commit of the GUIX package.
-  (match (package-source guix)
-    ((? channel? source)
-     (channel-commit source))
-    (_
-     (apply (lambda* (#:key commit #:allow-other-keys) commit)
-            (package-arguments guix)))))
-
 (operating-system
   (host-name "gnu")
   (timezone "Etc/UTC")
@@ -141,14 +133,7 @@ root ALL=(ALL) ALL
                      (guix-service-type config =>
                                         (guix-configuration
                                          (inherit config)
-                                         (guix
-                                          (let ((guix (current-guix)))
-                                            (package
-                                              (inherit guix)
-                                              ;; Do not leak the local checkout URL.
-                                              (source (channel
-                                                        (inherit %default-guix-channel)
-                                                        (commit (guix-package-commit guix)))))))))))))
+                                         (guix (current-guix))))))))
 
   ;; Allow resolution of '.local' host names with mDNS.
   (name-service-switch %mdns-host-lookup-nss))
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 0101fe3d6e..7be6a79688 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -98,6 +98,7 @@
             efi-raw-image-type
             efi32-raw-image-type
             qcow2-image-type
+            qcow2-gpt-image-type
             iso-image-type
             uncompressed-iso-image-type
             docker-image-type
@@ -265,6 +266,16 @@ set to the given OS."
                   (format 'compressed-qcow2))
                  <>))))
 
+(define qcow2-gpt-image-type
+  (image-type
+   (name 'qcow2-gpt)
+   (constructor (cut image-with-os
+                 (image
+                  (inherit efi-disk-image)
+                  (name 'image.qcow2)
+                  (format 'compressed-qcow2))
+                 <>))))
+
 (define iso-image-type
   (image-type
    (name 'iso9660)
@@ -352,16 +363,27 @@ set to the given OS."
                        (guix build utils))
           gexp* ...))))
 
+(define (partition-has-flag? partition flag)
+  "Return true if PARTITION's flags include FLAG."
+  (member flag (partition-flags partition)))
+
+(define (find-partition-with-flag image flag)
+  "Return partition of the given IMAGE that has FLAG, or #f if not found."
+  (srfi-1:find (cut partition-has-flag? <> flag)
+               (image-partitions image)))
+
 (define (root-partition? partition)
   "Return true if PARTITION is the root partition, false otherwise."
-  (member 'boot (partition-flags partition)))
+  (partition-has-flag? partition 'boot))
 
 (define (find-root-partition image)
-  "Return the root partition of the given IMAGE."
-  (or (srfi-1:find root-partition? (image-partitions image))
+  (or (find-partition-with-flag image 'boot)
       (raise (formatted-message
               (G_ "image lacks a partition with the 'boot' flag")))))
 
+(define (find-esp-partition image)
+  (find-partition-with-flag image 'esp))
+
 (define (root-partition-index image)
   "Return the index of the root partition of the given IMAGE."
   (1+ (srfi-1:list-index root-partition? (image-partitions image))))
@@ -652,6 +674,10 @@ used in the image. "
        (uuid-bytevector (partition-uuid partition)))))
 
   (let* ((os (image-operating-system image))
+         (image-name (image-name image))
+         (name (if image-name
+                   (symbol->string image-name)
+                   name))
          (bootloader (bootloader-package bootloader))
          (compression? (image-compression? image))
          (substitutable? (image-substitutable? image))
@@ -969,6 +995,19 @@ it can be used for bootloading."
 
   (let* ((root-file-system-type (image->root-file-system image))
          (base-os (image-operating-system image))
+         (esp-partition (find-esp-partition image))
+         ;; In case the user has added /boot/efi file-system,
+         ;; try to respect it and add a file-system pointing
+         ;; to the correct esp.
+         (wants-boot-efi? (and
+                         (srfi-1:any
+                          (lambda (fs)
+                            (let ((mount-point (file-system-mount-point fs)))
+                              (string=? mount-point "/boot/efi")))
+                          (operating-system-file-systems base-os))
+                         esp-partition))
+         ;; Replace root file system with one with proper UUID that the
+         ;; target image will have. Similarly for /boot/efi.
          (file-systems-to-keep
           (srfi-1:remove
            (lambda (fs)
@@ -985,24 +1024,32 @@ it can be used for bootloading."
                              file-systems
                              #:volatile-root? volatile-root?
                              rest)))
-            (bootloader (if (eq? format 'iso9660)
+            ;; Only replace with grub-mkrescue-bootloader if grub-pc
+            ;; is supported. AArch64 doesn't support it.  In such
+            ;; cases, respect bootloader of the system.  Still,
+            ;; for now make-iso9660-image installs only GRUB.
+            (bootloader (if (and (eq? format 'iso9660)
+                                 (supported-package? grub-hybrid))
                             (bootloader-configuration
-                             (inherit
-                              (operating-system-bootloader base-os))
-                             (bootloader grub-mkrescue-bootloader))
-                            (operating-system-bootloader base-os)))
-            (file-systems (cons (file-system
-                                  (mount-point "/")
-                                  (device "/dev/placeholder")
-                                  (type root-file-system-type))
-                                file-systems-to-keep))))
+                              (inherit
+                               (operating-system-bootloader base-os))
+                              (bootloader grub-mkrescue-bootloader))
+                            (operating-system-bootloader base-os)))))
          (uuid (root-uuid os)))
-    (operating-system
-      (inherit os)
-      (file-systems (cons (file-system
-                            (mount-point "/")
-                            (device uuid)
-                            (type root-file-system-type))
+         (operating-system
+           (inherit os)
+           (file-systems (append
+                          (list (file-system
+                                  (mount-point "/")
+                                  (device uuid)
+                                  (type root-file-system-type)))
+                          (if wants-boot-efi?
+                              (list (file-system
+                                      (mount-point "/boot/efi")
+                                      (type "vfat")
+                                      (device (file-system-label
+                                               (partition-label esp-partition)))))
+                              '())
                           file-systems-to-keep)))))
 
 (define* (system-image image)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 5041dadf15..e5dfdbb427 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -28,6 +28,7 @@
   #:use-module (gnu)
   #:use-module (gnu system)
   #:use-module (gnu system privilege)
+  #:use-module (gnu bootloader)
   #:use-module (gnu bootloader u-boot)
   #:use-module (guix gexp)
   #:use-module (guix store)
@@ -64,6 +65,7 @@
   #:use-module (gnu packages xorg)
   #:use-module (ice-9 match)
   #:export (installation-os
+            make-installation-os
             a20-olinuxino-lime-installation-os
             a20-olinuxino-lime2-emmc-installation-os
             a20-olinuxino-micro-installation-os
@@ -334,10 +336,13 @@ templates under @file{/etc/configuration}.")))
     "Load the @code{uvesafb} kernel module with the right options.")
    (default-value #t)))
 
-(define* (%installation-services #:key (system (or (and=>
-                                                    (%current-target-system)
-                                                    platform-target->system)
-                                                   (%current-system))))
+(define* (%installation-services
+          #:key
+          (system (or (and=>
+                       (%current-target-system)
+                       platform-target->system)
+                      (%current-system)))
+          (guix-for-system (current-guix)))
   ;; List of services of the installation system.
   (let ((motd (plain-file "motd" "
 \x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m
@@ -355,15 +360,6 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
     (define bare-bones-os
       (load "examples/bare-bones.tmpl"))
 
-    (define (guix-package-commit guix)
-      ;; Extract the commit of the GUIX package.
-      (match (package-source guix)
-        ((? channel? source)
-         (channel-commit source))
-        (_
-         (apply (lambda* (#:key commit #:allow-other-keys) commit)
-                (package-arguments guix)))))
-
     (append
      ;; Generic services
      (list (service virtual-terminal-service-type)
@@ -371,7 +367,8 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
            (service kmscon-service-type
                     (kmscon-configuration
                      (virtual-terminal "tty1")
-                     (login-program (installer-program))))
+                     (login-program (installer-program
+                                     #:guix-for-installer guix-for-system))))
 
            (service login-service-type
                     (login-configuration
@@ -408,13 +405,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
 
                      ;; Install and run the current Guix rather than an older
                      ;; snapshot.
-                     (guix (let ((guix (current-guix)))
-                             (package
-                               (inherit guix)
-                               ;; Do not leak the local checkout URL.
-                               (source (channel
-                                        (inherit %default-guix-channel)
-                                        (commit (guix-package-commit guix)))))))))
+                     (guix guix-for-system)))
 
            ;; Start udev so that useful device nodes are available.
            ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
@@ -525,19 +516,52 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
         jfsutils
         xfsprogs))
 
-(define installation-os
+(define* (%installation-initrd-modules
+          #:key
+          (system (or (and=>
+                       (%current-target-system)
+                       platform-target->system)
+                      (%current-system))))
+  ;; AArch64 currently lacks a lot of modules necessary
+  ;; for booting from USB sticks, hard disks or
+  ;; CDROMs. Those are built-in in x86_64 kernel.
+  `(,@(if (target-aarch64? system)
+          '("sr_mod" "sd_mod"
+            "usb_common" "usbcore"
+            ;; USB 3.0
+            "xhci_pci" "xhci_hcd"
+            ;; embedded USB 3.0
+            "xhci_plat_hcd"
+            ;; USB 2.0
+            "ehci_pci" "ehci_hcd")
+          '())
+    ,@%base-initrd-modules))
+
+(define* (make-installation-os #:key
+                               ;; Version displayed in the GRUB entry name.
+                               (grub-displayed-version
+                                (package-version guix))
+                               ;; Whether to use efi-only installation.
+                               ;; When #f, use hybrid grub that sets up
+                               ;; both legacy boot and efi.
+                               (efi-only? #f))
   ;; The operating system used on installation images for USB sticks etc.
   (operating-system
     (host-name "gnu")
     (timezone "Europe/Paris")
     (locale "en_US.utf8")
     (name-service-switch %mdns-host-lookup-nss)
-    (bootloader (bootloader-configuration
-                 (bootloader grub-bootloader)
-                 (targets '("/dev/sda"))))
-    (label (string-append "GNU Guix installation "
-                          (or (getenv "GUIX_DISPLAYED_VERSION")
-                              (package-version guix))))
+
+    (initrd-modules (%installation-initrd-modules))
+
+    (bootloader (if efi-only?
+                    (bootloader-configuration
+                      (bootloader grub-efi-bootloader)
+                      (targets '("/boot/efi")))
+                    (bootloader-configuration
+                      (bootloader grub-bootloader)
+                      (targets '("/dev/sda")))))
+    (label (string-append "GNU Guix installation " grub-displayed-version))
 
     ;; XXX: The AMD Radeon driver is reportedly broken, which makes kmscon
     ;; non-functional:
@@ -550,19 +574,19 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
      ;; the appropriate one.
      (append %base-live-file-systems
 
-            ;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need
-            ;; elogind's cgroup file systems.
-            (list %pseudo-terminal-file-system
-                  %shared-memory-file-system
-                  %efivars-file-system
-                  %immutable-store)))
+             ;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need
+             ;; elogind's cgroup file systems.
+             (list %pseudo-terminal-file-system
+                   %shared-memory-file-system
+                   %efivars-file-system
+                   %immutable-store)))
 
     (users (list (user-account
-                  (name "guest")
-                  (group "users")
-                  (supplementary-groups '("wheel")) ; allow use of sudo
-                  (password "")
-                  (comment "Guest of GNU"))))
+                   (name "guest")
+                   (group "users")
+                   (supplementary-groups '("wheel")) ; allow use of sudo
+                   (password "")
+                   (comment "Guest of GNU"))))
 
     (issue %issue)
     (services (%installation-services))
@@ -570,20 +594,25 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
     ;; We don't need setuid programs, except for 'passwd', which can be handy
     ;; if one is to allow remote SSH login to the machine being installed.
     (privileged-programs (list (privileged-program
-                                (program (file-append shadow "/bin/passwd"))
-                                (setuid? #t))))
+                                 (program (file-append shadow "/bin/passwd"))
+                                 (setuid? #t))))
 
     (pam-services
      ;; Explicitly allow for empty passwords.
      (base-pam-services #:allow-empty-passwords? #t))
 
     (packages (append
-                (list glibc             ; for 'tzselect' & co.
-                      fontconfig
-                      font-dejavu font-gnu-unifont
-                      grub)             ; mostly so xrefs to its manual work
-                %installer-disk-utilities
-                %base-packages))))
+               (list glibc             ; for 'tzselect' & co.
+                     fontconfig
+                     font-dejavu font-gnu-unifont
+
+                     ;; Mostly so xrefs to its manual work.
+                     (bootloader-package
+                      (bootloader-configuration-bootloader bootloader)))
+               %installer-disk-utilities
+               %base-packages))))
+
+(define installation-os (make-installation-os))
 
 (define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
                          (triplet "arm-linux-gnueabihf"))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index febfda5778..329ded9f0b 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -366,7 +366,7 @@ FILE-SYSTEMS."
   (define virtio-modules
     ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
     '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
-      "virtio_console" "virtio-rng"))
+      "virtio_console" "virtio-rng" "virtio_mmio" "virtio_scsi"))
 
   `("ahci"                                  ;for SATA controllers
     "usb-storage" "uas"                     ;for the installation image etc.