From e3f0155c41b28510f77e113ca2d37f0e7d90a2ca Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 23 May 2020 19:10:28 +0200 Subject: image: Do not use VM to create disk-images. Now that installing Grub on raw disk-images is supported, we do not need to rely on (gnu system vm) module. * gnu/system/image.scm (make-system-image): Rename to ... (system-image): ... this, and remove the compatibility wrapper. (find-image): Turn to a monadic procedure. This will become useful when introducing Hurd support, to be able to detect the target system. * gnu/ci.scm (qemu-jobs): Use lower-object now that system-image returns a file-like object. * gnu/tests/install.scm (run-install): Ditto. * guix/scripts/system.scm (system-derivation-for-action): Add a 'base-image' argument, (perform-action): adapt accordingly. --- gnu/system/image.scm | 40 ++++++---------------------------------- 1 file changed, 6 insertions(+), 34 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 02c026b88c..f44886c137 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -492,7 +492,7 @@ it can be used for bootloading." (type root-file-system-type)) file-systems-to-keep))))) -(define* (make-system-image image) +(define* (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)) @@ -525,38 +525,10 @@ image, depending on IMAGE format." "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 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)))))) + (mbegin %store-monad + (return + (match file-system-type + ("iso9660" iso9660-image) + (_ efi-disk-image))))) ;;; image.scm ends here -- cgit v1.2.3