~ruther/guix-local

1eeccc2f31c0b0f8c600cb181f19fda1d90551a6 — Ludovic Courtès 12 years ago 4106c58
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(-)

M gnu/system/vm.scm
M gnu/system/vm.scm => gnu/system/vm.scm +35 -14
@@ 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