aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2023-01-30 11:33:18 +0200
committerEfraim Flashner <efraim@flashner.co.il>2023-01-30 12:39:40 +0200
commit4cf1acc7f3033b50b0bf19e02c9f522d522d338c (patch)
tree9fd64956ee60304c15387eb394cd649e49f01467 /gnu/system/vm.scm
parentedb8c09addd186d9538d43b12af74d6c7aeea082 (diff)
parent595b53b74e3ef57a1c0c96108ba86d38a170a241 (diff)
downloadguix-4cf1acc7f3033b50b0bf19e02c9f522d522d338c.tar.gz
guix-4cf1acc7f3033b50b0bf19e02c9f522d522d338c.zip
Merge remote-tracking branch 'origin/master' into core-updates
Conflicts: doc/guix.texi gnu/local.mk gnu/packages/admin.scm gnu/packages/base.scm gnu/packages/chromium.scm gnu/packages/compression.scm gnu/packages/databases.scm gnu/packages/diffoscope.scm gnu/packages/freedesktop.scm gnu/packages/gnome.scm gnu/packages/gnupg.scm gnu/packages/guile.scm gnu/packages/inkscape.scm gnu/packages/llvm.scm gnu/packages/openldap.scm gnu/packages/pciutils.scm gnu/packages/ruby.scm gnu/packages/samba.scm gnu/packages/sqlite.scm gnu/packages/statistics.scm gnu/packages/syndication.scm gnu/packages/tex.scm gnu/packages/tls.scm gnu/packages/version-control.scm gnu/packages/xml.scm guix/build-system/copy.scm guix/scripts/home.scm
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm27
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))))