From 66f23d66219533aff689a05d16439827da1a2a59 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 3 May 2014 12:45:43 +0200 Subject: 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. --- gnu/system/vm.scm | 35 ++++++++++++++++++++++------------- 1 file 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 -- cgit 1.4.1