From e3f0155c41b28510f77e113ca2d37f0e7d90a2ca Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
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.
---
 guix/scripts/system.scm | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

(limited to 'guix/scripts/system.scm')

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3efd113ac8..3d7aa77cb7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -670,7 +670,7 @@ (define file-systems
 ;;; 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 @@ (define* (system-derivation-for-action os action
                                                 (* 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 @@ (define bootcfg
       (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?
-- 
cgit v1.2.3