Package: guix-patches;
Reported by: Mathieu Othacehe <othacehe <at> gnu.org>
Date: Tue, 19 Jan 2021 13:17:02 UTC
Severity: normal
Done: Mathieu Othacehe <othacehe <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 45979 in the body.
You can then email your comments to 45979 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#45979; Package guix-patches.
(Tue, 19 Jan 2021 13:17:02 GMT) Full text and rfc822 format available.Mathieu Othacehe <othacehe <at> gnu.org>:guix-patches <at> gnu.org.
(Tue, 19 Jan 2021 13:17:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: guix-patches <at> gnu.org Subject: system: vm: Introduce system-qemu-image/script. Date: Tue, 19 Jan 2021 14:16:42 +0100
[Message part 1 (text/plain, inline)]
Hello, Here's a patch turning system-qemu-image/shared-store-script into system-qemu-image/script so that it can be used for system test requiring a read-write store. Thanks, Mathieu
[0001-system-vm-Introduce-system-qemu-image-script.patch (text/x-diff, inline)]
From 3f1aff7d391453adbbe4a693ae20f4e0f2d5fcf6 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe <at> gnu.org>
Date: Tue, 19 Jan 2021 13:57:52 +0100
Subject: [PATCH] system: vm: Introduce system-qemu-image/script.
Some system tests may require to run a virtual machine with a freestanding
store, that can be written to. This is not possible when using the host store
as a read-only mount. Add a "shared-store?" field to the <virtual-machine>
record, so that it can be lowered to a virtual machine running a freestanding
Guix System image.
* gnu/system/vm.scm (system-qemu-image/shared-store-script): Rename to ...
(system-qemu-image/script): ... this new procedure. Add a "shared-store?"
argument and honor it.
(<virtual-machine>)[shared-store?]: New field.
(virtual-machine-compiler): Honor it.
* guix/scripts/system.scm (system-derivation-for-action): Adapt accordingly.
* gnu/tests/base.scm (%test-basic-os): Adapt comment.
---
gnu/system/vm.scm | 112 ++++++++++++++++++++++++----------------
gnu/tests/base.scm | 2 +-
guix/scripts/system.scm | 14 ++---
3 files changed, 75 insertions(+), 53 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 1afae6b4ed..945b9d1378 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -52,8 +52,10 @@
#:use-module (gnu packages linux)
#:use-module (gnu packages admin)
+ #:use-module (gnu image)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module (gnu system linux-container)
@@ -65,7 +67,7 @@
#:use-module (gnu services base)
#:use-module (gnu system uuid)
- #:use-module (srfi srfi-1)
+ #:use-module ((srfi srfi-1) #:hide (partition))
#:use-module (srfi srfi-26)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
@@ -76,7 +78,7 @@
system-qemu-image
system-qemu-image/shared-store
- system-qemu-image/shared-store-script
+ system-qemu-image/script
system-docker-image
virtual-machine
@@ -772,22 +774,25 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
(format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly"
#$image)))
-(define* (system-qemu-image/shared-store-script os
- #:key
- (system (%current-system))
- (target (%current-target-system))
- (qemu qemu)
- (graphic? #t)
- (memory-size 256)
- (mappings '())
- full-boot?
- (disk-image-size
- (* (if full-boot? 500 70)
- (expt 2 20)))
- (options '()))
+(define* (system-qemu-image/script os
+ #:key
+ (system (%current-system))
+ (target (%current-target-system))
+ (qemu qemu)
+ (graphic? #t)
+ (shared-store? #t)
+ (memory-size 256)
+ (mappings '())
+ (full-boot?
+ (not shared-store?))
+ (disk-image-size
+ (* (if full-boot? 500 70)
+ (expt 2 20)))
+ (options '()))
"Return a derivation that builds a script to run a virtual machine image of
-OS that shares its store with the host. The virtual machine runs with
-MEMORY-SIZE MiB of memory.
+OS that shares its store with the host or uses a freestanding Guix System
+image is SHARED-STORE? is false. The virtual machine runs with MEMORY-SIZE
+MiB of memory.
MAPPINGS is a list of <file-system-mapping> specifying mapping of host file
systems into the guest.
@@ -796,13 +801,22 @@ When FULL-BOOT? is true, the returned script runs everything starting from the
bootloader; otherwise it directly starts the operating system kernel. The
DISK-IMAGE-SIZE parameter specifies the size in bytes of the root disk image;
it is mostly useful when FULL-BOOT? is true."
- (mlet* %store-monad ((os -> (virtualized-operating-system os mappings full-boot?))
- (image (system-qemu-image/shared-store
- os
- #:system system
- #:target target
- #:full-boot? full-boot?
- #:disk-image-size disk-image-size)))
+ (mlet* %store-monad
+ ((os -> (virtualized-operating-system os mappings full-boot?))
+ (image (if shared-store?
+ (system-qemu-image/shared-store
+ os
+ #:system system
+ #:target target
+ #:full-boot? full-boot?
+ #:disk-image-size disk-image-size)
+ (lower-object
+ (system-image
+ (image
+ (inherit (os->image os #:type qcow2-image-type))
+ (size disk-image-size)))
+ system
+ #:target target))))
(define kernel-arguments
#~(list #$@(if graphic? #~() #~("console=ttyS0"))
#+@(operating-system-kernel-arguments os "/dev/vda1")))
@@ -818,7 +832,9 @@ it is mostly useful when FULL-BOOT? is true."
(string-join #$kernel-arguments " "))))
#$@(common-qemu-options image
(map file-system-mapping-source
- (cons %store-mapping mappings)))
+ (if shared-store?
+ (cons %store-mapping mappings)
+ mappings)))
"-m " (number->string #$memory-size)
#$@options))
@@ -845,6 +861,8 @@ it is mostly useful when FULL-BOOT? is true."
(default qemu))
(graphic? virtual-machine-graphic? ;Boolean
(default #f))
+ (shared-store? virtual-machine-shared-store? ;Boolean
+ (default #t))
(memory-size virtual-machine-memory-size ;integer (MiB)
(default 256))
(disk-image-size virtual-machine-disk-image-size ;integer (bytes)
@@ -876,29 +894,33 @@ FORWARDINGS is a list of host-port/guest-port pairs."
(define-gexp-compiler (virtual-machine-compiler (vm <virtual-machine>)
system target)
(match vm
- (($ <virtual-machine> os qemu graphic? memory-size disk-image-size ())
- (system-qemu-image/shared-store-script os
- #:system system
- #:target target
- #:qemu qemu
- #:graphic? graphic?
- #:memory-size memory-size
- #:disk-image-size
- disk-image-size))
- (($ <virtual-machine> os qemu graphic? memory-size disk-image-size
- forwardings)
+ (($ <virtual-machine> os qemu graphic? shared-store? memory-size
+ disk-image-size ())
+ (system-qemu-image/script os
+ #:system system
+ #:target target
+
+ #:qemu qemu
+ #:graphic? graphic?
+ #:shared-store? shared-store?
+ #:memory-size memory-size
+ #:disk-image-size
+ disk-image-size))
+ (($ <virtual-machine> os qemu graphic? shared-store? memory-size
+ disk-image-size forwardings)
(let ((options
`("-nic" ,(string-append
"user,model=virtio-net-pci,"
(port-forwardings->qemu-options forwardings)))))
- (system-qemu-image/shared-store-script os
- #:system system
- #:target target
- #:qemu qemu
- #:graphic? graphic?
- #:memory-size memory-size
- #:disk-image-size
- disk-image-size
- #:options options)))))
+ (system-qemu-image/script os
+ #:system system
+ #:target target
+ #:qemu qemu
+ #:graphic? graphic?
+ #:shared-store? shared-store?
+ #:memory-size memory-size
+ #:disk-image-size
+ disk-image-size
+ #:options options)))))
;;; vm.scm ends here
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index e5f9b87b1d..16163bc1f3 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -524,7 +524,7 @@ functionality tests.")
(vm (virtual-machine os)))
;; XXX: Add call to 'virtualized-operating-system' to get the exact same
;; set of services as the OS produced by
- ;; 'system-qemu-image/shared-store-script'.
+ ;; 'system-qemu-image/script'.
(run-basic-test (virtualized-operating-system os '())
#~(list #$vm))))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index eb7137b7a9..f805db7a72 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -698,13 +698,13 @@ checking this by themselves in their 'check' procedure."
((vm-image)
(system-qemu-image os #:disk-image-size image-size))
((vm)
- (system-qemu-image/shared-store-script os
- #:full-boot? full-boot?
- #:disk-image-size
- (if full-boot?
- image-size
- (* 70 (expt 2 20)))
- #:mappings mappings))
+ (system-qemu-image/script os
+ #:full-boot? full-boot?
+ #:disk-image-size
+ (if full-boot?
+ image-size
+ (* 70 (expt 2 20)))
+ #:mappings mappings))
((disk-image)
(let* ((base-image (os->image os #:type image-type))
(base-target (image-target base-image)))
--
2.29.2
guix-patches <at> gnu.org:bug#45979; Package guix-patches.
(Tue, 19 Jan 2021 15:14:02 GMT) Full text and rfc822 format available.Message #8 received at 45979 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: 45979 <at> debbugs.gnu.org Subject: Re: [bug#45979] system: vm: Introduce system-qemu-image/script. Date: Tue, 19 Jan 2021 16:13:51 +0100
> Here's a patch turning system-qemu-image/shared-store-script into > system-qemu-image/script so that it can be used for system test > requiring a read-write store. While this achieves the desired effect, producing big freestanding images is quite inconvenient for the tests. In wonder if it could be possible to overlay the store 9p mount and keep using VM with shared store. Mathieu
Mathieu Othacehe <othacehe <at> gnu.org>:Mathieu Othacehe <othacehe <at> gnu.org>:Message #13 received at 45979-done <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: 45979-done <at> debbugs.gnu.org Subject: Re: bug#45979: system: vm: Introduce system-qemu-image/script. Date: Fri, 26 Mar 2021 10:55:31 +0100
Hello, > While this achieves the desired effect, producing big freestanding > images is quite inconvenient for the tests. In wonder if it could be > possible to overlay the store 9p mount and keep using VM with shared > store. I don't have any need for that patch right now, so closing. Thanks, Mathieu
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Fri, 23 Apr 2021 11:24:12 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.