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:
		
							parent
							
								
									4dfbdcbcb4
								
							
						
					
					
						commit
						96ffa27ba4
					
				
					 1 changed files with 37 additions and 12 deletions
				
			
		|  | @ -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)))) | ||||
|  |  | |||
		Reference in a new issue