vm: Fix 'vm --full-boot' to produce a sufficient disk image.
* gnu/system/vm.scm (system-qemu-image/shared-store): Add #:disk-image-size and #:full-boot? parameters and honor them. Pass '#:copy-inputs? full-boot?', and change #:inputs argument. * guix/scripts/system.scm (system-derivation-for-action): Pass #:disk-image-size to 'system-qemu-image/shared-store'. * doc/guix.texi (Invoking guix system): Mention use of '--image-size' in conjunction with '--full-boot'.
This commit is contained in:
parent
a9967103de
commit
6aa260af12
|
@ -4151,9 +4151,15 @@ Build a virtual machine that contain the operating system declared in
|
||||||
|
|
||||||
The VM shares its store with the host system.
|
The VM shares its store with the host system.
|
||||||
|
|
||||||
On GNU/Linux, the default is to boot directly to the kernel. The
|
On GNU/Linux, the default is to boot directly to the kernel; this has
|
||||||
@code{--full-boot} option forces a complete boot sequence, starting with
|
the advantage of requiring only a very tiny root disk image since the
|
||||||
the bootloader.
|
host's store can then be mounted.
|
||||||
|
|
||||||
|
The @code{--full-boot} option forces a complete boot sequence, starting
|
||||||
|
with the bootloader. This requires more disk space since a root image
|
||||||
|
containing at least the kernel, initrd, and bootloader data files must
|
||||||
|
be created. The @code{--image-size} option can be used to specify the
|
||||||
|
image's size.
|
||||||
|
|
||||||
@item vm-image
|
@item vm-image
|
||||||
@itemx disk-image
|
@itemx disk-image
|
||||||
|
|
|
@ -376,20 +376,31 @@ environment with the store shared with the host."
|
||||||
|
|
||||||
(define* (system-qemu-image/shared-store
|
(define* (system-qemu-image/shared-store
|
||||||
os
|
os
|
||||||
#:key (disk-image-size (* 15 (expt 2 20))))
|
#:key
|
||||||
|
full-boot?
|
||||||
|
(disk-image-size (* (if full-boot? 500 15) (expt 2 20))))
|
||||||
"Return a derivation that builds a QEMU image of OS that shares its store
|
"Return a derivation that builds a QEMU image of OS that shares its store
|
||||||
with the host."
|
with the host.
|
||||||
(mlet* %store-monad
|
|
||||||
((os-drv (operating-system-derivation os))
|
When FULL-BOOT? is true, return an image that does a complete boot sequence,
|
||||||
|
bootloaded included; thus, make a disk image that contains everything the
|
||||||
|
bootloader refers to: OS kernel, initrd, bootloader data, etc."
|
||||||
|
(mlet* %store-monad ((os-drv (operating-system-derivation os))
|
||||||
(grub.cfg (operating-system-grub.cfg os)))
|
(grub.cfg (operating-system-grub.cfg os)))
|
||||||
|
;; XXX: When FULL-BOOT? is true, we end up creating an image that contains
|
||||||
|
;; GRUB.CFG and all its dependencies, including the output of OS-DRV.
|
||||||
|
;; This is more than needed (we only need the kernel, initrd, GRUB for its
|
||||||
|
;; font, and the background image), but it's hard to filter that.
|
||||||
(qemu-image #:os-derivation os-drv
|
(qemu-image #:os-derivation os-drv
|
||||||
#:grub-configuration grub.cfg
|
#:grub-configuration grub.cfg
|
||||||
#:disk-image-size disk-image-size
|
#:disk-image-size disk-image-size
|
||||||
#:inputs `(("system" ,os-drv))
|
#:inputs (if full-boot?
|
||||||
|
`(("grub.cfg" ,grub.cfg))
|
||||||
|
'())
|
||||||
|
|
||||||
;; XXX: Passing #t here is too slow, so let it off by default.
|
;; XXX: Passing #t here is too slow, so let it off by default.
|
||||||
#:register-closures? #f
|
#:register-closures? #f
|
||||||
#:copy-inputs? #f)))
|
#:copy-inputs? full-boot?)))
|
||||||
|
|
||||||
(define* (common-qemu-options image)
|
(define* (common-qemu-options image)
|
||||||
"Return the a string-value gexp with the common QEMU options to boot IMAGE."
|
"Return the a string-value gexp with the common QEMU options to boot IMAGE."
|
||||||
|
@ -406,15 +417,23 @@ with the host."
|
||||||
#:key
|
#:key
|
||||||
(qemu qemu)
|
(qemu qemu)
|
||||||
(graphic? #t)
|
(graphic? #t)
|
||||||
full-boot?)
|
full-boot?
|
||||||
|
(disk-image-size
|
||||||
|
(* (if full-boot? 500 15)
|
||||||
|
(expt 2 20))))
|
||||||
"Return a derivation that builds a script to run a virtual machine image of
|
"Return a derivation that builds a script to run a virtual machine image of
|
||||||
OS that shares its store with the host. When FULL-BOOT? is true, the returned
|
OS that shares its store with the host.
|
||||||
script runs everything starting from the bootloader; otherwise it directly
|
|
||||||
starts the operating system kernel."
|
When FULL-BOOT? is true, the returned script runs everything starting from the
|
||||||
(mlet* %store-monad
|
bootloader; otherwise it directly starts the operating system kernel. The
|
||||||
((os -> (virtualized-operating-system os))
|
DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
|
||||||
|
it is mostly useful when FULL-BOOT? is true."
|
||||||
|
(mlet* %store-monad ((os -> (virtualized-operating-system os))
|
||||||
(os-drv (operating-system-derivation os))
|
(os-drv (operating-system-derivation os))
|
||||||
(image (system-qemu-image/shared-store os)))
|
(image (system-qemu-image/shared-store
|
||||||
|
os
|
||||||
|
#:full-boot? full-boot?
|
||||||
|
#:disk-image-size disk-image-size)))
|
||||||
(define builder
|
(define builder
|
||||||
#~(call-with-output-file #$output
|
#~(call-with-output-file #$output
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
|
|
|
@ -258,7 +258,9 @@ it atomically, and then run OS's activation script."
|
||||||
((vm-image)
|
((vm-image)
|
||||||
(system-qemu-image os #:disk-image-size image-size))
|
(system-qemu-image os #:disk-image-size image-size))
|
||||||
((vm)
|
((vm)
|
||||||
(system-qemu-image/shared-store-script os #:full-boot? full-boot?))
|
(system-qemu-image/shared-store-script os
|
||||||
|
#:full-boot? full-boot?
|
||||||
|
#:disk-image-size image-size))
|
||||||
((disk-image)
|
((disk-image)
|
||||||
(system-disk-image os #:disk-image-size image-size))))
|
(system-disk-image os #:disk-image-size image-size))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue