aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/system/vm.scm49
1 files changed, 37 insertions, 12 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 12660d4abc..328168f4f4 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -338,6 +338,26 @@ of the GNU system as described by OS."
("grub.cfg" ,grub.cfg))
#:copy-inputs? #t))))
+(define (file-system->mount-tag fs)
+ "Return a 9p mount tag for host file system FS."
+ ;; QEMU mount tags cannot contain slashes and cannot start with '_'.
+ ;; Compute an identifier that corresponds to the rules.
+ (string-append "TAG"
+ (string-map (match-lambda
+ (#\/ #\_)
+ (chr chr))
+ fs)))
+
+(define (host-9p-file-system source target)
+ "Return a <file-system> to mount the host's SOURCE file system as TARGET in
+the guest, using a 9p virtfs."
+ (file-system
+ (mount-point target)
+ (device (file-system->mount-tag source))
+ (type "9p")
+ (options "trans=virtio")
+ (check? #f)))
+
(define (virtualized-operating-system os)
"Return an operating system based on OS suitable for use in a virtualized
environment with the store shared with the host."
@@ -356,13 +376,11 @@ environment with the store shared with the host."
(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-system (inherit
+ (host-9p-file-system (%store-prefix)
+ (%store-prefix)))
+ (needed-for-boot? #t))
;; Remove file systems that conflict with those
;; above, or that are normally bound to real devices.
@@ -402,11 +420,18 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc."
#:register-closures? #f
#:copy-inputs? full-boot?)))
-(define* (common-qemu-options image)
- "Return the a string-value gexp with the common QEMU options to boot IMAGE."
-#~(string-append
+(define* (common-qemu-options image shared-fs)
+ "Return the a string-value gexp with the common QEMU options to boot IMAGE,
+with '-virtfs' options for the host file systems listed in SHARED-FS."
+ (define (virtfs-option fs)
+ #~(string-append "-virtfs local,path=\"" #$fs
+ "\",security_model=none,mount_tag=\""
+ #$(file-system->mount-tag fs)
+ "\" "))
+
+ #~(string-append
" -enable-kvm -no-reboot -net nic,model=virtio \
- -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \
+ " #$@(map virtfs-option shared-fs) " \
-net user \
-serial stdio \
-drive file=" #$image
@@ -447,7 +472,7 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
-initrd " #$os-drv "/initrd \
-append \"" #$(if graphic? "" "console=ttyS0 ")
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" "))
-#$(common-qemu-options image)
+#$(common-qemu-options image (list (%store-prefix)))
" \"$@\"\n")
port)
(chmod port #o555))))