From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Craven Subject: [PATCH 6/8] vm: Improve readability of run-vm.sh generation. Date: Tue, 14 Feb 2017 16:28:32 +0100 Message-ID: <20170214152834.19651-8-david@craven.ch> References: <20170214152834.19651-1-david@craven.ch> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:48290) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cdf2g-0002I4-6n for guix-devel@gnu.org; Tue, 14 Feb 2017 10:29:25 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cdf2c-0002Wq-Pg for guix-devel@gnu.org; Tue, 14 Feb 2017 10:29:22 -0500 Received: from so254-10.mailgun.net ([198.61.254.10]:53304) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cdf2c-0002UM-Im for guix-devel@gnu.org; Tue, 14 Feb 2017 10:29:18 -0500 In-Reply-To: <20170214152834.19651-1-david@craven.ch> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * gnu/system/vm.scm (common-qemu-options, system-qemu-image/shared-store-script): Improve readability. --- gnu/system/vm.scm | 69 ++++++++++++++++++++++++++++++------------------------- 1 file changed, 38 insertions(+), 31 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index a7203d169..103af37c9 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -434,25 +434,26 @@ bootloader refers to: OS kernel, initrd, bootloader data, etc." (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) - "\" ")) + #~(format #f "-virtfs local,path=~s,security_model=none,mount_tag=~s" + #$fs #$(file-system->mount-tag fs))) - #~(string-append - ;; Only enable kvm if we see /dev/kvm exists. + #~(;; Only enable kvm if we see /dev/kvm exists. ;; This allows users without hardware virtualization to still use these ;; commands. - #$(if (file-exists? "/dev/kvm") - " -enable-kvm " - "") - " -no-reboot -net nic,model=virtio \ - " #$@(map virtfs-option shared-fs) " \ - -vga std \ - -drive file=" #$image - ",if=virtio,cache=writeback,werror=report,readonly \ - -m 256")) + #$@(if (file-exists? "/dev/kvm") + '("-enable-kvm") + '()) + + "-no-reboot" + "-net nic,model=virtio" + + #$@(map virtfs-option shared-fs) + "-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 #:key @@ -479,25 +480,31 @@ it is mostly useful when FULL-BOOT? is true." os #:full-boot? full-boot? #: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 #~(call-with-output-file #$output (lambda (port) - (display - (string-append "#!" #$bash "/bin/sh -exec " #$qemu "/bin/" #$(qemu-command (%current-system)) - -#$@(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) + (format port "#!~a~% exec ~a \"$@\"~%" + #$(file-append bash "/bin/sh") + (string-join #$qemu-exec " ")) (chmod port #o555)))) (gexp->derivation "run-vm.sh" builder))) -- 2.11.1