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

vm: Improve readability of run-vm.sh generation.

Browse source 
* gnu/system/vm.scm (common-qemu-options,
system-qemu-image/shared-store-script): Improve readability.
This commit is contained in:
David Craven 2017-02-14 16:28:32 +01:00 committed by Danny Milosavljevic
parent 43fe431cce
commit 26a076ed69
No known key found for this signature in database
GPG key ID: E71A35542C30BAA5
1 changed files with 39 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

71
gnu/system/vm.scm
View file

@ -434,25 +434,26 @@ (define* (system-qemu-image/shared-store
(define* (common-qemu-options image shared-fs) (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,
with '-virtfs' options for the host file systems listed in SHARED-FS." 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 (define (virtfs-option fs)
;; Only enable kvm if we see /dev/kvm exists. #~(format #f "-virtfs local,path=~s,security_model=none,mount_tag=~s"
#$fs #$(file-system->mount-tag fs)))
#~(;; Only enable kvm if we see /dev/kvm exists.
;; This allows users without hardware virtualization to still use these ;; This allows users without hardware virtualization to still use these
;; commands. ;; commands.
#$(if (file-exists? "/dev/kvm") #$@(if (file-exists? "/dev/kvm")
" -enable-kvm " '("-enable-kvm")
"") '())
" -no-reboot -net nic,model=virtio \
" #$@(map virtfs-option shared-fs) " \ "-no-reboot"
-vga std \ "-net nic,model=virtio"
-drive file=" #$image
",if=virtio,cache=writeback,werror=report,readonly \ #$@(map virtfs-option shared-fs)
-m 256")) "-vga std"
(format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
#$image)
"-m 256"))
(define* (system-qemu-image/shared-store-script os (define* (system-qemu-image/shared-store-script os
#:key #:key
@ -479,25 +480,31 @@ (define* (system-qemu-image/shared-store-script os
os os
#:full-boot? full-boot? #:full-boot? full-boot?
#:disk-image-size disk-image-size))) #:disk-image-size disk-image-size)))
(define kernel-arguments
#~(list "--root=/dev/vda1"
(string-append "--system=" #$os-drv)
(string-append "--load=" #$os-drv "/boot")
#$@(if graphic? #~() #~("console=ttyS0"))
#+@(operating-system-kernel-arguments os)))
(define qemu-exec
#~(list (string-append #$qemu "/bin/" #$(qemu-command (%current-system)))
#$@(if full-boot?
#~()
#~("-kernel" #$(operating-system-kernel-file os)
"-initrd" #$(file-append os-drv "/initrd")
(format #f "-append ~s"
(string-join #$kernel-arguments " "))))
#$@(common-qemu-options image
(map file-system-mapping-source
(cons %store-mapping mappings)))))
(define builder (define builder
#~(call-with-output-file #$output #~(call-with-output-file #$output
(lambda (port) (lambda (port)
(display (format port "#!~a~% exec ~a \"$@\"~%"
(string-append "#!" #$bash "/bin/sh #$(file-append bash "/bin/sh")
exec " #$qemu "/bin/" #$(qemu-command (%current-system)) (string-join #$qemu-exec " "))
#$@(if full-boot?
#~()
#~(" -kernel " #$(operating-system-kernel-file os) " \
-initrd " #$os-drv "/initrd \
-append \"" #$(if graphic? "" "console=ttyS0 ")
"--system=" #$os-drv " --load=" #$os-drv "/boot --root=/dev/vda1 "
(string-join (list #+@(operating-system-kernel-arguments os))) "\" "))
#$(common-qemu-options image
(map file-system-mapping-source
(cons %store-mapping mappings)))
" \"$@\"\n")
port)
(chmod port #o555)))) (chmod port #o555))))
(gexp->derivation "run-vm.sh" builder))) (gexp->derivation "run-vm.sh" builder)))