@@ -219,19 +219,21 @@ system.")
(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))))))
+ (lower-object
+ (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)))))))
+ (lower-object
+ (system-image
+ (image
+ (inherit iso9660-image)
+ (operating-system installation-os))))))))
'()))
(define channel-build-system
@@ -488,7 +488,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))
@@ -521,38 +521,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 <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))))))
+ (mbegin %store-monad
+ (return
+ (match file-system-type
+ ("iso9660" iso9660-image)
+ (_ efi-disk-image)))))
;;; image.scm ends here
@@ -228,18 +228,18 @@ packages defined in installation-os."
(mlet* %store-monad ((_ (set-grafting #f))
(system (current-system))
(target (operating-system-derivation target-os))
+ (base-image (find-image
+ installation-disk-image-file-system-type))
;; Since the installation system has no network access,
;; we cheat a little bit by adding TARGET to its GC
;; roots. This way, we know 'guix system init' will
;; succeed. Also add guile-final, which is pulled in
;; through provenance.drv and may not always be present.
- (image
+ (image ->
(system-image
(image
- (inherit
- (find-image
- installation-disk-image-file-system-type))
+ (inherit base-image)
(size install-size)
(operating-system
(operating-system-with-gc-roots
@@ -670,7 +670,7 @@ checking this by themselves in their 'check' procedure."
;;; Action.
;;;
-(define* (system-derivation-for-action os action
+(define* (system-derivation-for-action os base-image action
#:key image-size file-system-type
full-boot? container-shared-network?
mappings)
@@ -694,11 +694,12 @@ checking this by themselves in their 'check' procedure."
(* 70 (expt 2 20)))
#:mappings mappings))
((disk-image)
- (system-image
- (image
- (inherit (find-image file-system-type))
- (size image-size)
- (operating-system os))))
+ (lower-object
+ (system-image
+ (image
+ (inherit base-image)
+ (size image-size)
+ (operating-system os)))))
((docker-image)
(system-docker-image os #:shared-network? container-shared-network?))))
@@ -800,7 +801,8 @@ static checks."
(check-initrd-modules os)))
(mlet* %store-monad
- ((sys (system-derivation-for-action os action
+ ((image (find-image file-system-type))
+ (sys (system-derivation-for-action os image action
#:file-system-type file-system-type
#:image-size image-size
#:full-boot? full-boot?