summary refs log tree commit diff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-03 12:45:43 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-03 12:46:09 +0200
commit66f23d66219533aff689a05d16439827da1a2a59 (patch)
tree7fe5f74194988f4e6c7ff812d26cb48a3759ab6f /gnu/system/vm.scm
parent03ddfaf5fb5fab78f7180089158bea0494072b3c (diff)
downloadguix-66f23d66219533aff689a05d16439827da1a2a59.tar.gz
vm: Provide a root partition for the freestanding VM image.
Fixes a regression introduced in 83bcd0b.

* gnu/system/vm.scm (system-qemu-image): Override the 'file-systems'
  field of OS.  Add #:file-system-type parameter and honor it.
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm35
1 files changed, 22 insertions, 13 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 867e01ad5f..786e564031 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -296,19 +296,28 @@ basic contents of the root file system of OS."
                               (operating-system-users os))))))
 
 (define* (system-qemu-image os
-                            #:key (disk-image-size (* 900 (expt 2 20))))
-  "Return the derivation of a QEMU image of DISK-IMAGE-SIZE bytes of the GNU
-system as described by OS."
-  (mlet* %store-monad
-      ((os-drv      (operating-system-derivation os))
-       (os-dir   -> (derivation->output-path os-drv))
-       (grub.cfg -> (string-append os-dir "/grub.cfg"))
-       (populate    (operating-system-default-contents os)))
-    (qemu-image  #:grub-configuration grub.cfg
-                 #:populate populate
-                 #:disk-image-size disk-image-size
-                 #:initialize-store? #t
-                 #:inputs-to-copy `(("system" ,os-drv)))))
+                            #:key
+                            (file-system-type "ext4")
+                            (disk-image-size (* 900 (expt 2 20))))
+  "Return the derivation of a freestanding QEMU image of DISK-IMAGE-SIZE bytes
+of the GNU system as described by OS."
+  (let ((os (operating-system (inherit os)
+              ;; The mounted file systems are under our control.
+              (file-systems (list (file-system
+                                    (mount-point "/")
+                                    (device "/dev/sda1")
+                                    (type file-system-type)))))))
+    (mlet* %store-monad
+        ((os-drv      (operating-system-derivation os))
+         (os-dir   -> (derivation->output-path os-drv))
+         (grub.cfg -> (string-append os-dir "/grub.cfg"))
+         (populate    (operating-system-default-contents os)))
+      (qemu-image  #:grub-configuration grub.cfg
+                   #:populate populate
+                   #:disk-image-size disk-image-size
+                   #:file-system-type file-system-type
+                   #:initialize-store? #t
+                   #:inputs-to-copy `(("system" ,os-drv))))))
 
 (define (virtualized-operating-system os)
   "Return an operating system based on OS suitable for use in a virtualized