diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/image.scm | 532 | ||||
| -rw-r--r-- | gnu/system/install.scm | 1 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 3 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 216 |
4 files changed, 561 insertions, 191 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm new file mode 100644 index 0000000000..571b7af5f3 --- /dev/null +++ b/gnu/system/image.scm @@ -0,0 +1,532 @@ +;;; 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 monads) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (guix ui) + #: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 srfi-1:) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) + #: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 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. + (srfi-1: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* gexp* ...) + (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)) + gexp* ...)))) + + +;; +;; Disk image. +;; + +(define* (system-disk-image image + #:key + (name "disk-image") + bootcfg + bootloader + register-closures? + (inputs '())) + "Return as a file-like object, 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 + (raise (condition + (&message + (message + (format #f (G_ "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))) + (computed-file name + #~(symlink + (string-append #$image-dir "/" #$genimage-name) + #$output) + #:options `(#: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 (srfi-1: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 as a file-like object 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))))) + (computed-file name builder + #:options `(#: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." + (srfi-1: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) + "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." + (define root-file-system + (srfi-1:find + (lambda (fs) + (string=? (file-system-mount-point fs) "/")) + (operating-system-file-systems os))) + + (let*-values (((partitions) (image-partitions base-image)) + ((root-partition other-partitions) + (srfi-1:partition root-partition? partitions))) + (image + (inherit base-image) + (operating-system os) + (partitions + (cons (partition + (inherit (car root-partition)) + (uuid (file-system-device root-file-system)) + (size (root-size base-image))) + other-partitions))))) + +(define (operating-system-for-image image) + "Return an operating-system based on the one specified in IMAGE, but +suitable for image creation. Assign an UUID to the root file-system, so that +it can be used for bootloading." + (define volatile-root? (image-volatile-root? image)) + + (define (root-uuid os) + ;; 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 ((type (if (eq? (image-format image) 'iso9660) + 'iso9660 + 'dce))) + (operating-system-uuid os type))) + + (let* ((root-file-system-type (image->root-file-system image)) + (base-os (image-operating-system image)) + (file-systems-to-keep + (srfi-1:remove + (lambda (fs) + (string=? (file-system-mount-point fs) "/")) + (operating-system-file-systems base-os))) + (format (image-format image)) + (os + (operating-system + (inherit base-os) + (initrd (lambda (file-systems . rest) + (apply (operating-system-initrd base-os) + file-systems + #:volatile-root? volatile-root? + rest))) + (bootloader (if (eq? format 'iso9660) + (bootloader-configuration + (inherit + (operating-system-bootloader base-os)) + (bootloader grub-mkrescue-bootloader)) + (operating-system-bootloader base-os))) + (file-systems (cons (file-system + (mount-point "/") + (device "/dev/placeholder") + (type root-file-system-type)) + file-systems-to-keep)))) + (uuid (root-uuid os))) + (operating-system + (inherit os) + (file-systems (cons (file-system + (mount-point "/") + (device uuid) + (type root-file-system-type)) + file-systems-to-keep))))) + +(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." + (define substitutable? (image-substitutable? image)) + + (let* ((os (operating-system-for-image image)) + (image* (image-with-os image os)) + (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." + (define substitutable? (image-substitutable? image)) + (define volatile-root? (image-volatile-root? image)) + + (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)) + (format (image-format image))) + (mbegin %store-monad + (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-root? + #:substitutable? substitutable?) + (lower-object + (make-system-image image)))))) + +;;; image.scm ends here diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 7166c12bcc..fe49ffdb94 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -523,6 +523,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m mdadm dosfstools ;mkfs.fat, for the UEFI boot partition btrfs-progs + f2fs-tools jfsutils openssh ;we already have sshd, having ssh/scp can help wireless-tools iw wpa-supplicant-minimal iproute diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index d84f352663..c43d53a210 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -245,6 +245,9 @@ FILE-SYSTEMS." '()) ,@(if (find (file-system-type-predicate "jfs") file-systems) (list jfs_fsck/static) + '()) + ,@(if (find (file-system-type-predicate "f2fs") file-systems) + (list f2fs-fsck/static) '()))) (define-syntax vhash ;TODO: factorize diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 1d5ee39497..4ea82cfd50 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 @@ -269,95 +269,6 @@ substitutable." (eq? (service-kind service) guix-service-type)) (operating-system-services os))))) -(define* (iso9660-image #:key - (name "iso9660-image") - file-system-label - file-system-uuid - (system (%current-system)) - (target (%current-target-system)) - (qemu qemu-minimal) - os - bootcfg-drv - bootloader - (register-closures? (has-guix-service-type? os)) - (inputs '()) - (grub-mkrescue-environment '()) - (substitutable? #t)) - "Return a bootable, stand-alone iso9660 image. - -INPUTS is a list of inputs (as for packages)." - (define schema - (and register-closures? - (local-file (search-path %load-path - "guix/store/schema.sql")))) - - (expression->derivation-in-linux-vm - name - (with-extensions gcrypt-sqlite3&co - (with-imported-modules `(,@(source-module-closure '((gnu build vm) - (guix store database) - (guix build utils)) - #:select? not-config?) - ((guix config) => ,(make-config.scm))) - #~(begin - (use-modules (gnu build vm) - (guix store database) - (guix build utils)) - - (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 xorriso) - (map canonical-package - (list sed grep coreutils findutils gawk)))) - - - (graphs '#$(match inputs - (((names . _) ...) - names))) - ;; 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) - (make-iso9660-image #$xorriso - '#$grub-mkrescue-environment - #$(bootloader-package bootloader) - #$bootcfg-drv - #$os - "/xchg/guixsd.iso" - #:register-closures? #$register-closures? - #:closures graphs - #:volume-id #$file-system-label - #:volume-uuid #$(and=> file-system-uuid - uuid-bytevector)))))) - #:system system - #:target target - - ;; Keep a local file system for /tmp so that we can populate it directly as - ;; root and have files owned by root. See <https://bugs.gnu.org/31752>. - #:file-systems (remove (lambda (file-system) - (string=? (file-system-mount-point file-system) - "/tmp")) - %linux-vm-file-systems) - - #:make-disk-image? #f - #:single-file-output? #t - #:references-graphs inputs - #:substitutable? substitutable? - - ;; Xorriso seems to be quite memory-hungry, so increase the VM's RAM size. - #:memory-size 512)) - (define* (qemu-image #:key (name "qemu-image") (system (%current-system)) @@ -624,62 +535,13 @@ system." ;;; VM and disk images. ;;; -(define* (operating-system-uuid os #:optional (type 'dce)) - "Compute UUID object with a deterministic \"UUID\" for OS, of the given -TYPE (one of 'iso9660 or 'dce). Return a UUID object." - ;; Note: For this to be deterministic, we must not hash things that contains - ;; (directly or indirectly) procedures, for example. That rules out - ;; anything that contains gexps, thunk or delayed record fields, etc. - - (define service-name - (compose service-type-name service-kind)) - - (define (file-system-digest fs) - ;; Return a hashable digest that does not contain 'dependencies' since - ;; this field can contain procedures. - (let ((device (file-system-device fs))) - (list (file-system-mount-point fs) - (file-system-type fs) - (file-system-device->string device) - (file-system-options fs)))) - - (if (eq? type 'iso9660) - (let ((pad (compose (cut string-pad <> 2 #\0) - number->string)) - (h (hash (map service-name (operating-system-services os)) - 3600))) - (bytevector->uuid - (string->iso9660-uuid - (string-append "1970-01-01-" - (pad (hash (operating-system-host-name os) 24)) "-" - (pad (quotient h 60)) "-" - (pad (modulo h 60)) "-" - (pad (hash (map file-system-digest - (operating-system-file-systems os)) - 100)))) - 'iso9660)) - (bytevector->uuid - (uint-list->bytevector - (list (hash (map file-system-digest - (operating-system-file-systems os)) - (- (expt 2 32) 1)) - (hash (operating-system-host-name os) - (- (expt 2 32) 1)) - (hash (map service-name (operating-system-services os)) - (- (expt 2 32) 1)) - (hash (map file-system-digest (operating-system-file-systems os)) - (- (expt 2 32) 1))) - (endianness little) - 4) - type))) - -(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 @@ -687,25 +549,14 @@ to USB sticks meant to be read-only. SUBSTITUTABLE? determines whether the returned derivation should be marked as substitutable." - (define normalize-label - ;; ISO labels are all-caps (case-insensitive), but since - ;; 'find-partition-by-label' is case-sensitive, make it all-caps here. - (if (string=? "iso9660" file-system-type) - string-upcase - identity)) - (define root-label - ;; Volume name of the root file system. - (normalize-label "Guix_image")) + "Guix_image") (define (root-uuid os) ;; 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. - (operating-system-uuid os - (if (string=? file-system-type "iso9660") - 'iso9660 - 'dce))) + (operating-system-uuid os 'dce)) (define file-systems-to-keep (remove (lambda (fs) @@ -722,11 +573,7 @@ substitutable." #:volatile-root? volatile? rest))) - (bootloader (if (string=? "iso9660" file-system-type) - (bootloader-configuration - (inherit (operating-system-bootloader os)) - (bootloader grub-mkrescue-bootloader)) - (operating-system-bootloader os))) + (bootloader (operating-system-bootloader os)) ;; Force our own root file system. (We need a "/" file system ;; to call 'root-uuid'.) @@ -744,33 +591,20 @@ substitutable." (type file-system-type)) file-systems-to-keep)))) (bootcfg (operating-system-bootcfg os))) - (if (string=? "iso9660" file-system-type) - (iso9660-image #:name name - #:file-system-label root-label - #:file-system-uuid uuid - #:os os - #:bootcfg-drv bootcfg - #:bootloader (bootloader-configuration-bootloader - (operating-system-bootloader os)) - #:inputs `(("system" ,os) - ("bootcfg" ,bootcfg)) - #:grub-mkrescue-environment - '(("MKRESCUE_SED_MODE" . "mbr_hfs")) - #:substitutable? substitutable?) - (qemu-image #:name name - #:os os - #:bootcfg-drv bootcfg - #:bootloader (bootloader-configuration-bootloader - (operating-system-bootloader os)) - #:disk-image-size disk-image-size - #:disk-image-format "raw" - #:file-system-type file-system-type - #:file-system-label root-label - #:file-system-uuid uuid - #:copy-inputs? #t - #:inputs `(("system" ,os) - ("bootcfg" ,bootcfg)) - #:substitutable? substitutable?)))) + (qemu-image #:name name + #:os os + #:bootcfg-drv bootcfg + #:bootloader (bootloader-configuration-bootloader + (operating-system-bootloader os)) + #:disk-image-size disk-image-size + #:disk-image-format "raw" + #:file-system-type file-system-type + #:file-system-label root-label + #:file-system-uuid uuid + #:copy-inputs? #t + #:inputs `(("system" ,os) + ("bootcfg" ,bootcfg)) + #:substitutable? substitutable?))) (define* (system-qemu-image os #:key |