me
/
guix
Archived
1
0
Fork 0
Code

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>
master
David Craven 2017-02-14 16:28:33 +01:00 committed by Ludovic Courtès
parent ecc4324fef
commit 909de139e7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 13 deletions
gnu/system

34
gnu/system/vm.scm
View File

@ -365,7 +365,7 @@ of the GNU system as described by OS."
(check? #f) (check? #f)
(create-mount-point? #t))))) (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 "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 environment with the store shared with the host. MAPPINGS is a list of
<file-system-mapping> to realize in the virtualized OS." <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))))) (string-prefix? "/dev/" source)))))
(operating-system-file-systems os))) (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) (operating-system (inherit os)
(initrd (lambda (file-systems . rest) (initrd (lambda (file-systems . rest)
(apply base-initrd file-systems (apply base-initrd file-systems
@ -391,17 +400,16 @@ environment with the store shared with the host. MAPPINGS is a list of
;; Disable swap. ;; Disable swap.
(swap-devices '()) (swap-devices '())
(file-systems (cons* (file-system ;; XXX: When FULL-BOOT? is true, do not add a 9p mount for /gnu/store
(mount-point "/") ;; since that would lead the bootloader config to look for the kernel and
(device "/dev/vda1") ;; initrd in it.
(type "ext4")) (file-systems (if full-boot?
virtual-file-systems
(file-system (inherit (cons
(mapping->file-system %store-mapping)) (file-system
(needed-for-boot? #t)) (inherit (mapping->file-system %store-mapping))
(needed-for-boot? #t))
(append (map mapping->file-system mappings) virtual-file-systems)))))
user-file-systems)))))
(define* (system-qemu-image/shared-store (define* (system-qemu-image/shared-store
os 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 bootloader; otherwise it directly starts the operating system kernel. The
DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image; DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
it is mostly useful when FULL-BOOT? is true." 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)) (os-drv (operating-system-derivation os))
(image (system-qemu-image/shared-store (image (system-qemu-image/shared-store
os os