02/02: vm: Fix full-boot? option.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 909de139e7f6ab474e6e510a3c15bb4b4731b8cf
Author: David Craven <address@hidden>
Date:   Tue Feb 14 16:28:33 2017 +0100

    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 <address@hidden>
---
 gnu/system/vm.scm | 34 +++++++++++++++++++++-------------
 1 file changed, 21 insertions(+), 13 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 103af37..5c6e7f6 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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