bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: foreign: Add utilities for resizing foreign images.

Browse source 
* gnu/tests/foreign.scm
(qcow-image-with-marionette): Add resize-image and
resize-proc to resize the image, the partition and the file system.
(resize-ext4-partition): New variable.
(run-foreign-install-test): Add resize-image and resize-proc; Pass them to
qcow-image-with-marionette.

Change-Id: I92dbe0cdcafb5ff0a0b6c3e9b96205b4ad9d10e8
Signed-off-by: Rutherther <rutherther@ditigal.xyz>
This commit is contained in:
Rutherther 2025-12-23 14:36:07 +01:00
parent efec531f5e
commit 1d27f4029c
No known key found for this signature in database
GPG key ID: 0322798269E471C3
1 changed files with 58 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
gnu/tests/foreign.scm
View file

@ -29,7 +29,9 @@
#:use-module ((gnu tests base)
#:select (%hello-dependencies-manifest
guix-daemon-test-cases))
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu packages linux)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
#:use-module (gnu packages make-bootstrap)
@ -57,10 +59,17 @@ ExecStart=/opt/guix/bin/guile --no-auto-compile \\
(define* (qcow-image-with-marionette image
#:key
(name "image-with-marionette.qcow2")
(device "/dev/vdb1"))
(device "/dev/vdb1")
(resize-image #f)
(resize-proc #~(const #f)))
"Instrument IMAGE, returning a new image that contains a statically-linked
Guile under /opt/guix and a marionette systemd service. The relevant file
system is expected to be on DEVICE."
system is expected to be on DEVICE. When RESIZE-IMAGE is not #f, it is
supplied as an argument to qemu-img resize as new size of the image, eg.
\"+1G\" to add 1 GiB to the partition and its file system. RESIZE-PROC is a
gexp evaluating to a two-argument procedure. The two arguments are device and
marionette. This procedure will be called from within a VM and it should
resize the partition and file system, if appropriate."
(define vm
(virtual-machine
(marionette-operating-system %simple-os)))
@ -80,6 +89,10 @@ system is expected to be on DEVICE."
"create" "-b" #$image
"-F" "qcow2" "-f" "qcow2" target-image)
(when #$resize-image
(invoke (string-append #+qemu "/bin/qemu-img")
"resize" target-image #$resize-image))
;; Run a VM that will mount IMAGE and populate it. This is somewhat
;; more convenient to set up than 'guestfish' from libguestfs.
(let ((marionette
@ -89,6 +102,8 @@ system is expected to be on DEVICE."
",format=qcow2,if=virtio,"
"cache=writeback,werror=report,readonly=off")))))
(#$resize-proc #$device marionette)
(unless (zero? (marionette-eval '(system* "mount" #$device "/mnt")
marionette))
(error "failed to mount foreign distro image" #$device))
@ -134,6 +149,32 @@ system is expected to be on DEVICE."
(computed-file name build))
(define resize-ext4-partition
;; Gexp evaluating to a two-argument procedure, taking DEVICE and
;; MARIONETTE. It will grow the given device and its file system to 100 %
;; of the empty space on the image.
#~(lambda (device marionette)
(unless (zero? (marionette-eval
`(system*
#$(file-append cloud-utils "/bin/growpart")
(string-take ,device (- (string-length ,device) 1))
(string-take-right ,device 1))
marionette))
(error "failed to grow the partition"))
;; ;; resize2fs will refuse operation when e2fsck is not ran.
(unless (zero? (marionette-eval
`(system* #$(file-append e2fsprogs "/sbin/e2fsck")
"-fy" ,device)
marionette))
(error "failed to repair the file system"))
(unless (zero? (marionette-eval
`(system* #$(file-append e2fsprogs "/sbin/resize2fs")
,device)
marionette))
(error "failed to grow the file system"))))
(define (manifest-entry-without-grafts entry)
"Return ENTRY with grafts disabled on its contents."
(manifest-entry
@ -159,16 +200,26 @@ system is expected to be on DEVICE."
(file-append (package-source guix) "/etc/guix-install.sh"))
(define* (run-foreign-install-test image name
#:key (device "/dev/vdb1")
(deb-files '()))
#:key
(device "/dev/vdb1")
(deb-files '())
(resize-image #f)
(resize-proc #~(const #f)))
"Run an installation of Guix in IMAGE, the QCOW2 image of a systemd-based
GNU/Linux distro, and check that the installation is functional. The root
partition of IMAGE is expected to be on DEVICE. Prior to that, install all
of DEB-FILES with 'dpkg -i'."
partition of IMAGE is expected to be on DEVICE. Prior to that, install all of
DEB-FILES with 'dpkg -i'. When RESIZE-IMAGE is not #f, it is supplied as an
argument to qemu-img resize as new size of the image, eg. \"+1G\" to add 1
GiB to the partition and its file system. RESIZE-PROC is a gexp evaluating to
a two-argument procedure. The two arguments are device and marionette. This
procedure will be called from within a VM and it should resize the partition
and file system, if appropriate."
(define instrumented-image
(qcow-image-with-marionette image
#:name (string-append name ".qcow2")
#:device device))
#:device device
#:resize-image resize-image
#:resize-proc resize-proc))
(define (test tarball)
(with-imported-modules (source-module-closure