vm: Make the image format a parameter.

* guix/build/vm.scm (load-in-linux-vm): Add #:disk-image-format
  parameter; add 'image-file' variable.  Honor DISK-IMAGE-FORMAT.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Add
  #:disk-image-format parameter, and honor it.
  (qemu-image): Likewise.

2 files changed, 19 insertions, 9 deletions

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 0d41791d87..39ce5bb6ef 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -119,6 +119,7 @@ input tuple.  The output file name is when building for SYSTEM."
                                              (make-disk-image? #f)
                                              (references-graphs #f)
                                              (memory-size 256)
+                                             (disk-image-format "qcow2")
                                              (disk-image-size
                                               (* 100 (expt 2 20))))
   "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
@@ -127,8 +128,9 @@ store; it should put its output files in the `/xchg' directory, which is
 copied to the derivation's output when the VM terminates.  The virtual machine
 runs with MEMORY-SIZE MiB of memory.
 
-When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
-DISK-IMAGE-SIZE bytes and return it.
+When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
+DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
+return it.
 
 MODULES is the set of modules imported in the execution environment of EXP.
 
@@ -174,6 +176,7 @@ made available under the /xchg CIFS share."
                               #:linux linux #:initrd initrd
                               #:memory-size #$memory-size
                               #:make-disk-image? #$make-disk-image?
+                              #:disk-image-format #$disk-image-format
                               #:disk-image-size #$disk-image-size
                               #:references-graphs graphs))))
 
@@ -190,15 +193,17 @@ made available under the /xchg CIFS share."
                      (system (%current-system))
                      (qemu qemu-headless)
                      (disk-image-size (* 100 (expt 2 20)))
+                     (disk-image-format "qcow2")
                      (file-system-type "ext4")
                      grub-configuration
                      (register-closures? #t)
                      (inputs '())
                      copy-inputs?)
-  "Return a bootable, stand-alone QEMU image, with a root partition of type
-FILE-SYSTEM-TYPE.  The returned image is a full disk image, with a GRUB
-installation that uses GRUB-CONFIGURATION as its configuration
-file (GRUB-CONFIGURATION must be the name of a file in the VM.)
+  "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
+'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.  The
+returned image is a full disk image, with a GRUB installation that uses
+GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION must be the
+name of a file in the VM.)
 
 INPUTS is a list of inputs (as for packages).  When COPY-INPUTS? is true, copy
 all of INPUTS into the image being built.  When REGISTER-CLOSURES? is true,
@@ -242,6 +247,7 @@ the image."
     #:system system
     #:make-disk-image? #t
     #:disk-image-size disk-image-size
+    #:disk-image-format disk-image-format
     #:references-graphs graph)))
 
 
diff --git a/guix/build/vm.scm b/guix/build/vm.scm
index 2a8843c633..4de536abb4 100644
--- a/guix/build/vm.scm
+++ b/guix/build/vm.scm
@@ -50,6 +50,7 @@
                            (qemu (qemu-command)) (memory-size 512)
                            linux initrd
                            make-disk-image? (disk-image-size 100)
+                           (disk-image-format "qcow2")
                            (references-graphs '()))
   "Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
 the result to OUTPUT.
@@ -60,9 +61,12 @@ it via /dev/hda.
 
 REFERENCES-GRAPHS can specify a list of reference-graph files as produced by
 the #:references-graphs parameter of 'derivation'."
+  (define image-file
+    (string-append "image." disk-image-format))
 
   (when make-disk-image?
-    (unless (zero? (system* "qemu-img" "create" "-f" "qcow2" "image.qcow2"
+    (unless (zero? (system* "qemu-img" "create" "-f" disk-image-format
+                            image-file
                             (number->string disk-image-size)))
       (error "qemu-img failed")))
 
@@ -92,12 +96,12 @@ the #:references-graphs parameter of 'derivation'."
                   "-append" (string-append "console=ttyS0 --load="
                                            builder)
                   (if make-disk-image?
-                      '("-hda" "image.qcow2")
+                      `("-hda" ,image-file)
                       '())))
     (error "qemu failed" qemu))
 
   (if make-disk-image?
-      (copy-file "image.qcow2" output)
+      (copy-file image-file output)
       (begin
         (mkdir output)
         (copy-recursively "xchg" output))))