vm: Formalize use of '-virtfs' options.

* gnu/system/vm.scm (file-system->mount-tag, host-9p-file-system): New
  procedures.
  (virtualized-operating-system): Use 'host-9p-file-system' for the
  store.
  (common-qemu-options): Add 'shared-fs' parameter.
  [virtfs-option]: New procedure.
  Use it.
  (system-qemu-image/shared-store-script): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2014-11-20 22:48:18 +01:00
parent 4dfbdcbcb4
commit 96ffa27ba4
1 changed files with 37 additions and 12 deletions

View File

@ -338,6 +338,26 @@ of the GNU system as described by OS."
("grub.cfg" ,grub.cfg)) ("grub.cfg" ,grub.cfg))
#:copy-inputs? #t)))) #: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) (define (virtualized-operating-system os)
"Return an operating system based on OS suitable for use in a virtualized "Return an operating system based on OS suitable for use in a virtualized
environment with the store shared with the host." environment with the store shared with the host."
@ -356,13 +376,11 @@ environment with the store shared with the host."
(mount-point "/") (mount-point "/")
(device "/dev/vda1") (device "/dev/vda1")
(type "ext4")) (type "ext4"))
(file-system
(mount-point (%store-prefix)) (file-system (inherit
(device "store") (host-9p-file-system (%store-prefix)
(type "9p") (%store-prefix)))
(needed-for-boot? #t) (needed-for-boot? #t))
(options "trans=virtio")
(check? #f))
;; Remove file systems that conflict with those ;; Remove file systems that conflict with those
;; above, or that are normally bound to real devices. ;; 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 #:register-closures? #f
#:copy-inputs? full-boot?))) #:copy-inputs? full-boot?)))
(define* (common-qemu-options image) (define* (common-qemu-options image shared-fs)
"Return the a string-value gexp with the common QEMU options to boot IMAGE." "Return the a string-value gexp with the common QEMU options to boot IMAGE,
#~(string-append 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 \ " -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 \ -net user \
-serial stdio \ -serial stdio \
-drive file=" #$image -drive file=" #$image
@ -447,7 +472,7 @@ exec " #$qemu "/bin/" #$(qemu-command (%current-system))
-initrd " #$os-drv "/initrd \ -initrd " #$os-drv "/initrd \
-append \"" #$(if graphic? "" "console=ttyS0 ") -append \"" #$(if graphic? "" "console=ttyS0 ")
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" ")) "--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1\" "))
#$(common-qemu-options image) #$(common-qemu-options image (list (%store-prefix)))
" \"$@\"\n") " \"$@\"\n")
port) port)
(chmod port #o555)))) (chmod port #o555))))