Merge branch 'master' into staging.

With "conflicts" solved (all in favor of master except git) in:
	gnu/local.mk
	gnu/packages/databases.scm
	gnu/packages/glib.scm
	gnu/packages/gnome.scm
	gnu/packages/gnupg.scm
	gnu/packages/gnuzilla.scm
	gnu/packages/graphics.scm
	gnu/packages/gstreamer.scm
	gnu/packages/gtk.scm
	gnu/packages/linux.scm
	gnu/packages/machine-learning.scm
	gnu/packages/networking.scm
	gnu/packages/polkit.scm
	gnu/packages/pulseaudio.scm
	gnu/packages/rpc.scm
	gnu/packages/rust.scm
	gnu/packages/version-control.scm
	gnu/packages/w3m.scm

17 files changed, 410 insertions, 601 deletions

diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index c928008c92..7055a8f92d 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -1,9 +1,9 @@
 ;; This is an operating system configuration template
 ;; for a "desktop" setup with GNOME and Xfce where the
-;; root partition is encrypted with LUKS.
+;; root partition is encrypted with LUKS, and a swap file.
 
-(use-modules (gnu) (gnu system nss))
-(use-service-modules desktop xorg)
+(use-modules (gnu) (gnu system nss) (guix utils))
+(use-service-modules desktop sddm xorg)
 (use-package-modules certs gnome)
 
 (operating-system
@@ -42,16 +42,26 @@
                          (type "vfat")))
                  %base-file-systems))
 
+  ;; Specify a swap file for the system, which resides on the
+  ;; root file system.
+  (swap-devices (list (swap-space
+                       (target "/swapfile"))))
+
   ;; Create user `bob' with `alice' as its initial password.
   (users (cons (user-account
                 (name "bob")
                 (comment "Alice's brother")
                 (password (crypt "alice" "$6$abc"))
-                (group "users")
+                (group "students")
                 (supplementary-groups '("wheel" "netdev"
                                         "audio" "video")))
                %base-user-accounts))
 
+  ;; Add the `students' group
+  (groups (cons* (user-group
+                  (name "students"))
+                 %base-groups))
+
   ;; This is where we specify system-wide packages.
   (packages (append (list
                      ;; for HTTPS access
@@ -64,12 +74,25 @@
   ;; by clicking the gear.  Use the "desktop" services, which
   ;; include the X11 log-in service, networking with
   ;; NetworkManager, and more.
-  (services (append (list (service gnome-desktop-service-type)
-                          (service xfce-desktop-service-type)
-                          (set-xorg-configuration
-                           (xorg-configuration
-                            (keyboard-layout keyboard-layout))))
-                    %desktop-services))
+  (services (if (target-x86-64?)
+                (append (list (service gnome-desktop-service-type)
+                              (service xfce-desktop-service-type)
+                              (set-xorg-configuration
+                               (xorg-configuration
+                                (keyboard-layout keyboard-layout))))
+                        %desktop-services)
+
+                ;; FIXME: Since GDM depends on Rust (gdm -> gnome-shell -> gjs
+                ;; -> mozjs -> rust) and Rust is currently unavailable on
+                ;; non-x86_64 platforms, we use SDDM and Mate here instead of
+                ;; GNOME and GDM.
+                (append (list (service mate-desktop-service-type)
+                              (service xfce-desktop-service-type)
+                              (set-xorg-configuration
+                               (xorg-configuration
+                                (keyboard-layout keyboard-layout))
+                               sddm-service-type))
+                        %desktop-services)))
 
   ;; 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 a59d91587b..ccb0b045db 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -5,7 +5,7 @@
 ;;
 
 (use-modules (gnu) (guix) (srfi srfi-1))
-(use-service-modules desktop mcron networking spice ssh xorg)
+(use-service-modules desktop mcron networking spice ssh xorg sddm)
 (use-package-modules bootloaders certs fonts nvi
                      package-management wget xorg)
 
@@ -107,12 +107,12 @@ root ALL=(ALL) ALL
                  ;; Use the DHCP client service rather than NetworkManager.
                  (service dhcp-client-service-type))
 
-           ;; Remove GDM, ModemManager, NetworkManager, and wpa-supplicant,
-           ;; which don't make sense in a VM.
+           ;; 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
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index e69cfd06e6..e1d1fb72cc 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <[email protected]>
+;;; Copyright © 2013-2021 Ludovic Courtès <[email protected]>
 ;;; Copyright © 2020 Google LLC
 ;;; Copyright © 2020 Jakub Kądziołka <[email protected]>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <[email protected]>
@@ -30,7 +30,8 @@
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (guix records)
-  #:use-module ((guix diagnostics) #:select (&fix-hint))
+  #:use-module ((guix diagnostics)
+                #:select (source-properties->location leave &fix-hint))
   #:use-module (guix i18n)
   #:use-module (gnu system uuid)
   #:re-export (uuid                               ;backward compatibility
@@ -96,7 +97,14 @@
 
             %store-mapping
             %network-configuration-files
-            %network-file-mappings))
+            %network-file-mappings
+
+            swap-space
+            swap-space?
+            swap-space-target
+            swap-space-dependencies
+            swap-space-priority
+            swap-space-discard?))
 
 ;;; Commentary:
 ;;;
@@ -107,6 +115,45 @@
 ;;;
 ;;; Code:
 
+(eval-when (expand load eval)
+  (define invalid-file-system-flags
+    ;; Note: Keep in sync with 'mount-flags->bit-mask'.
+    (let ((known-flags '(read-only
+                         bind-mount no-suid no-dev no-exec
+                         no-atime strict-atime lazy-time)))
+      (lambda (flags)
+        "Return the subset of FLAGS that is invalid."
+        (remove (cut memq <> known-flags) flags))))
+
+  (define (%validate-file-system-flags flags location)
+    "Raise an error if FLAGS contains invalid mount flags; otherwise return
+FLAGS."
+    (match (invalid-file-system-flags flags)
+      (() flags)
+      (invalid
+       (leave (source-properties->location location)
+              (N_ "invalid file system mount flag:~{ ~s~}~%"
+                  "invalid file system mount flags:~{ ~s~}~%"
+                  (length invalid))
+              invalid)))))
+
+(define-syntax validate-file-system-flags
+  (lambda (s)
+    "Validate the given file system mount flags, raising an error if invalid
+flags are found."
+    (syntax-case s (quote)
+      ((_ (quote (symbols ...)))                  ;validate at expansion time
+       (begin
+         (%validate-file-system-flags (syntax->datum #'(symbols ...))
+                                      (syntax-source s))
+         #'(quote (symbols ...))))
+      ((_ flags)
+       #`(%validate-file-system-flags flags
+                                      '#,(datum->syntax s (syntax-source s))))
+      (id
+       (identifier? #'id)
+       #'%validate-file-system-flags))))
+
 ;; File system declaration.
 (define-record-type* <file-system> %file-system
   make-file-system
@@ -115,7 +162,8 @@
   (mount-point      file-system-mount-point)      ; string
   (type             file-system-type)             ; string
   (flags            file-system-flags             ; list of symbols
-                    (default '()))
+                    (default '())
+                    (sanitize validate-file-system-flags))
   (options          file-system-options           ; string or #f
                     (default #f))
   (mount?           file-system-mount?            ; Boolean
@@ -671,4 +719,19 @@ subvolume name is unknown."))
                   (G_ "Use the @code{subvol} Btrfs file system option."))))))))
 
 
+;;;
+;;; Swap space
+;;;
+
+(define-record-type* <swap-space> swap-space make-swap-space
+  swap-space?
+  this-swap-space
+  (target swap-space-target)
+  (dependencies swap-space-dependencies
+                (default '()))
+  (priority swap-space-priority
+            (default #f))
+  (discard? swap-space-discard?
+           (default #f)))
+
 ;;; file-systems.scm ends here
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index e976494d74..2acc7b7e11 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -34,6 +34,7 @@
   #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages hurd)
   #:use-module (gnu packages less)
+  #:use-module (gnu packages texinfo)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services hurd)
@@ -67,7 +68,8 @@
   (list hurd bash coreutils file findutils grep sed
         diffutils patch gawk tar gzip bzip2 xz lzip
         guile-3.0-latest guile-colorized guile-readline
-        net-base inetutils less shadow shepherd sudo which))
+        net-base inetutils less shadow shepherd sudo which
+        info-reader))
 
 (define %base-services/hurd
   (list (service hurd-console-service-type
@@ -77,11 +79,13 @@
         (service hurd-getty-service-type (hurd-getty-configuration
                                           (tty "tty2")))
         (service static-networking-service-type
-                 (list (static-networking (interface "lo")
-                                          (ip "127.0.0.1")
-                                          (requirement '())
-                                          (provision '(loopback networking))
-                                          (name-servers '("10.0.2.3")))))
+                 (list %loopback-static-networking
+
+                       ;; QEMU user-mode networking.  To get "eth0", you need
+                       ;; QEMU to emulate a device for which Mach has an
+                       ;; in-kernel driver, for instance with:
+                       ;; --device rtl8139,netdev=net0 --netdev user,id=net0
+                       %qemu-static-networking))
         (syslog-service)
         (service guix-service-type
                  (guix-configuration
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 1012fa6158..42e215f614 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Mathieu Othacehe <[email protected]>
+;;; Copyright © 2020, 2021 Mathieu Othacehe <[email protected]>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -31,16 +31,19 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
+  #:use-module (gnu platform)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
+  #:use-module (gnu system linux-container)
   #:use-module (gnu system uuid)
   #:use-module (gnu system vm)
   #:use-module (guix packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages cdrom)
+  #:use-module (gnu packages compression)
   #:use-module (gnu packages disk)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages genimage)
@@ -66,16 +69,16 @@
 
             efi-disk-image
             iso9660-image
-            arm32-disk-image
-            arm64-disk-image
+            docker-image
+            raw-with-offset-disk-image
 
             image-with-os
             efi-raw-image-type
             qcow2-image-type
             iso-image-type
             uncompressed-iso-image-type
-            arm32-image-type
-            arm64-image-type
+            docker-image-type
+            raw-with-offset-image-type
 
             image-with-label
             system-image
@@ -128,10 +131,13 @@
            (label "GUIX_IMAGE")
            (flags '(boot)))))))
 
-(define* (arm32-disk-image #:optional (offset root-offset))
+(define docker-image
+  (image
+   (format 'docker)))
+
+(define* (raw-with-offset-disk-image #:optional (offset root-offset))
   (image
    (format 'disk-image)
-   (target "arm-linux-gnueabihf")
    (partitions
     (list (partition
            (inherit root-partition)
@@ -140,11 +146,6 @@
    ;; fails.
    (volatile-root? #f)))
 
-(define* (arm64-disk-image #:optional (offset root-offset))
-  (image
-   (inherit (arm32-disk-image offset))
-   (target "aarch64-linux-gnu")))
-
 
 ;;;
 ;;; Images types.
@@ -186,15 +187,15 @@ set to the given OS."
                   (compression? #f))
                  <>))))
 
-(define arm32-image-type
+(define docker-image-type
   (image-type
-   (name 'arm32-raw)
-   (constructor (cut image-with-os (arm32-disk-image) <>))))
+   (name 'docker)
+   (constructor (cut image-with-os docker-image <>))))
 
-(define arm64-image-type
+(define raw-with-offset-image-type
   (image-type
-   (name 'arm64-raw)
-   (constructor (cut image-with-os (arm64-disk-image) <>))))
+   (name 'raw-with-offset)
+   (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
 
 
 ;;
@@ -232,8 +233,7 @@ set to the given OS."
 (define-syntax-rule (with-imported-modules* gexp* ...)
   (with-extensions gcrypt-sqlite3&co
     (with-imported-modules `(,@(source-module-closure
-                                '((gnu build vm)
-                                  (gnu build image)
+                                '((gnu build image)
                                   (gnu build bootloader)
                                   (gnu build hurd-boot)
                                   (gnu build linux-boot)
@@ -241,8 +241,7 @@ set to the given OS."
                                 #:select? not-config?)
                              ((guix config) => ,(make-config.scm)))
       #~(begin
-          (use-modules (gnu build vm)
-                       (gnu build image)
+          (use-modules (gnu build image)
                        (gnu build bootloader)
                        (gnu build hurd-boot)
                        (gnu build linux-boot)
@@ -310,6 +309,14 @@ used in the image."
          ((member 'esp flags) "0xEF")
          (else "0x83"))))
 
+    (define (partition->gpt-type partition)
+      ;; Return the genimage GPT partition type code corresponding to PARTITION.
+      ;; See https://github.com/pengutronix/genimage/blob/master/README.rst
+      (let ((flags (partition-flags partition)))
+        (cond
+          ((member 'esp flags) "U")
+          (else "L"))))
+
     (define (partition-image partition)
       ;; Return as a file-like object, an image of the given PARTITION.  A
       ;; directory, filled by calling the PARTITION initializer procedure, is
@@ -341,6 +348,8 @@ used in the image."
                  (initializer image-root
                               #:references-graphs '#$graph
                               #:deduplicate? #f
+                              #:copy-closures? (not
+                                                #$(image-shared-store? image))
                               #:system-directory #$os
                               #:grub-efi #+grub-efi
                               #:bootloader-package
@@ -359,26 +368,44 @@ used in the image."
                        #:local-build? #f
                        #:options `(#:references-graphs ,inputs))))
 
-    (define (partition->config partition)
+    (define (gpt-image? image)
+      (eq? 'gpt (image-partition-table-type image)))
+
+    (define (partition-type-values image partition)
+      (if (gpt-image? image)
+          (values "partition-type-uuid" (partition->gpt-type partition))
+          (values "partition-type" (partition->dos-type partition))))
+
+    (define (partition->config image partition)
       ;; Return the genimage partition configuration for PARTITION.
-      (let ((label (partition-label partition))
-            (dos-type (partition->dos-type partition))
-            (image (partition-image partition))
-            (offset (partition-offset partition)))
-        #~(format #f "~/partition ~a {
-~/~/partition-type = ~a
-~/~/image = \"~a\"
-~/~/offset = \"~a\"
-~/}"
-                  #$label
-                  #$dos-type
-                  #$image
-                  #$offset)))
+      (let-values (((partition-type-attribute partition-type-value)
+                    (partition-type-values image partition)))
+        (let ((label (partition-label partition))
+              (image (partition-image partition))
+              (offset (partition-offset partition)))
+          #~(format #f "~/partition ~a {
+  ~/~/~a = ~a
+  ~/~/image = \"~a\"
+  ~/~/offset = \"~a\"
+  ~/}"
+                    #$label
+                    #$partition-type-attribute
+                    #$partition-type-value
+                    #$image
+                    #$offset))))
+
+    (define (genimage-type-options image-type image)
+      (cond
+        ((equal? image-type "hdimage")
+         (format #f "~%~/~/gpt = ~a~%~/"
+                 (if (gpt-image? image) "true" "false")))
+        (else "")))
 
     (let* ((format (image-format image))
            (image-type (format->image-type format))
+           (image-type-options (genimage-type-options image-type image))
            (partitions (image-partitions image))
-           (partitions-config (map partition->config partitions))
+           (partitions-config (map (cut partition->config image <>) partitions))
            (builder
             #~(begin
                 (let ((format (@ (ice-9 format) format)))
@@ -387,9 +414,10 @@ used in the image."
                       (format port
                               "\
 image ~a {
-~/~a {}
+~/~a {~a}
 ~{~a~^~%~}
-}~%" #$genimage-name #$image-type (list #$@partitions-config))))))))
+}~%" #$genimage-name #$image-type #$image-type-options
+ (list #$@partitions-config))))))))
       (computed-file "genimage.cfg" builder)))
 
   (let* ((image-name (image-name image))
@@ -514,15 +542,107 @@ returns an image record where the first partition's label is set to <label>."
 
 
 ;;
+;; Docker image.
+;;
+
+(define* (system-docker-image image
+                              #:key
+                              (name "docker-image"))
+  "Build a docker image for IMAGE.  NAME is the base name to use for the
+output file."
+  (define boot-program
+    ;; Program that runs the boot script of OS, which in turn starts shepherd.
+    (program-file "boot-program"
+                  #~(let ((system (cadr (command-line))))
+                      (setenv "GUIX_NEW_SYSTEM" system)
+                      (execl #$(file-append guile-3.0 "/bin/guile")
+                             "guile" "--no-auto-compile"
+                             (string-append system "/boot")))))
+
+  (define shared-network?
+    (image-shared-network? image))
+
+  (let* ((os (operating-system-with-gc-roots
+              (containerized-operating-system
+               (image-operating-system image) '()
+               #:shared-network?
+               shared-network?)
+              (list boot-program)))
+         (substitutable? (image-substitutable? image))
+         (register-closures? (has-guix-service-type? os))
+         (schema (and register-closures?
+                      (local-file (search-path %load-path
+                                               "guix/store/schema.sql"))))
+         (name (string-append name ".tar.gz"))
+         (graph "system-graph"))
+    (define builder
+      (with-extensions (cons guile-json-3         ;for (guix docker)
+                             gcrypt-sqlite3&co)   ;for (guix store database)
+        (with-imported-modules `(,@(source-module-closure
+                                    '((guix docker)
+                                      (guix store database)
+                                      (guix build utils)
+                                      (guix build store-copy)
+                                      (gnu build image))
+                                    #:select? not-config?)
+                                 ((guix config) => ,(make-config.scm)))
+          #~(begin
+              (use-modules (guix docker)
+                           (guix build utils)
+                           (gnu build image)
+                           (srfi srfi-19)
+                           (guix build store-copy)
+                           (guix store database))
+
+              ;; Set the SQL schema location.
+              (sql-schema #$schema)
+
+              ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
+              (setenv "GUIX_LOCPATH"
+                      #+(file-append glibc-utf8-locales "/lib/locale"))
+              (setlocale LC_ALL "en_US.utf8")
+
+              (set-path-environment-variable "PATH" '("bin" "sbin") '(#+tar))
+
+              (let ((image-root (string-append (getcwd) "/tmp-root")))
+                (mkdir-p image-root)
+                (initialize-root-partition image-root
+                                           #:references-graphs '(#$graph)
+                                           #:copy-closures? #f
+                                           #:register-closures? #$register-closures?
+                                           #:deduplicate? #f
+                                           #:system-directory #$os)
+                (build-docker-image
+                 #$output
+                 (cons* image-root
+                        (map store-info-item
+                             (call-with-input-file #$graph
+                               read-reference-graph)))
+                 #$os
+                 #:entry-point '(#$boot-program #$os)
+                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
+                 #:creation-time (make-time time-utc 0 1)
+                 #:transformations `((,image-root -> ""))))))))
+
+    (computed-file name builder
+                   ;; Allow offloading so that this I/O-intensive process
+                   ;; doesn't run on the build farm's head node.
+                   #:local-build? #f
+                   #:options `(#:references-graphs ((,graph ,os))
+                               #:substitutable? ,substitutable?))))
+
+
+;;
 ;; Image creation.
 ;;
 
 (define (image->root-file-system image)
   "Return the IMAGE root partition file-system type."
-  (let ((format (image-format image)))
-    (if (eq? format 'iso9660)
-        "iso9660"
-        (partition-file-system (find-root-partition image)))))
+  (case (image-format image)
+    ((iso9660) "iso9660")
+    ((docker) "dummy")
+    (else
+     (partition-file-system (find-root-partition image)))))
 
 (define (root-size image)
   "Return the root partition size of IMAGE."
@@ -615,7 +735,30 @@ it can be used for bootloading."
   "Return the derivation of IMAGE.  It can be a raw disk-image or an ISO9660
 image, depending on IMAGE format."
   (define substitutable? (image-substitutable? image))
-  (define target (image-target image))
+  (define platform (image-platform image))
+
+  ;; The image platform definition may provide the appropriate "system"
+  ;; architecture for the image.  If we are already running on this system,
+  ;; the image can be built natively.  If we are running on a different
+  ;; system, then we need to cross-compile, using the "target" provided by the
+  ;; image definition.
+  (define system (and=> platform platform-system))
+  (define target (cond
+                  ;; No defined platform, let's use the user defined
+                  ;; system/target parameters.
+                  ((not platform)
+                   (%current-target-system))
+                  ;; The current system is the same as the platform system, no
+                  ;; need to cross-compile.
+                  ((and system
+                        (string=? system (%current-system)))
+                   #f)
+                  ;; If there is a user defined target let's override the
+                  ;; platform target. Otherwise, we can cross-compile to the
+                  ;; platform target.
+                  (else
+                   (or (%current-target-system)
+                       (and=> platform platform-target)))))
 
   (with-parameters ((%current-target-system target))
     (let* ((os (operating-system-for-image image))
@@ -633,6 +776,8 @@ image, depending on IMAGE format."
                             #:register-closures? register-closures?
                             #:inputs `(("system" ,os)
                                        ("bootcfg" ,bootcfg))))
+       ((memq image-format '(docker))
+        (system-docker-image image*))
        ((memq image-format '(iso9660))
          (system-iso9660-image
           image*
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index fc2dbe3209..4c38c46a89 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -23,6 +23,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages ssh)
+  #:use-module (gnu platforms hurd)
   #:use-module (gnu services)
   #:use-module (gnu services ssh)
   #:use-module (gnu system)
@@ -75,7 +76,7 @@
 (define hurd-disk-image
   (image
    (format 'disk-image)
-   (target "i586-pc-gnu")
+   (platform hurd)
    (partitions
     (list (partition
            (size 'guess)
@@ -103,13 +104,15 @@
 (define hurd-barebones-disk-image
   (image
    (inherit
-    (os->image hurd-barebones-os #:type hurd-image-type))
+    (os+platform->image hurd-barebones-os hurd
+                        #:type hurd-image-type))
    (name 'hurd-barebones-disk-image)))
 
 (define hurd-barebones-qcow2-image
   (image
    (inherit
-    (os->image hurd-barebones-os #:type hurd-qcow2-image-type))
+    (os+platform->image hurd-barebones-os hurd
+                        #:type hurd-qcow2-image-type))
    (name 'hurd-barebones.qcow2)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 63227af509..3ce62fbf3b 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -22,6 +22,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -52,12 +53,13 @@
 (define novena-image-type
   (image-type
    (name 'novena-raw)
-   (constructor (cut image-with-os (arm32-disk-image) <>))))
+   (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
 
 (define novena-barebones-raw-image
   (image
    (inherit
-    (os->image novena-barebones-os #:type novena-image-type))
+    (os+platform->image novena-barebones-os armv7-linux
+                        #:type novena-image-type))
    (name 'novena-barebones-raw-image)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 808c71295f..aaec458766 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -57,12 +58,13 @@
 (define pine64-image-type
   (image-type
    (name 'pine64-raw)
-   (constructor (cut image-with-os (arm64-disk-image) <>))))
+   (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
 
 (define pine64-barebones-raw-image
   (image
    (inherit
-    (os->image pine64-barebones-os #:type pine64-image-type))
+    (os+platform->image pine64-barebones-os aarch64-linux
+                        #:type pine64-image-type))
    (name 'pine64-barebones-raw-image)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index b6b844cef6..1bfac7a8bb 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -58,13 +59,14 @@
   (image-type
    (name 'pinebook-pro-raw)
    (constructor (cut image-with-os
-                     (arm64-disk-image (* 9 (expt 2 20))) ;9MiB
+                     (raw-with-offset-disk-image (* 9 (expt 2 20))) ;9MiB
                      <>))))
 
 (define pinebook-pro-barebones-raw-image
   (image
    (inherit
-    (os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type))
+    (os+platform->image pinebook-pro-barebones-os aarch64-linux
+                        #:type pinebook-pro-image-type))
    (name 'pinebook-pro-barebones-raw-image)))
 
 ;; Return the default image.
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index 68d3742adc..d25d55e528 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -21,6 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
+  #:use-module (gnu platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services networking)
@@ -53,12 +54,15 @@
 (define rock64-image-type
   (image-type
    (name 'rock64-raw)
-   (constructor (cut image-with-os (arm64-disk-image (expt 2 24)) <>))))
+   (constructor (cut image-with-os
+                     (raw-with-offset-disk-image (expt 2 24))
+                     <>))))
 
 (define rock64-barebones-raw-image
   (image
    (inherit
-    (os->image rock64-barebones-os #:type rock64-image-type))
+    (os+platform->image rock64-barebones-os aarch64-linux
+                        #:type rock64-image-type))
    (name 'rock64-barebones-raw-image)))
 
 rock64-barebones-raw-image
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 7b394184ad..073d7df1db 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -408,10 +408,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
 
           ;; Loopback device, needed by OpenSSH notably.
           (service static-networking-service-type
-                   (list (static-networking (interface "lo")
-                                            (ip "127.0.0.1")
-                                            (requirement '())
-                                            (provision '(loopback)))))
+                   (list %loopback-static-networking))
 
           (service wpa-supplicant-service-type)
           (dbus-service)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index a083292fcf..c78dd09205 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -288,6 +288,9 @@ FILE-SYSTEMS."
     ,@(if (find (file-system-type-predicate "jfs") file-systems)
           (list jfs_fsck/static)
           '())
+    ,@(if (find (file-system-type-predicate "ntfs") file-systems)
+          (list ntfsfix/static)
+          '())
     ,@(if (find (file-system-type-predicate "f2fs") file-systems)
           (list f2fs-fsck/static)
           '())
@@ -349,7 +352,8 @@ FILE-SYSTEMS."
     "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
     "nls_iso8859-1"                            ;for `mkfs.fat`, et.al
     ,@(if (string-match "^(x86_64|i[3-6]86)-" system)
-          '("pata_acpi" "pata_atiixp"    ;for ATA controllers
+          '("framebuffer_coreboot"       ;for display during early (Core)boot
+            "pata_acpi" "pata_atiixp"    ;for ATA controllers
             "isci")                      ;for SAS controllers like Intel C602
           '())
 
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 18bbe5ba32..b209b9b9cf 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -147,7 +147,6 @@ data format changes between libc versions."
 
 (define %default-locale-libcs
   ;; The libcs for which we build locales by default.
-  ;; List the previous and current libc to ease transition.
   (list glibc))
 
 (define %default-locale-definitions
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 518dbc4fe8..96a381d5fe 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -192,7 +192,8 @@ option of @command{guix system}.\n")
   "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
 'cryptsetup'."
   (with-imported-modules (source-module-closure
-                          '((gnu build file-systems)))
+                          '((gnu build file-systems)
+                            (guix build utils))) ;; For mkdir-p
     (match targets
       ((target)
        #~(let ((source #$(if (uuid? source)
@@ -201,7 +202,12 @@ option of @command{guix system}.\n")
            ;; XXX: 'use-modules' should be at the top level.
            (use-modules (rnrs bytevectors) ;bytevector?
                         ((gnu build file-systems)
-                         #:select (find-partition-by-luks-uuid)))
+                         #:select (find-partition-by-luks-uuid))
+                        ((guix build utils) #:select (mkdir-p)))
+
+           ;; Create '/run/cryptsetup/' if it does not exist, as device locking
+           ;; is mandatory for LUKS2.
+           (mkdir-p "/run/cryptsetup/")
 
            ;; Use 'cryptsetup-static', not 'cryptsetup', to avoid pulling the
            ;; whole world inside the initrd (for when we're in an initrd).
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a31daada59..2574e019f1 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <[email protected]>
+;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <[email protected]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -285,7 +285,7 @@ authenticate to run COMMAND."
           ;; These programs are setuid-root.
           (map (cut unix-pam-service <>
                     #:allow-empty-passwords? allow-empty-passwords?)
-               '("passwd" "sudo"))
+               '("passwd" "chfn" "sudo"))
           ;; This is setuid-root, as well.  Allow root to run "su" without
           ;; authenticating.
           (list (unix-pam-service "su"
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 7c57222716..59f0a02c8b 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016 Alex Griffin <[email protected]>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
 ;;; Copyright © 2020 Efraim Flashner <[email protected]>
+;;; Copyright © 2020 Maxim Cournoyer <[email protected]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -164,7 +165,12 @@ XTerm*utf8: always
 XTerm*metaSendsEscape: true\n"))
         (gdbinit   (plain-file "gdbinit" "\
 # Tell GDB where to look for separate debugging files.
-set debug-file-directory ~/.guix-profile/lib/debug
+guile
+(use-modules (gdb))
+(execute (string-append \"set debug-file-directory \"
+                        (or (getenv \"GDB_DEBUG_FILE_DIRECTORY\")
+                            \"~/.guix-profile/lib/debug\")))
+end
 
 # Authorize extensions found in the store, such as the
 # pretty-printers of libstdc++.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 1e2d8b47c2..c2f7efa966 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -35,7 +35,7 @@
   #:use-module (guix base32)
   #:use-module ((guix self) #:select (make-config.scm))
 
-  #:use-module ((gnu build vm)
+  #:use-module ((gnu build marionette)
                 #:select (qemu-command))
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootloaders)
@@ -51,6 +51,8 @@
 
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
+  #:use-module (gnu image)
+  #:use-module (gnu system image)
   #:use-module (gnu system linux-container)
   #:use-module (gnu system linux-initrd)
   #:use-module (gnu bootloader)
@@ -60,18 +62,13 @@
   #:use-module (gnu services base)
   #:use-module (gnu system uuid)
 
-  #:use-module (srfi srfi-1)
+  #:use-module ((srfi srfi-1) #:hide (partition))
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
 
-  #:export (expression->derivation-in-linux-vm
-            qemu-image
-            virtualized-operating-system
-
-            system-qemu-image/shared-store
+  #:export (virtualized-operating-system
             system-qemu-image/shared-store-script
-            system-docker-image
 
             virtual-machine
             virtual-machine?))
@@ -124,444 +121,6 @@
                            %default-msize-value))
           (check? #f))))
 
-(define not-config?
-  ;; Select (guix …) and (gnu …) modules, except (guix config).
-  (match-lambda
-    (('guix 'config) #f)
-    (('guix rest ...) #t)
-    (('gnu rest ...) #t)
-    (rest #f)))
-
-(define gcrypt-sqlite3&co
-  ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
-  (append-map (lambda (package)
-                (cons package
-                      (match (package-transitive-propagated-inputs package)
-                        (((labels packages) ...)
-                         packages))))
-              (list guile-gcrypt guile-sqlite3)))
-
-(define* (expression->derivation-in-linux-vm name exp
-                                             #:key
-                                             (system (%current-system))
-                                             (linux linux-libre)
-                                             initrd
-                                             (qemu qemu-minimal)
-                                             (env-vars '())
-                                             (guile-for-build
-                                              (%guile-for-build))
-                                             (file-systems
-                                              %linux-vm-file-systems)
-
-                                             (single-file-output? #f)
-                                             (make-disk-image? #f)
-                                             (references-graphs #f)
-                                             (memory-size 256)
-                                             (disk-image-format "qcow2")
-                                             (disk-image-size 'guess)
-
-                                             (substitutable? #t))
-  "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
-derivation).  The virtual machine runs with MEMORY-SIZE MiB of memory.  In the
-virtual machine, EXP has access to FILE-SYSTEMS, which, by default, includes a
-9p share of the store, the '/xchg' where EXP should put its output file(s),
-and a 9p share of /tmp.
-
-If SINGLE-FILE-OUTPUT? is true, copy a single file from '/xchg' to OUTPUT.
-Otherwise, copy the contents of /xchg to a new directory OUTPUT.
-
-When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
-DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
-return it.  When DISK-IMAGE-SIZE is 'guess, estimate the image size based
-based on the size of the closure of REFERENCES-GRAPHS.
-
-When REFERENCES-GRAPHS is true, it must be a list of file name/store path
-pairs, as for `derivation'.  The files containing the reference graphs are
-made available under the /xchg CIFS share.
-
-SUBSTITUTABLE? determines whether the returned derivation should be marked as
-substitutable."
-  (define user-builder
-    (program-file "builder-in-linux-vm" exp))
-
-  (define loader
-    ;; Invoke USER-BUILDER instead using 'primitive-load'.  The reason for
-    ;; this is to allow USER-BUILDER to dlopen stuff by using a full-featured
-    ;; Guile, which it couldn't do using the statically-linked guile used in
-    ;; the initrd.  See example at
-    ;; <https://lists.gnu.org/archive/html/guix-devel/2017-10/msg00233.html>.
-    (program-file "linux-vm-loader"
-                  ;; Communicate USER-BUILDER's exit status via /xchg so that
-                  ;; the host can distinguish between success, failure, and
-                  ;; kernel panic.
-                  #~(let ((status (system* #$user-builder)))
-                      (call-with-output-file "/xchg/.exit-status"
-                        (lambda (port)
-                          (write status port)))
-                      (sync)
-                      (reboot))))
-
-  (define-syntax-rule (check predicate)
-    (let-system (system target)
-      (predicate (or target system))))
-
-  (let ((initrd (or initrd
-                    (base-initrd file-systems
-                                 #:on-error 'backtrace
-                                 #:linux linux
-                                 #:linux-modules %base-initrd-modules
-                                 #:qemu-networking? #t))))
-
-    (define builder
-      ;; Code that launches the VM that evaluates EXP.
-      (with-extensions gcrypt-sqlite3&co
-        (with-imported-modules `(,@(source-module-closure
-                                    '((guix build utils)
-                                      (gnu build vm))
-                                    #:select? not-config?)
-
-                                 ;; For consumption by (gnu store database).
-                                 ((guix config) => ,(make-config.scm)))
-          #~(begin
-              (use-modules (guix build utils)
-                           (gnu build vm))
-
-              ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded
-              ;; by 'estimated-partition-size' below.
-              (setenv "GUIX_LOCPATH"
-                      #+(file-append glibc-utf8-locales "/lib/locale"))
-              (setlocale LC_ALL "en_US.utf8")
-
-              (let* ((native-inputs
-                      '#+(list qemu (canonical-package coreutils)))
-                     (linux   (string-append
-                               #+linux "/"
-                               #+(system-linux-image-file-name system)))
-                     (initrd  #+initrd)
-                     (loader  #+loader)
-                     (graphs  '#$(match references-graphs
-                                   (((graph-files . _) ...) graph-files)
-                                   (_ #f)))
-                     (target  #$(let-system (system target)
-                                  (or target system)))
-                     (size    #$(if (eq? 'guess disk-image-size)
-                                    #~(+ (* 70 (expt 2 20)) ;ESP
-                                         (estimated-partition-size graphs))
-                                    disk-image-size)))
-
-                (set-path-environment-variable "PATH" '("bin") native-inputs)
-
-                (load-in-linux-vm loader
-                                  #:output #$output
-                                  #:linux linux #:initrd initrd
-                                  #:qemu (qemu-command target)
-                                  #:memory-size #$memory-size
-                                  #:make-disk-image? #$make-disk-image?
-                                  #:single-file-output? #$single-file-output?
-                                  #:disk-image-format #$disk-image-format
-                                  #:disk-image-size size
-                                  #:references-graphs graphs))))))
-
-    (gexp->derivation name builder
-                      ;; TODO: Require the "kvm" feature.
-                      #:system system
-                      #:target #f             ;EXP is always executed natively
-                      #:env-vars env-vars
-                      #:guile-for-build guile-for-build
-                      #:references-graphs references-graphs
-                      #:substitutable? substitutable?)))
-
-(define (has-guix-service-type? os)
-  "Return true if OS contains a service of the type GUIX-SERVICE-TYPE."
-  (not (not (find (lambda (service)
-                     (eq? (service-kind service) guix-service-type))
-                   (operating-system-services os)))))
-
-(define* (qemu-image #:key
-                     (name "qemu-image")
-                     (system (%current-system))
-                     (target (%current-target-system))
-                     (qemu qemu-minimal)
-                     (disk-image-size 'guess)
-                     (disk-image-format "qcow2")
-                     (file-system-type "ext4")
-                     (file-system-options '())
-                     (device-nodes 'linux)
-                     (extra-directives '())
-                     file-system-label
-                     file-system-uuid
-                     os
-                     bootcfg-drv
-                     bootloader
-                     (register-closures? (has-guix-service-type? os))
-                     (inputs '())
-                     copy-inputs?
-                     (substitutable? #t))
-  "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
-'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
-Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
-partition; likewise FILE-SYSTEM-UUID, if true, specifies the UUID of the root
-partition (a UUID object).  FILE-SYSTEM-OPTIONS is an optional list of
-command-line options passed to 'mkfs.ext4' (or similar).
-
-The returned image is a full disk image that runs OS-DERIVATION,
-with a GRUB installation that uses GRUB-CONFIGURATION as its configuration
-file (GRUB-CONFIGURATION must be the name of a file in the VM.)
-
-INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
-all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
-register INPUTS in the store database of the image so that Guix can be used in
-the image.  By default, REGISTER-CLOSURES? is set to true only if a service of
-type GUIX-SERVICE-TYPE is present in the services definition of the operating
-system.
-
-When DEVICE-NODES is 'linux, create Linux-device block and character devices
-under /dev.  When it is 'hurd, do Hurdish things.
-
-EXTRA-DIRECTIVES is an optional list of directives to populate the root file
-system that is passed to 'populate-root-file-system'."
-  (define schema
-    (and register-closures?
-         (local-file (search-path %load-path
-                                  "guix/store/schema.sql"))))
-
-  (define preserve-target
-    (if target
-        (lambda (obj)
-          (with-parameters ((%current-target-system target))
-            obj))
-        identity))
-
-  (define inputs*
-    (map (match-lambda
-           ((name thing)
-            `(,name ,(preserve-target thing)))
-           ((name thing output)
-            `(,name ,(preserve-target thing) ,output)))
-         inputs))
-
-  (expression->derivation-in-linux-vm
-   name
-   (with-extensions gcrypt-sqlite3&co
-     (with-imported-modules `(,@(source-module-closure '((gnu build vm)
-                                                         (gnu build bootloader)
-                                                         (gnu build hurd-boot)
-                                                         (guix store database)
-                                                         (guix build utils))
-                                                       #:select? not-config?)
-                              ((guix config) => ,(make-config.scm)))
-       #~(begin
-           (use-modules (gnu build bootloader)
-                        (gnu build vm)
-                        ((gnu build hurd-boot)
-                         #:select (make-hurd-device-nodes))
-                        ((gnu build linux-boot)
-                         #:select (make-essential-device-nodes))
-                        (guix store database)
-                        (guix build utils)
-                        (srfi srfi-26)
-                        (ice-9 binary-ports))
-
-           (sql-schema #$schema)
-
-           ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
-           (setenv "GUIX_LOCPATH"
-                   #+(file-append glibc-utf8-locales "/lib/locale"))
-           (setlocale LC_ALL "en_US.utf8")
-
-           (let ((inputs
-                  '#+(append (list parted e2fsprogs dosfstools)
-                             (map canonical-package
-                                  (list sed grep coreutils findutils gawk))))
-
-                 ;; This variable is unused but allows us to add INPUTS-TO-COPY
-                 ;; as inputs.
-                 (to-register
-                  '#$(map (match-lambda
-                            ((name thing) thing)
-                            ((name thing output) `(,thing ,output)))
-                          inputs*)))
-
-             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
-             (let* ((graphs     '#$(match inputs
-                                     (((names . _) ...)
-                                      names)))
-                    (initialize (root-partition-initializer
-                                 #:extra-directives '#$extra-directives
-                                 #:closures graphs
-                                 #:copy-closures? #$copy-inputs?
-                                 #:register-closures? #$register-closures?
-                                 #:system-directory #$(preserve-target os)
-
-                                 #:make-device-nodes
-                                 #$(match device-nodes
-                                     ('linux #~make-essential-device-nodes)
-                                     ('hurd #~make-hurd-device-nodes))
-
-                                 ;; Disable deduplication to speed things up,
-                                 ;; and because it doesn't help much for a
-                                 ;; single system generation.
-                                 #:deduplicate? #f))
-                    (root-size  #$(if (eq? 'guess disk-image-size)
-                                      #~(max
-                                         ;; Minimum 20 MiB root size
-                                         (* 20 (expt 2 20))
-                                         (estimated-partition-size
-                                          (map (cut string-append "/xchg/" <>)
-                                               graphs)))
-                                      (- disk-image-size
-                                         (* 50 (expt 2 20)))))
-                    (partitions
-                     (append
-                      (list (partition
-                             (size root-size)
-                             (label #$file-system-label)
-                             (uuid #$(and=> file-system-uuid
-                                            uuid-bytevector))
-                             (file-system #$file-system-type)
-                             (file-system-options '#$file-system-options)
-                             (flags '(boot))
-                             (initializer initialize)))
-                      ;; Append a small EFI System Partition for use with UEFI
-                      ;; bootloaders if we are not targeting ARM because UEFI
-                      ;; support in U-Boot is experimental.
-                      ;;
-                      ;; FIXME: ‘target-arm?’ may be not operate on the right
-                      ;; system/target values.  Rewrite using ‘let-system’ when
-                      ;; available.
-                      (if #$(target-arm?)
-                          '()
-                          (list (partition
-                                 ;; The standalone grub image is about 10MiB, but
-                                 ;; leave some room for custom or multiple images.
-                                 (size (* 40 (expt 2 20)))
-                                 (label "GNU-ESP") ;cosmetic only
-                                 ;; Use "vfat" here since this property is used
-                                 ;; when mounting. The actual FAT-ness is based
-                                 ;; on file system size (16 in this case).
-                                 (file-system "vfat")
-                                 (flags '(esp)))))))
-                    (grub-efi #$(and (not (target-arm?)) grub-efi)))
-               (initialize-hard-disk "/dev/vda"
-                                     #:partitions partitions
-                                     #:grub-efi grub-efi
-                                     #:bootloader-package
-                                     #+(bootloader-package bootloader)
-                                     #:bootcfg #$(preserve-target bootcfg-drv)
-                                     #:bootcfg-location
-                                     #$(bootloader-configuration-file bootloader)
-                                     #:bootloader-installer
-                                     #+(bootloader-installer bootloader)))))))
-   #:system system
-   #:make-disk-image? #t
-   #:disk-image-size disk-image-size
-   #:disk-image-format disk-image-format
-   #:references-graphs inputs*
-   #:substitutable? substitutable?))
-
-(define* (system-docker-image os
-                              #:key
-                              (name "guix-docker-image")
-                              (memory-size 256)
-                              (register-closures? (has-guix-service-type? os))
-                              shared-network?)
-  "Build a docker image.  OS is the desired <operating-system>.  NAME is the
-base name to use for the output file.  When SHARED-NETWORK? is true, assume
-that the container will share network with the host and thus doesn't need a
-DHCP client, nscd, and so on.
-
-When REGISTER-CLOSURES? is true, register the closure of OS with Guix in the
-resulting Docker image.  By default, REGISTER-CLOSURES? is set to true only if
-a service of type GUIX-SERVICE-TYPE is present in the services definition of
-the operating system."
-  (define schema
-    (and register-closures?
-         (local-file (search-path %load-path
-                                  "guix/store/schema.sql"))))
-
-  (define boot-program
-    ;; Program that runs the boot script of OS, which in turn starts shepherd.
-    (program-file "boot-program"
-                  #~(let ((system (cadr (command-line))))
-                      (setenv "GUIX_NEW_SYSTEM" system)
-                      (execl #$(file-append guile-3.0 "/bin/guile")
-                             "guile" "--no-auto-compile"
-                             (string-append system "/boot")))))
-
-
-  (let ((os    (operating-system-with-gc-roots
-                (containerized-operating-system os '()
-                                                #:shared-network?
-                                                shared-network?)
-                (list boot-program)))
-        (name  (string-append name ".tar.gz"))
-        (graph "system-graph"))
-    (define build
-      (with-extensions (cons guile-json-3         ;for (guix docker)
-                             gcrypt-sqlite3&co)   ;for (guix store database)
-        (with-imported-modules `(,@(source-module-closure
-                                    '((guix docker)
-                                      (guix store database)
-                                      (guix build utils)
-                                      (guix build store-copy)
-                                      (gnu build vm))
-                                    #:select? not-config?)
-                                 ((guix config) => ,(make-config.scm)))
-          #~(begin
-              (use-modules (guix docker)
-                           (guix build utils)
-                           (gnu build vm)
-                           (srfi srfi-19)
-                           (guix build store-copy)
-                           (guix store database))
-
-              ;; Set the SQL schema location.
-              (sql-schema #$schema)
-
-              ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded.
-              (setenv "GUIX_LOCPATH"
-                      #+(file-append glibc-utf8-locales "/lib/locale"))
-              (setlocale LC_ALL "en_US.utf8")
-
-              (let* (;; This initializer requires elevated privileges that are
-                     ;; not normally available in the build environment (e.g.,
-                     ;; it needs to create device nodes).  In order to obtain
-                     ;; such privileges, we run it as root in a VM.
-                     (initialize (root-partition-initializer
-                                  #:closures '(#$graph)
-                                  #:register-closures? #$register-closures?
-                                  #:system-directory #$os
-                                  ;; De-duplication would fail due to
-                                  ;; cross-device link errors, so don't do it.
-                                  #:deduplicate? #f))
-                     ;; Even as root in a VM, the initializer would fail due to
-                     ;; lack of privileges if we use a root-directory that is on
-                     ;; a file system that is shared with the host (e.g., /tmp).
-                     (root-directory "/guixsd-system-root"))
-                (set-path-environment-variable "PATH" '("bin" "sbin") '(#+tar))
-                (mkdir root-directory)
-                (initialize root-directory)
-                (build-docker-image
-                 (string-append "/xchg/" #$name) ;; The output file.
-                 (cons* root-directory
-                        (map store-info-item
-                             (call-with-input-file
-                                 (string-append "/xchg/" #$graph)
-                               read-reference-graph)))
-                 #$os
-                 #:entry-point '(#$boot-program #$os)
-                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
-                 #:creation-time (make-time time-utc 0 1)
-                 #:transformations `((,root-directory -> ""))))))))
-
-    (expression->derivation-in-linux-vm
-     name build
-     #:memory-size memory-size
-     #:make-disk-image? #f
-     #:single-file-output? #t
-     #:references-graphs `((,graph ,os)))))
-
 
 ;;;
 ;;; VMs that share file systems with the host.
@@ -592,7 +151,8 @@ the operating system."
        (check? #f)
        (create-mount-point? #t)))))
 
-(define* (virtualized-operating-system os mappings #:optional (full-boot? #f))
+(define* (virtualized-operating-system os mappings
+                                       #:key (full-boot? #f) volatile?)
   "Return an operating system based on OS suitable for use in a virtualized
 environment with the store shared with the host.  MAPPINGS is a list of
 <file-system-mapping> to realize in the virtualized OS."
@@ -635,7 +195,7 @@ environment with the store shared with the host.  MAPPINGS is a list of
     (initrd (lambda (file-systems . rest)
               (apply (operating-system-initrd os)
                      file-systems
-                     #:volatile-root? #t
+                     #:volatile-root? volatile?
                      rest)))
 
     ;; Disable swap.
@@ -652,47 +212,8 @@ environment with the store shared with the host.  MAPPINGS is a list of
                          (needed-for-boot? #t))
                        virtual-file-systems)))))
 
-(define* (system-qemu-image/shared-store
-          os
-          #:key
-          (system (%current-system))
-          (target (%current-target-system))
-          full-boot?
-          (disk-image-size (* (if full-boot? 500 30) (expt 2 20))))
-  "Return a derivation that builds a QEMU image of OS that shares its store
-with the host.
-
-When FULL-BOOT? is true, return an image that does a complete boot sequence,
-bootloaded included; thus, make a disk image that contains everything the
-bootloader refers to: OS kernel, initrd, bootloader data, etc."
-  (define root-uuid
-    ;; Use a fixed UUID to improve determinism.
-    (operating-system-uuid os 'dce))
-
-  (define bootcfg
-    (operating-system-bootcfg os))
-
-  ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
-  ;; BOOTCFG and all its dependencies, including the output of OS.
-  ;; This is more than needed (we only need the kernel, initrd, GRUB for its
-  ;; font, and the background image), but it's hard to filter that.
-  (qemu-image #:os os
-              #:system system
-              #:target target
-              #:bootcfg-drv bootcfg
-              #:bootloader (bootloader-configuration-bootloader
-                            (operating-system-bootloader os))
-              #:disk-image-size disk-image-size
-              #:file-system-uuid root-uuid
-              #:inputs (if full-boot?
-                           `(("bootcfg" ,bootcfg))
-                           '())
-
-              ;; XXX: Passing #t here is too slow, so let it off by default.
-              #:register-closures? #f
-              #:copy-inputs? full-boot?))
-
-(define* (common-qemu-options image shared-fs)
+(define* (common-qemu-options image shared-fs
+                              #:key rw-image?)
   "Return the a string-value gexp with the common QEMU options to boot IMAGE,
 with '-virtfs' options for the host file systems listed in SHARED-FS."
 
@@ -708,13 +229,14 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
             '())
 
      "-no-reboot"
-     "-object" "rng-random,filename=/dev/urandom,id=guixsd-vm-rng"
-     "-device" "virtio-rng-pci,rng=guixsd-vm-rng"
+     "-object" "rng-random,filename=/dev/urandom,id=guix-vm-rng"
+     "-device" "virtio-rng-pci,rng=guix-vm-rng"
 
      #$@(map virtfs-option shared-fs)
-     "-vga std"
-     (format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on"
-             #$image)))
+     #$@(if rw-image?
+            #~((format #f "-drive file=~a,if=virtio" #$image))
+            #~((format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on"
+                       #$image)))))
 
 (define* (system-qemu-image/shared-store-script os
                                                 #:key
@@ -722,7 +244,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
                                                 (target (%current-target-system))
                                                 (qemu qemu)
                                                 (graphic? #t)
-                                                (memory-size 256)
+                                                (volatile? #t)
+                                                (memory-size 512)
                                                 (mappings '())
                                                 full-boot?
                                                 (disk-image-size
@@ -737,40 +260,61 @@ MAPPINGS is a list of <file-system-mapping> specifying mapping of host file
 systems into the guest.
 
 When FULL-BOOT? is true, the returned script runs everything starting from the
-bootloader; otherwise it directly starts the operating system kernel.  The
-DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
-it is mostly useful when FULL-BOOT?  is true."
-  (mlet* %store-monad ((os ->  (virtualized-operating-system os mappings full-boot?))
-                       (image  (system-qemu-image/shared-store
-                                os
-                                #:system system
-                                #:target target
+bootloader; otherwise it directly starts the operating system kernel.  When
+VOLATILE? is true, an overlay is created on top of a read-only
+storage. Otherwise the storage is made persistent.  The DISK-IMAGE-SIZE
+parameter specifies the size in bytes of the root disk image; it is mostly
+useful when FULL-BOOT?  is true."
+  (mlet* %store-monad ((os ->  (virtualized-operating-system
+                                os mappings
                                 #:full-boot? full-boot?
-                                #:disk-image-size disk-image-size)))
+                                #:volatile? volatile?))
+                       (base-image -> (system-image
+                                       (image
+                                        (inherit
+                                         (raw-with-offset-disk-image))
+                                        (operating-system os)
+                                        (size disk-image-size)
+                                        (shared-store?
+                                         (and (not full-boot?) volatile?))
+                                        (volatile-root? volatile?)))))
     (define kernel-arguments
       #~(list #$@(if graphic? #~() #~("console=ttyS0"))
               #+@(operating-system-kernel-arguments os "/dev/vda1")))
 
+    (define rw-image
+      #~(format #f "/tmp/guix-image-~a" (basename #$base-image)))
+
     (define qemu-exec
       #~(list #+(file-append qemu "/bin/"
                              (qemu-command (or target system)))
+              ;; Tells qemu to use the terminal it was started in for IO.
+              #$@(if graphic? '() #~("-nographic"))
               #$@(if full-boot?
                      #~()
                      #~("-kernel" #$(operating-system-kernel-file os)
                         "-initrd" #$(file-append os "/initrd")
                         (format #f "-append ~s"
                                 (string-join #$kernel-arguments " "))))
-              #$@(common-qemu-options image
+              #$@(common-qemu-options (if volatile? base-image rw-image)
                                       (map file-system-mapping-source
-                                           (cons %store-mapping mappings)))
+                                           (cons %store-mapping mappings))
+                                      #:rw-image? (not volatile?))
               "-m " (number->string #$memory-size)
               #$@options))
 
     (define builder
       #~(call-with-output-file #$output
           (lambda (port)
-            (format port "#!~a~% exec ~a \"$@\"~%"
-                    #+(file-append bash "/bin/sh")
+            (format port "#!~a~%"
+                    #+(file-append bash "/bin/sh"))
+            (when (not #$volatile?)
+              (format port "~a~%"
+                      #$(program-file "copy-image"
+                                      #~(unless (file-exists? #$rw-image)
+                                          (copy-file #$base-image #$rw-image)
+                                          (chmod #$rw-image #o640)))))
+            (format port "exec ~a \"$@\"~%"
                     (string-join #$qemu-exec " "))
             (chmod port #o555))))
 
@@ -786,7 +330,9 @@ it is mostly useful when FULL-BOOT?  is true."
   virtual-machine?
   (operating-system virtual-machine-operating-system) ;<operating-system>
   (qemu             virtual-machine-qemu              ;<package>
-                    (default qemu))
+                    (default qemu-minimal))
+  (volatile?        virtual-machine-volatile?    ;Boolean
+                    (default #t))
   (graphic?         virtual-machine-graphic?      ;Boolean
                     (default #f))
   (memory-size      virtual-machine-memory-size   ;integer (MiB)
@@ -820,17 +366,19 @@ FORWARDINGS is a list of host-port/guest-port pairs."
 (define-gexp-compiler (virtual-machine-compiler (vm <virtual-machine>)
                                                 system target)
   (match vm
-    (($ <virtual-machine> os qemu graphic? memory-size disk-image-size ())
+    (($ <virtual-machine> os qemu volatile? graphic? memory-size
+                          disk-image-size ())
      (system-qemu-image/shared-store-script os
                                             #:system system
                                             #:target target
                                             #:qemu qemu
                                             #:graphic? graphic?
+                                            #:volatile? volatile?
                                             #:memory-size memory-size
                                             #:disk-image-size
                                             disk-image-size))
-    (($ <virtual-machine> os qemu graphic? memory-size disk-image-size
-                          forwardings)
+    (($ <virtual-machine> os qemu volatile? graphic? memory-size
+                          disk-image-size forwardings)
      (let ((options
             `("-nic" ,(string-append
                        "user,model=virtio-net-pci,"
@@ -840,6 +388,7 @@ FORWARDINGS is a list of host-port/guest-port pairs."
                                               #:target target
                                               #:qemu qemu
                                               #:graphic? graphic?
+                                              #:volatile? volatile?
                                               #:memory-size memory-size
                                               #:disk-image-size
                                               disk-image-size