~ruther/guix-local

909de139e7f6ab474e6e510a3c15bb4b4731b8cf — David Craven 9 years ago ecc4324
vm: Fix full-boot? option.

* gnu/system/vm.scm (virtualized-operating-system): Add full-boot?
  option. Don't add a %store-mapping when full-boot? is passed. This leads
  the grub-configuration-file procedure to look for the kernel and initrd in
  / instead of /gnu/store.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
1 files changed, 21 insertions(+), 13 deletions(-)

M gnu/system/vm.scm
M gnu/system/vm.scm => gnu/system/vm.scm +21 -13
@@ 365,7 365,7 @@ of the GNU system as described by OS."
       (check? #f)
       (create-mount-point? #t)))))

(define (virtualized-operating-system os mappings)
(define* (virtualized-operating-system os mappings #:optional (full-boot? #f))
  "Return an operating system based on OS suitable for use in a virtualized
environment with the store shared with the host.  MAPPINGS is a list of
<file-system-mapping> to realize in the virtualized OS."


@@ 381,6 381,15 @@ environment with the store shared with the host.  MAPPINGS is a list of
                         (string-prefix? "/dev/" source)))))
            (operating-system-file-systems os)))

  (define virtual-file-systems
    (cons (file-system
            (mount-point "/")
            (device "/dev/vda1")
            (type "ext4"))

          (append (map mapping->file-system mappings)
                  user-file-systems)))

  (operating-system (inherit os)
    (initrd (lambda (file-systems . rest)
              (apply base-initrd file-systems


@@ 391,17 400,16 @@ environment with the store shared with the host.  MAPPINGS is a list of
    ;; Disable swap.
    (swap-devices '())

    (file-systems (cons* (file-system
                           (mount-point "/")
                           (device "/dev/vda1")
                           (type "ext4"))

                         (file-system (inherit
                                       (mapping->file-system %store-mapping))
                            (needed-for-boot? #t))

                         (append (map mapping->file-system mappings)
                                 user-file-systems)))))
    ;; XXX: When FULL-BOOT? is true, do not add a 9p mount for /gnu/store
    ;; since that would lead the bootloader config to look for the kernel and
    ;; initrd in it.
    (file-systems (if full-boot?
                      virtual-file-systems
                      (cons
                       (file-system
                         (inherit (mapping->file-system %store-mapping))
                         (needed-for-boot? #t))
                       virtual-file-systems)))))

(define* (system-qemu-image/shared-store
          os


@@ 474,7 482,7 @@ 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 mappings))
  (mlet* %store-monad ((os ->  (virtualized-operating-system os mappings full-boot?))
                       (os-drv (operating-system-derivation os))
                       (image  (system-qemu-image/shared-store
                                os