diff --git a/gnu/build/image.scm b/gnu/build/image.scm
new file mode 100644
index 0000000000..7c47bda344
--- /dev/null
+++ b/gnu/build/image.scm
@@ -0,0 +1,275 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu build image)
+  #:use-module (guix build store-copy)
+  #:use-module (guix build syscalls)
+  #:use-module (guix build utils)
+  #:use-module (guix store database)
+  #:use-module (gnu build bootloader)
+  #:use-module (gnu build install)
+  #:use-module (gnu build linux-boot)
+  #:use-module (gnu image)
+  #:use-module (gnu system uuid)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (make-partition-image
+            genimage
+            initialize-efi-partition
+            initialize-root-partition
+
+            make-iso9660-image))
+
+(define (sexp->partition sexp)
+  "Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
+<partition> record."
+  (match sexp
+    ((size file-system label uuid)
+     (partition (size size)
+                (file-system file-system)
+                (label label)
+                (uuid uuid)))))
+
+(define (size-in-kib size)
+  "Convert SIZE expressed in bytes, to kilobytes and return it as a string."
+  (number->string
+   (inexact->exact (ceiling (/ size 1024)))))
+
+(define (root-size root)
+  "Given the ROOT directory, evalute and return its size. As this doesn't take
+the partition metadata size into account, take a 25% margin."
+  (* 1.25 (file-size root)))
+
+(define* (make-ext4-image partition target root
+                          #:key (owner 0))
+  "Handle the creation of EXT4 partition images. See 'make-partition-image'."
+  (let ((size (partition-size partition))
+        (label (partition-label partition))
+        (uuid (partition-uuid partition))
+        (options "lazy_itable_init=1,lazy_journal_init=1"))
+    (invoke "mke2fs" "-t" "ext4" "-d" root
+            "-L" label "-U" (uuid->string uuid)
+            "-E" (format #f "root_owner=~a:~a,~a"
+                         owner owner options)
+            target
+            (format #f "~ak"
+                    (size-in-kib
+                     (if (eq? size 'guess)
+                         (root-size root)
+                         size))))))
+
+(define* (make-vfat-image partition target root)
+  "Handle the creation of VFAT partition images. See 'make-partition-image'."
+  (let ((size (partition-size partition))
+        (label (partition-label partition)))
+    (invoke "mkdosfs" "-n" label "-C" target "-F" "16" "-S" "1024"
+            (size-in-kib
+             (if (eq? size 'guess)
+                 (root-size root)
+                 size)))
+    (for-each (lambda (file)
+                (unless (member file '("." ".."))
+                  (invoke "mcopy" "-bsp" "-i" target
+                          (string-append root "/" file)
+                          (string-append "::" file))))
+              (scandir root))))
+
+(define* (make-partition-image partition-sexp target root)
+  "Create and return the image of PARTITION-SEXP as TARGET. Use the given ROOT
+directory to populate the image."
+  (let* ((partition (sexp->partition partition-sexp))
+         (type (partition-file-system partition)))
+    (cond
+     ((string=? type "ext4")
+      (make-ext4-image partition target root))
+     ((string=? type "vfat")
+      (make-vfat-image partition target root))
+     (else
+      (format (current-error-port)
+              "Unsupported partition type~%.")))))
+
+(define* (genimage config target)
+  "Use genimage to generate in TARGET directory, the image described in the
+given CONFIG file."
+  ;; genimage needs a 'root' directory.
+  (mkdir "root")
+  (invoke "genimage" "--config" config
+          "--outputpath" target))
+
+(define* (initialize-efi-partition root
+                                   #:key
+                                   bootloader-package
+                                   #:allow-other-keys)
+  "Install in ROOT directory, an EFI loader using BOOTLOADER-PACKAGE."
+  (install-efi-loader bootloader-package root))
+
+(define (register-bootcfg-root target bootcfg)
+  "On file system TARGET, register BOOTCFG as a GC root."
+  (let ((directory (string-append target "/var/guix/gcroots")))
+    (mkdir-p directory)
+    (symlink bootcfg (string-append directory "/bootcfg"))))
+
+(define* (register-closure prefix closure
+                           #:key
+                           (deduplicate? #t) (reset-timestamps? #t)
+                           (schema (sql-schema)))
+  "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
+target store and CLOSURE is the name of a file containing a reference graph as
+produced by #:references-graphs..  As a side effect, if RESET-TIMESTAMPS? is
+true, reset timestamps on store files and, if DEDUPLICATE? is true,
+deduplicates files common to CLOSURE and the rest of PREFIX."
+  (let ((items (call-with-input-file closure read-reference-graph)))
+    (register-items items
+                    #:prefix prefix
+                    #:deduplicate? deduplicate?
+                    #:reset-timestamps? reset-timestamps?
+                    #:registration-time %epoch
+                    #:schema schema)))
+
+(define* (initialize-root-partition root
+                                    #:key
+                                    bootcfg
+                                    bootcfg-location
+                                    (deduplicate? #t)
+                                    references-graphs
+                                    (register-closures? #t)
+                                    system-directory
+                                    #:allow-other-keys)
+  "Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to
+install the bootloader configuration.
+
+If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store.  If
+DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the
+rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
+of the directory of the 'system' derivation."
+  (populate-root-file-system system-directory root)
+  (populate-store references-graphs root)
+
+  (when register-closures?
+    (for-each (lambda (closure)
+                (register-closure root
+                                  closure
+                                  #:reset-timestamps? #t
+                                  #:deduplicate? deduplicate?))
+              references-graphs))
+
+  (when bootcfg
+    (install-boot-config bootcfg bootcfg-location root)
+
+    ;; Register BOOTCFG as a GC root.
+    (register-bootcfg-root root bootcfg)))
+
+(define* (make-iso9660-image xorriso grub-mkrescue-environment
+                             grub bootcfg system-directory root target
+                             #:key (volume-id "Guix_image") (volume-uuid #f)
+                             register-closures? (references-graphs '())
+                             (compression? #t))
+  "Given a GRUB package, creates an iso image as TARGET, using BOOTCFG as
+GRUB configuration and OS-DRV as the stuff in it."
+  (define grub-mkrescue
+    (string-append grub "/bin/grub-mkrescue"))
+
+  (define grub-mkrescue-sed.sh
+    (string-append (getcwd) "/" "grub-mkrescue-sed.sh"))
+
+  ;; Use a modified version of grub-mkrescue-sed.sh, see below.
+  (copy-file (string-append xorriso
+                            "/bin/grub-mkrescue-sed.sh")
+             grub-mkrescue-sed.sh)
+
+  ;; Force grub-mkrescue-sed.sh to use the build directory instead of /tmp
+  ;; that is read-only inside the build container.
+  (substitute* grub-mkrescue-sed.sh
+    (("/tmp/") (string-append (getcwd) "/"))
+    (("MKRESCUE_SED_XORRISO_ARGS \\$x")
+     (format #f "MKRESCUE_SED_XORRISO_ARGS $(echo $x | sed \"s|/tmp|~a|\")"
+             (getcwd))))
+
+  ;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT
+  ;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of
+  ;; those files.  The epoch for FAT is Jan. 1st 1980, not 1970, so choose
+  ;; that.
+  (setenv "SOURCE_DATE_EPOCH"
+          (number->string
+           (time-second
+            (date->time-utc (make-date 0 0 0 0 1 1 1980 0)))))
+
+  ;; Our patched 'grub-mkrescue' honors this environment variable and passes
+  ;; it to 'mformat', which makes it the serial number of 'efi.img'.  This
+  ;; allows for deterministic builds.
+  (setenv "GRUB_FAT_SERIAL_NUMBER"
+          (number->string (if volume-uuid
+
+                              ;; On 32-bit systems the 2nd argument must be
+                              ;; lower than 2^32.
+                              (string-hash (iso9660-uuid->string volume-uuid)
+                                           (- (expt 2 32) 1))
+
+                              #x77777777)
+                          16))
+
+  (setenv "MKRESCUE_SED_MODE" "original")
+  (setenv "MKRESCUE_SED_XORRISO" (string-append xorriso "/bin/xorriso"))
+  (setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes")
+
+  (for-each (match-lambda
+              ((name . value) (setenv name value)))
+            grub-mkrescue-environment)
+
+  (apply invoke grub-mkrescue
+         (string-append "--xorriso=" grub-mkrescue-sed.sh)
+         "-o" target
+         (string-append "boot/grub/grub.cfg=" bootcfg)
+         root
+         "--"
+         ;; Set all timestamps to 1.
+         "-volume_date" "all_file_dates" "=1"
+
+         `(,@(if compression?
+                 '(;; ‘zisofs’ compression reduces the total image size by
+                   ;; ~60%.
+                   "-zisofs" "level=9:block_size=128k" ; highest compression
+                   ;; It's transparent to our Linux-Libre kernel but not to
+                   ;; GRUB.  Don't compress the kernel, initrd, and other
+                   ;; files read by grub.cfg, as well as common
+                   ;; already-compressed file names.
+                   "-find" "/" "-type" "f"
+                   ;; XXX Even after "--" above, and despite documentation
+                   ;; claiming otherwise, "-or" is stolen by grub-mkrescue
+                   ;; which then chokes on it (as ‘-o …’) and dies.  Don't use
+                   ;; "-or".
+                   "-not" "-wholename" "/boot/*"
+                   "-not" "-wholename" "/System/*"
+                   "-not" "-name" "unicode.pf2"
+                   "-not" "-name" "bzImage"
+                   "-not" "-name" "*.gz"   ; initrd & all man pages
+                   "-not" "-name" "*.png"  ; includes grub-image.png
+                   "-exec" "set_filter" "--zisofs"
+                   "--")
+                 '())
+           "-volid" ,(string-upcase volume-id)
+           ,@(if volume-uuid
+             `("-volume_date" "uuid"
+               ,(string-filter (lambda (value)
+                                 (not (char=? #\- value)))
+                               (iso9660-uuid->string
+                                volume-uuid)))
+             '()))))
diff --git a/gnu/ci.scm b/gnu/ci.scm
index fb2596c809..0430cf594b 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -38,6 +38,7 @@
                 #:select (lookup-compressor self-contained-tarball))
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader u-boot)
+  #:use-module (gnu image)
   #:use-module (gnu packages)
   #:use-module (gnu packages gcc)
   #:use-module (gnu packages base)
@@ -49,6 +50,7 @@
   #:use-module (gnu packages make-bootstrap)
   #:use-module (gnu packages package-management)
   #:use-module (gnu system)
+  #:use-module (gnu system image)
   #:use-module (gnu system vm)
   #:use-module (gnu system install)
   #:use-module (gnu tests)
@@ -209,32 +211,23 @@ system.")
     (expt 2 20))
 
   (if (member system %guixsd-supported-systems)
-      (if (member system %u-boot-systems)
-          (list (->job 'flash-image
-                       (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (system-disk-image
-                            (operating-system (inherit installation-os)
-                             (bootloader (bootloader-configuration
-                                          (bootloader u-boot-bootloader)
-                                          (target #f))))
-                            #:disk-image-size
-                            (* 1500 MiB))))))
-          (list (->job 'usb-image
-                       (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (system-disk-image installation-os
-                                              #:disk-image-size
-                                              (* 1500 MiB)))))
-                (->job 'iso9660-image
-                       (run-with-store store
-                         (mbegin %store-monad
-                           (set-guile-for-build (default-guile))
-                           (system-disk-image installation-os
-                                              #:file-system-type
-                                              "iso9660"))))))
+      (list (->job 'usb-image
+                   (run-with-store store
+                     (mbegin %store-monad
+                       (set-guile-for-build (default-guile))
+                       (system-image
+                        (image
+                         (inherit efi-disk-image)
+                         (size (* 1500 MiB))
+                         (operating-system installation-os))))))
+            (->job 'iso9660-image
+                   (run-with-store store
+                     (mbegin %store-monad
+                       (set-guile-for-build (default-guile))
+                       (system-image
+                        (image
+                         (inherit iso9660-image)
+                         (operating-system installation-os)))))))
       '()))
 
 (define channel-build-system
diff --git a/gnu/image.scm b/gnu/image.scm
new file mode 100644
index 0000000000..e250741c98
--- /dev/null
+++ b/gnu/image.scm
@@ -0,0 +1,77 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu image)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:export (partition
+            partition?
+            partition-device
+            partition-size
+            partition-file-system
+            partition-label
+            partition-uuid
+            partition-flags
+            partition-initializer
+
+            image
+            image-name
+            image-format
+            image-size
+            image-operating-system
+            image-partitions
+            image-compression?
+            image-volatile-root?
+            image-substitutable?))
+
+
+;;;
+;;; Partition record.
+;;;
+
+(define-record-type* <partition> partition make-partition
+  partition?
+  (device      partition-device (default #f))
+  (size        partition-size)
+  (file-system partition-file-system (default "ext4"))
+  (label       partition-label (default #f))
+  (uuid        partition-uuid (default #f))
+  (flags       partition-flags (default '()))
+  (initializer partition-initializer (default #f)))
+
+
+;;;
+;;; Image record.
+;;;
+
+(define-record-type* <image>
+  image make-image
+  image?
+  (format             image-format) ;symbol
+  (size               image-size  ;size in bytes as integer
+                      (default 'guess))
+  (operating-system   image-operating-system  ;<operating-system>
+                      (default #f))
+  (partitions         image-partitions ;list of <partition>
+                      (default '()))
+  (compression?       image-compression? ;boolean
+                      (default #t))
+  (volatile-root?     image-volatile-root? ;boolean
+                      (default #t))
+  (substitutable?     image-substitutable? ;boolean
+                      (default #t)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 9f212434a9..408063a36e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -61,6 +61,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/bootloader/u-boot.scm                     \
   %D%/bootloader/depthcharge.scm                \
   %D%/ci.scm					\
+  %D%/image.scm					\
   %D%/packages.scm				\
   %D%/packages/abduco.scm			\
   %D%/packages/abiword.scm			\
@@ -602,6 +603,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/system.scm				\
   %D%/system/accounts.scm			\
   %D%/system/file-systems.scm			\
+  %D%/system/image.scm 				\
   %D%/system/install.scm			\
   %D%/system/keyboard.scm			\
   %D%/system/linux-container.scm		\
@@ -622,6 +624,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/activation.scm			\
   %D%/build/bootloader.scm			\
   %D%/build/cross-toolchain.scm			\
+  %D%/build/image.scm				\
   %D%/build/file-systems.scm			\
   %D%/build/install.scm				\
   %D%/build/linux-boot.scm			\
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
new file mode 100644
index 0000000000..d4d2e2eb79
--- /dev/null
+++ b/gnu/system/image.scm
@@ -0,0 +1,514 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system image)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix records)
+  #:use-module (guix utils)
+  #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu image)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #: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 disk)
+  #:use-module (gnu packages gawk)
+  #:use-module (gnu packages genimage)
+  #:use-module (gnu packages guile)
+  #:autoload   (gnu packages gnupg) (guile-gcrypt)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages mtools)
+  #:use-module ((srfi srfi-1) #:prefix scm:)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:export (esp-partition
+            root-partition
+
+            efi-disk-image
+            iso9660-image
+
+            find-image
+            system-image))
+
+
+;;;
+;;; Images definitions.
+;;;
+
+(define esp-partition
+  (partition
+   (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))
+   (initializer (gexp initialize-efi-partition))))
+
+(define root-partition
+  (partition
+   (size 'guess)
+   (label "Guix_image")
+   (file-system "ext4")
+   (flags '(boot))
+   (initializer (gexp initialize-root-partition))))
+
+(define efi-disk-image
+  (image
+   (format 'disk-image)
+   (partitions (list esp-partition root-partition))))
+
+(define iso9660-image
+  (image
+   (format 'iso9660)
+   (partitions
+    (list (partition
+           (size 'guess)
+           (label "GUIX_IMAGE")
+           (flags '(boot)))))
+   ;; XXX: Temporarily disable compression to speed-up the tests.
+   (compression? #f)))
+
+
+;;
+;; Helpers.
+;;
+
+(define (root-uuid image)
+  ;; UUID of the root file system, computed in a deterministic fashion.
+  ;; This is what we use to locate the root file system so it has to be
+  ;; different from the user's own file system UUIDs.
+  (let ((os (image-operating-system image))
+        (type (if (eq? (image-format image) 'iso9660)
+                  'iso9660
+                  'dce)))
+    (operating-system-uuid os type)))
+
+(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 (partition->gexp partition)
+  "Turn PARTITION, a <partition> object, into a list-valued gexp suitable for
+'make-partition-image'."
+  #~'(#$@(list (partition-size partition))
+      #$(partition-file-system partition)
+      #$(partition-label partition)
+      #$(and=> (partition-uuid partition)
+               uuid-bytevector)))
+
+(define gcrypt-sqlite3&co
+  ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
+  (scm:append-map
+   (lambda (package)
+     (cons package
+           (match (package-transitive-propagated-inputs package)
+             (((labels packages) ...)
+              packages))))
+   (list guile-gcrypt guile-sqlite3)))
+
+(define-syntax-rule (with-imported-modules* exp ...)
+  (with-extensions gcrypt-sqlite3&co
+    (with-imported-modules `(,@(source-module-closure
+                                '((gnu build vm)
+                                  (gnu build image)
+                                  (guix store database))
+                                #:select? not-config?)
+                             ((guix config) => ,(make-config.scm)))
+      #~(begin
+          (use-modules (gnu build vm)
+                       (gnu build image)
+                       (guix store database)
+                       (guix build utils))
+          exp ...))))
+
+
+;;
+;; Disk image.
+;;
+
+(define* (system-disk-image image
+                            #:key
+                            (name "disk-image")
+                            bootcfg
+                            bootloader
+                            register-closures?
+                            (inputs '()))
+  "Return the derivation of the disk-image described by IMAGE. Said image can
+be copied on a USB stick as is. BOOTLOADER is the bootloader that will be
+installed and configured according to BOOTCFG parameter.
+
+Raw images of the IMAGE partitions are first created. Then, genimage is used
+to assemble the partition images into a disk-image without resorting to a
+virtual machine.
+
+INPUTS is a list of inputs (as for packages).  When REGISTER-CLOSURES? is
+true, register INPUTS in the store database of the image so that Guix can be
+used in the image."
+
+  (define genimage-name "image")
+
+  (define (image->genimage-cfg image)
+    "Return as a file-like object, the genimage configuration file describing
+the given IMAGE."
+    (define (format->image-type format)
+      "Return the genimage format corresponding to FORMAT. For now, only the
+hdimage format (raw disk-image) is supported."
+      (case format
+        ((disk-image) "hdimage")
+        (else
+         (error
+          (format #f "Unsupported image type ~a~%." format)))))
+
+    (define (partition->dos-type partition)
+      "Return the MBR partition type corresponding to the given PARTITION.
+See: https://en.wikipedia.org/wiki/Partition_type."
+      (let ((flags (partition-flags partition)))
+        (cond
+         ((member 'esp flags) "0xEF")
+         (else "0x83"))))
+
+    (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 first
+created within the store.  Then, an image of this directory is created using
+tools such as 'mke2fs' or 'mkdosfs', depending on the partition file-system
+type."
+      (let* ((os (image-operating-system image))
+             (schema (local-file (search-path %load-path
+                                              "guix/store/schema.sql")))
+             (graph (match inputs
+                      (((names . _) ...)
+                       names)))
+             (root-builder
+              (with-imported-modules*
+               (let* ((initializer #$(partition-initializer partition)))
+                 (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")
+
+                 (initializer #$output
+                              #:references-graphs '#$graph
+                              #:deduplicate? #f
+                              #:system-directory #$os
+                              #:bootloader-package
+                              #$(bootloader-package bootloader)
+                              #:bootcfg #$bootcfg
+                              #:bootcfg-location
+                              #$(bootloader-configuration-file bootloader)))))
+             (image-root
+              (computed-file "partition-image-root" root-builder
+                             #:options `(#:references-graphs ,inputs)))
+             (type (partition-file-system partition))
+             (image-builder
+              (with-imported-modules*
+               (let ((inputs '#$(list e2fsprogs dosfstools mtools)))
+                 (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+                 (make-partition-image #$(partition->gexp partition)
+                                       #$output
+                                       #$image-root)))))
+        (computed-file "partition.img" image-builder)))
+
+    (define (partition->config partition)
+      "Return the genimage partition configuration for PARTITION."
+      (let ((label (partition-label partition))
+            (dos-type (partition->dos-type partition))
+            (image (partition-image partition)))
+        #~(format #f "~/partition ~a {
+~/~/partition-type = ~a
+~/~/image = \"~a\"
+~/}"  #$label #$dos-type #$image)))
+
+    (let* ((format (image-format image))
+           (image-type (format->image-type format))
+           (partitions (image-partitions image))
+           (partitions-config (map partition->config partitions))
+           (builder
+            #~(begin
+                (let ((format (@ (ice-9 format) format)))
+                  (call-with-output-file #$output
+                    (lambda (port)
+                      (format port
+                              "\
+image ~a {
+~/~a {}
+~{~a~^~%~}
+}~%" #$genimage-name #$image-type (list #$@partitions-config))))))))
+      (computed-file "genimage.cfg" builder)))
+
+  (let* ((substitutable? (image-substitutable? image))
+         (builder
+          (with-imported-modules*
+           (let ((inputs '#$(list genimage coreutils findutils)))
+             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+             (genimage #$(image->genimage-cfg image) #$output))))
+         (image-dir (computed-file "image-dir" builder)))
+    (gexp->derivation name
+                      #~(symlink
+                         (string-append #$image-dir "/" #$genimage-name)
+                         #$output)
+                      #:substitutable? substitutable?)))
+
+
+;;
+;; ISO9660 image.
+;;
+
+(define (has-guix-service-type? os)
+  "Return true if OS contains a service of the type GUIX-SERVICE-TYPE."
+  (not (not (scm:find (lambda (service)
+                        (eq? (service-kind service) guix-service-type))
+                      (operating-system-services os)))))
+
+(define* (system-iso9660-image image
+                               #:key
+                               (name "iso9660-image")
+                               bootcfg
+                               bootloader
+                               register-closures?
+                               (inputs '())
+                               (grub-mkrescue-environment '()))
+  "Return a bootable, stand-alone iso9660 image.
+
+INPUTS is a list of inputs (as for packages).  When REGISTER-CLOSURES? is
+true, register INPUTS in the store database of the image so that Guix can be
+used in the image. "
+  (define root-label
+    (match (image-partitions image)
+      ((partition)
+       (partition-label partition))))
+
+  (define root-uuid
+    (match (image-partitions image)
+      ((partition)
+       (uuid-bytevector (partition-uuid partition)))))
+
+  (let* ((os (image-operating-system image))
+         (bootloader (bootloader-package bootloader))
+         (compression? (image-compression? image))
+         (substitutable? (image-substitutable? image))
+         (schema (local-file (search-path %load-path
+                                          "guix/store/schema.sql")))
+         (graph (match inputs
+                  (((names . _) ...)
+                   names)))
+         (root-builder
+          (with-imported-modules*
+           (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")
+
+           (initialize-root-partition #$output
+                                      #:references-graphs '#$graph
+                                      #:deduplicate? #f
+                                      #:system-directory #$os)))
+         (image-root
+          (computed-file "image-root" root-builder
+                         #:options `(#:references-graphs ,inputs)))
+         (builder
+          (with-imported-modules*
+           (let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
+                                   sed grep coreutils findutils gawk)))
+             (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+             (make-iso9660-image #$xorriso
+                                 '#$grub-mkrescue-environment
+                                 #$bootloader
+                                 #$bootcfg
+                                 #$os
+                                 #$image-root
+                                 #$output
+                                 #:references-graphs '#$graph
+                                 #:register-closures? #$register-closures?
+                                 #:compression? #$compression?
+                                 #:volume-id #$root-label
+                                 #:volume-uuid #$root-uuid)))))
+    (gexp->derivation name builder
+                      #:references-graphs inputs
+                      #:substitutable? substitutable?)))
+
+
+;;
+;; Image creation.
+;;
+
+(define (root-partition? partition)
+  "Return true if PARTITION is the root partition, false otherwise."
+  (member 'boot (partition-flags partition)))
+
+(define (find-root-partition image)
+  "Return the root partition of the given IMAGE."
+  (scm:find root-partition? (image-partitions image)))
+
+(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)))))
+
+(define (root-size image)
+  "Return the root partition size of IMAGE."
+  (let* ((image-size (image-size image))
+         (root-partition (find-root-partition image))
+         (root-size (partition-size root-partition)))
+    (cond
+     ((and (eq? root-size 'guess) image-size)
+      image-size)
+     (else root-size))))
+
+(define* (image-with-os base-image os
+                        #:key root-uuid root-size)
+  "Return an image based on BASE-IMAGE but with the operating-system field set
+to OS. Also set the UUID and the size of the root partition to ROOT-UUID and
+ROOT-SIZE respectively."
+  (let*-values (((partitions) (image-partitions base-image))
+                ((root-partition other-partitions)
+                 (scm:partition root-partition? partitions)))
+    (image
+     (inherit base-image)
+     (operating-system os)
+     (partitions
+      (cons (partition
+             (inherit (car root-partition))
+             (uuid root-uuid)
+             (size root-size))
+            other-partitions)))))
+
+(define* (make-system-image image)
+  "Return the derivation of IMAGE. It can be a raw disk-image or an ISO9660
+image, depending on IMAGE format."
+  (let* ((image-os (image-operating-system image))
+         (format (image-format image))
+         (file-systems-to-keep
+          (scm:remove
+           (lambda (fs)
+             (string=? (file-system-mount-point fs) "/"))
+           (operating-system-file-systems image-os)))
+         (root-file-system-type (image->root-file-system image))
+         (substitutable? (image-substitutable? image))
+         (volatile-root? (image-volatile-root? image))
+         (os (operating-system
+               (inherit image-os)
+               (initrd (lambda (file-systems . rest)
+                         (apply (operating-system-initrd image-os)
+                                file-systems
+                                #:volatile-root? volatile-root?
+                                rest)))
+               (bootloader (if (eq? format 'iso9660)
+                               (bootloader-configuration
+                                (inherit
+                                 (operating-system-bootloader image-os))
+                                (bootloader grub-mkrescue-bootloader))
+                               (operating-system-bootloader image-os)))
+               (file-systems (cons (file-system
+                                     (mount-point "/")
+                                     (device "/dev/placeholder")
+                                     (type root-file-system-type))
+                                   file-systems-to-keep))))
+         (uuid (root-uuid image))
+         (os (operating-system
+               (inherit os)
+               (file-systems (cons (file-system
+                                     (mount-point "/")
+                                     (device uuid)
+                                     (type root-file-system-type))
+                                   file-systems-to-keep))))
+         (image* (image-with-os image os
+                                #:root-uuid uuid
+                                #:root-size (root-size image)))
+         (register-closures? (has-guix-service-type? os))
+         (bootcfg (operating-system-bootcfg os))
+         (bootloader (bootloader-configuration-bootloader
+                      (operating-system-bootloader os))))
+    (case (image-format image)
+      ((disk-image)
+       (system-disk-image image*
+                          #:bootcfg bootcfg
+                          #:bootloader bootloader
+                          #:register-closures? register-closures?
+                          #:inputs `(("system" ,os)
+                                     ("bootcfg" ,bootcfg))))
+      ((iso9660)
+       (system-iso9660-image image*
+                             #:bootcfg bootcfg
+                             #:bootloader bootloader
+                             #:register-closures? register-closures?
+                             #:inputs `(("system" ,os)
+                                        ("bootcfg" ,bootcfg))
+                             #:grub-mkrescue-environment
+                             '(("MKRESCUE_SED_MODE" . "mbr_hfs")))))))
+
+(define (find-image file-system-type)
+  "Find and return an image that could match the given FILE-SYSTEM-TYPE. This
+is useful to adapt to interfaces written before the addition of the <image>
+record."
+  ;; XXX: Add support for system and target here, or in the caller.
+  (match file-system-type
+    ("iso9660" iso9660-image)
+    (_ efi-disk-image)))
+
+(define (system-image image)
+  "Wrap 'make-system-image' call, so that it is used only if the given IMAGE
+is supported. Otherwise, fallback to image creation in a VM. This is temporary
+and should be removed once 'make-system-image' is able to deal with all types
+of images."
+  (let* ((image-os (image-operating-system image))
+         (image-root-filesystem-type (image->root-file-system image))
+         (bootloader (bootloader-configuration-bootloader
+                      (operating-system-bootloader image-os)))
+         (bootloader-name (bootloader-name bootloader))
+         (size (image-size image))
+         (substitutable? (image-substitutable? image))
+         (volatile? (image-volatile-root? image))
+         (format (image-format image)))
+    (if (and (or (eq? bootloader-name 'grub)
+                 (eq? bootloader-name 'extlinux))
+             (eq? format 'disk-image))
+        ;; Fallback to image creation in a VM when it is not yet supported by
+        ;; this module.
+        (system-disk-image-in-vm image-os
+                                 #:disk-image-size size
+                                 #:file-system-type image-root-filesystem-type
+                                 #:volatile? volatile?
+                                 #:substitutable? substitutable?)
+        (make-system-image image))))
+
+;;; image.scm ends here
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 2fdf954883..37840ce355 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -77,7 +77,7 @@
 
             system-qemu-image/shared-store
             system-qemu-image/shared-store-script
-            system-disk-image
+            system-disk-image-in-vm
             system-docker-image
 
             virtual-machine
@@ -604,14 +604,13 @@ system."
 ;;; VM and disk images.
 ;;;
 
-
-(define* (system-disk-image os
-                            #:key
-                            (name "disk-image")
-                            (file-system-type "ext4")
-                            (disk-image-size (* 900 (expt 2 20)))
-                            (volatile? #t)
-                            (substitutable? #t))
+(define* (system-disk-image-in-vm os
+                                  #:key
+                                  (name "disk-image")
+                                  (file-system-type "ext4")
+                                  (disk-image-size (* 900 (expt 2 20)))
+                                  (volatile? #t)
+                                  (substitutable? #t))
   "Return the derivation of a disk image of DISK-IMAGE-SIZE bytes of the
 system described by OS.  Said image can be copied on a USB stick as is.  When
 VOLATILE? is true, the root file system is made volatile; this is useful
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 8650474fbc..d8d495589e 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -21,9 +21,11 @@
 (define-module (gnu tests install)
   #:use-module (gnu)
   #:use-module (gnu bootloader extlinux)
+  #:use-module (gnu image)
   #:use-module (gnu tests)
   #:use-module (gnu tests base)
   #:use-module (gnu system)
+  #:use-module (gnu system image)
   #:use-module (gnu system install)
   #:use-module (gnu system vm)
   #:use-module ((gnu build vm) #:select (qemu-command))
@@ -227,14 +229,18 @@ packages defined in installation-os."
                        ;; we cheat a little bit by adding TARGET to its GC
                        ;; roots.  This way, we know 'guix system init' will
                        ;; succeed.
-                       (image  (system-disk-image
-                                (operating-system-with-gc-roots
-                                 os (list target))
-                                #:disk-image-size install-size
-                                #:file-system-type
-                                installation-disk-image-file-system-type
-                                ;; Don't provide substitutes; too big.
-                                #:substitutable? #f)))
+                       (image
+                        (system-image
+                         (image
+                          (inherit
+                           (find-image
+                            installation-disk-image-file-system-type))
+                          (size install-size)
+                          (operating-system
+                            (operating-system-with-gc-roots
+                             os (list target)))
+                          ;; Don't provide substitutes; too big.
+                          (substitutable? #f)))))
     (define install
       (with-imported-modules '((guix build utils)
                                (gnu build marionette))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 2664c66a30..3c8691a08c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -54,9 +54,11 @@
   #:autoload   (gnu build linux-modules)
                  (device-module-aliases matching-modules)
   #:use-module (gnu system linux-initrd)
+  #:use-module (gnu image)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system file-systems)
+  #:use-module (gnu system image)
   #:use-module (gnu system mapped-devices)
   #:use-module (gnu system linux-container)
   #:use-module (gnu system uuid)
@@ -692,12 +694,11 @@ checking this by themselves in their 'check' procedure."
                                                 (* 70 (expt 2 20)))
                                             #:mappings mappings))
     ((disk-image)
-     (system-disk-image os
-                        #:name (match file-system-type
-                                 ("iso9660" "image.iso")
-                                 (_         "disk-image"))
-                        #:disk-image-size image-size
-                        #:file-system-type file-system-type))
+     (system-image
+      (image
+       (inherit (find-image file-system-type))
+       (size image-size)
+       (operating-system os))))
     ((docker-image)
      (system-docker-image os))))
 
