vm: Keep acceptable file systems from the original OS.

* gnu/system/vm.scm (virtualized-operating-system): Instead of
  completely overriding 'file-systems', use 'remove' to filter out some
  of those declared in OS.
  (system-qemu-image): Likewise.

1 files changed, 35 insertions, 14 deletions

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c6c23213ca..f42feb394c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -292,12 +292,23 @@ basic contents of the root file system of OS."
                             (disk-image-size (* 900 (expt 2 20))))
   "Return the derivation of a freestanding QEMU image of DISK-IMAGE-SIZE bytes
 of the GNU system as described by OS."
+  (define file-systems-to-keep
+    ;; Keep only file systems other than root and not normally bound to real
+    ;; devices.
+    (remove (lambda (fs)
+              (let ((target (file-system-mount-point fs))
+                    (source (file-system-device fs)))
+                (or (string=? target "/")
+                    (string-prefix? "/dev/" source))))
+            (operating-system-file-systems os)))
+
   (let ((os (operating-system (inherit os)
-              ;; The mounted file systems are under our control.
-              (file-systems (list (file-system
+              ;; Force our own root file system.
+              (file-systems (cons (file-system
                                     (mount-point "/")
                                     (device "/dev/sda1")
-                                    (type file-system-type)))))))
+                                    (type file-system-type))
+                                  file-systems-to-keep)))))
     (mlet* %store-monad
         ((os-drv      (operating-system-derivation os))
          (os-dir   -> (derivation->output-path os-drv))
@@ -315,17 +326,27 @@ of the GNU system as described by OS."
 environment with the store shared with the host."
   (operating-system (inherit os)
     (initrd (cut qemu-initrd <> #:volatile-root? #t))
-    (file-systems (list (file-system
-                          (mount-point "/")
-                          (device "/dev/vda1")
-                          (type "ext4"))
-                        (file-system
-                          (mount-point (%store-prefix))
-                          (device "store")
-                          (type "9p")
-                          (needed-for-boot? #t)
-                          (options "trans=virtio")
-                          (check? #f))))))
+    (file-systems (cons* (file-system
+                           (mount-point "/")
+                           (device "/dev/vda1")
+                           (type "ext4"))
+                         (file-system
+                           (mount-point (%store-prefix))
+                           (device "store")
+                           (type "9p")
+                           (needed-for-boot? #t)
+                           (options "trans=virtio")
+                           (check? #f))
+
+                         ;; Remove file systems that conflict with those
+                         ;; above, or that are normally bound to real devices.
+                         (remove (lambda (fs)
+                                   (let ((target (file-system-mount-point fs))
+                                         (source (file-system-device fs)))
+                                     (or (string=? target (%store-prefix))
+                                         (string=? target "/")
+                                         (string-prefix? "/dev/" source))))
+                                 (operating-system-file-systems os))))))
 
 (define* (system-qemu-image/shared-store
           os