~ruther/guix-local

6aa260af122ce445c2b41c2ce5f487724feea917 — Ludovic Courtès 11 years ago a996710
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'.
3 files changed, 46 insertions(+), 19 deletions(-)

M doc/guix.texi
M gnu/system/vm.scm
M guix/scripts/system.scm
M doc/guix.texi => doc/guix.texi +9 -3
@@ 4151,9 4151,15 @@ Build a virtual machine that contain the operating system declared in

The VM shares its store with the host system.

On GNU/Linux, the default is to boot directly to the kernel.  The
@code{--full-boot} option forces a complete boot sequence, starting with
the bootloader.
On GNU/Linux, the default is to boot directly to the kernel; this has
the advantage of requiring only a very tiny root disk image since the
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
@itemx disk-image

M gnu/system/vm.scm => gnu/system/vm.scm +34 -15
@@ 376,20 376,31 @@ environment with the store shared with the host."

(define* (system-qemu-image/shared-store
          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
with the host."
  (mlet* %store-monad
      ((os-drv      (operating-system-derivation os))
       (grub.cfg    (operating-system-grub.cfg os)))
with the host.

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)))
    ;; 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
                #:grub-configuration grub.cfg
                #: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.
                #:register-closures? #f
                #:copy-inputs? #f)))
                #:copy-inputs? full-boot?)))

(define* (common-qemu-options image)
  "Return the a string-value gexp with the common QEMU options to boot IMAGE."


@@ 406,15 417,23 @@ with the host."
                                                #:key
                                                (qemu qemu)
                                                (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
OS that shares its store with the host.  When FULL-BOOT? is true, the returned
script runs everything starting from the bootloader; otherwise it directly
starts the operating system kernel."
  (mlet* %store-monad
      ((os ->  (virtualized-operating-system os))
       (os-drv (operating-system-derivation os))
       (image  (system-qemu-image/shared-store os)))
OS that shares its store with the host.

When FULL-BOOT? is true, the returned script runs everything starting from the
bootloader; otherwise it directly starts the operating system kernel.  The
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))
                       (image  (system-qemu-image/shared-store
                                os
                                #:full-boot? full-boot?
                                #:disk-image-size disk-image-size)))
    (define builder
      #~(call-with-output-file #$output
          (lambda (port)

M guix/scripts/system.scm => guix/scripts/system.scm +3 -1
@@ 258,7 258,9 @@ it atomically, and then run OS's activation script."
    ((vm-image)
     (system-qemu-image os #:disk-image-size image-size))
    ((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)
     (system-disk-image os #:disk-image-size image-size))))