diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-12-06 15:06:35 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-12-06 15:06:35 +0100 |
commit | f59aa79ca342ef311a20dafc782adea6eed29b1a (patch) | |
tree | 27b6b2740bf537b2396af999dad7c33f238f44ad /gnu/system | |
parent | 2493de0d1a481f079580a354430b26977afbdbd1 (diff) | |
download | guix-patches-f59aa79ca342ef311a20dafc782adea6eed29b1a.tar guix-patches-f59aa79ca342ef311a20dafc782adea6eed29b1a.tar.gz |
system: vm: Non-volatile 'run-vm.sh' creates a CoW image.
Previously, copying the image would consume a lot of space and was
I/O-intensive, to the point that the marionette connection timeout of
20s could be reached when running tests like "docker-system".
* gnu/system/vm.scm (common-qemu-options): Pass 'format=' for each
'-drive' option.
(system-qemu-image/shared-store-script)[copy-image]: New variable.
[builder]: Use it when VOLATILE? is false.
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/vm.scm | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index c2f7efa966..b7bccd72a4 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org> ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> @@ -234,8 +234,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." #$@(map virtfs-option shared-fs) #$@(if rw-image? - #~((format #f "-drive file=~a,if=virtio" #$image)) - #~((format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on" + #~((format #f "-drive file=~a,format=qcow2,if=virtio" #$image)) + #~((format #f "-drive file=~a,format=raw,if=virtio,cache=writeback,werror=report,readonly=on" #$image))))) (define* (system-qemu-image/shared-store-script os @@ -303,17 +303,26 @@ useful when FULL-BOOT? is true." "-m " (number->string #$memory-size) #$@options)) + (define copy-image + ;; Script that "copies" BASE-IMAGE to /tmp. Make a copy-on-write image, + ;; which is much cheaper than actually copying it. + (program-file "copy-image" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (unless (file-exists? #$rw-image) + (invoke #+(file-append qemu "/bin/qemu-img") + "create" "-b" #$base-image + "-F" "raw" "-f" "qcow2" #$rw-image)))))) + (define builder #~(call-with-output-file #$output (lambda (port) (format port "#!~a~%" #+(file-append bash "/bin/sh")) - (when (not #$volatile?) - (format port "~a~%" - #$(program-file "copy-image" - #~(unless (file-exists? #$rw-image) - (copy-file #$base-image #$rw-image) - (chmod #$rw-image #o640))))) + #$@(if volatile? + #~() + #~((format port "~a~%" #+copy-image))) (format port "exec ~a \"$@\"~%" (string-join #$qemu-exec " ")) (chmod port #o555)))) |