GNU bug report logs - #45979
system: vm: Introduce system-qemu-image/script.

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Mathieu Othacehe <othacehe@HIDDEN>; dated Tue, 19 Jan 2021 13:17:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.

Message received at 45979 <at> debbugs.gnu.org:


Received: (at 45979) by debbugs.gnu.org; 19 Jan 2021 15:14:00 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Jan 19 10:14:00 2021
Received: from localhost ([127.0.0.1]:51274 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1l1shk-0001bM-4c
	for submit <at> debbugs.gnu.org; Tue, 19 Jan 2021 10:14:00 -0500
Received: from eggs.gnu.org ([209.51.188.92]:33036)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <othacehe@HIDDEN>) id 1l1shj-0001b6-CJ
 for 45979 <at> debbugs.gnu.org; Tue, 19 Jan 2021 10:13:59 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e]:53720)
 by eggs.gnu.org with esmtp (Exim 4.90_1)
 (envelope-from <othacehe@HIDDEN>) id 1l1she-0001nC-7O
 for 45979 <at> debbugs.gnu.org; Tue, 19 Jan 2021 10:13:54 -0500
Received: from [2a01:e0a:19b:d9a0:1538:87ab:3a95:7600] (port=40334 helo=cervin)
 by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <othacehe@HIDDEN>) id 1l1shd-0005e7-FM
 for 45979 <at> debbugs.gnu.org; Tue, 19 Jan 2021 10:13:53 -0500
From: Mathieu Othacehe <othacehe@HIDDEN>
To: 45979 <at> debbugs.gnu.org
Subject: Re: [bug#45979] system: vm: Introduce system-qemu-image/script.
References: <87a6t5xe11.fsf@HIDDEN>
Date: Tue, 19 Jan 2021 16:13:51 +0100
In-Reply-To: <87a6t5xe11.fsf@HIDDEN> (Mathieu Othacehe's message of "Tue, 19
 Jan 2021 14:16:42 +0100")
Message-ID: <8735yxx8ls.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 45979
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)


> 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




Information forwarded to guix-patches@HIDDEN:
bug#45979; Package guix-patches. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 19 Jan 2021 13:16:53 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Jan 19 08:16:53 2021
Received: from localhost ([127.0.0.1]:49701 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1l1qsL-0001ly-Qd
	for submit <at> debbugs.gnu.org; Tue, 19 Jan 2021 08:16:53 -0500
Received: from lists.gnu.org ([209.51.188.17]:58466)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <othacehe@HIDDEN>) id 1l1qsG-0001ll-UM
 for submit <at> debbugs.gnu.org; Tue, 19 Jan 2021 08:16:48 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:48220)
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <othacehe@HIDDEN>) id 1l1qsG-0006qY-OY
 for guix-patches@HIDDEN; Tue, 19 Jan 2021 08:16:44 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e]:51487)
 by eggs.gnu.org with esmtp (Exim 4.90_1)
 (envelope-from <othacehe@HIDDEN>) id 1l1qsF-0008DK-Vu
 for guix-patches@HIDDEN; Tue, 19 Jan 2021 08:16:44 -0500
Received: from [2a01:e0a:19b:d9a0:1538:87ab:3a95:7600] (port=38274 helo=cervin)
 by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256)
 (Exim 4.82) (envelope-from <othacehe@HIDDEN>) id 1l1qsF-0003BD-Da
 for guix-patches@HIDDEN; Tue, 19 Jan 2021 08:16:43 -0500
From: Mathieu Othacehe <othacehe@HIDDEN>
To: guix-patches@HIDDEN
Subject: system: vm: Introduce system-qemu-image/script.
Date: Tue, 19 Jan 2021 14:16:42 +0100
Message-ID: <87a6t5xe11.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

--=-=-=
Content-Type: text/plain


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

--=-=-=
Content-Type: text/x-diff
Content-Disposition: inline;
 filename=0001-system-vm-Introduce-system-qemu-image-script.patch

From 3f1aff7d391453adbbe4a693ae20f4e0f2d5fcf6 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@HIDDEN>
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


--=-=-=--




Acknowledgement sent to Mathieu Othacehe <othacehe@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#45979; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Tue, 19 Jan 2021 15:15:01 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.