diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-05-03 12:45:43 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-05-03 12:46:09 +0200 |
| commit | 66f23d66219533aff689a05d16439827da1a2a59 (patch) | |
| tree | 7fe5f74194988f4e6c7ff812d26cb48a3759ab6f /gnu/system/vm.scm | |
| parent | 03ddfaf5fb5fab78f7180089158bea0494072b3c (diff) | |
| download | gnu-guix-66f23d66219533aff689a05d16439827da1a2a59.tar gnu-guix-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.scm | 35 |
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 |