ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

vm: Keep acceptable file systems from the original OS.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2014-05-14 23:15:51 +02:00
parent 4106c58988
commit 1eeccc2f31
1 changed files with 35 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
gnu/system/vm.scm
View file

@ -292,12 +292,23 @@ (define* (system-qemu-image 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 @@ (define (virtualized-operating-system 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