Revert "tests: Use lower-oci-image-state in container tests."

This reverts commit cc07ecd7cc, which breaks
'guix pull', for to-be-investigated reasons.

Fixes: #2252
Change-Id: Idd02dd2e0cd93034e636030845996a9ab3748839
Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
This commit is contained in:
Giacomo Leidi 2025-08-25 09:17:03 +02:00 committed by Maxim Cournoyer
parent 93006671b4
commit 1f8ee9e023
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 87 additions and 101 deletions

View file

@ -46,9 +46,6 @@
%test-oci-service-rootless-podman
%test-oci-service-docker))
(define lower-oci-image-state
(@@ (gnu services containers) lower-oci-image-state))
(define %rootless-podman-os
(simple-operating-system
@ -72,48 +69,13 @@
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
(define %oci-tarball
(lower-oci-image-state
"guile-guest"
(packages->manifest
(list
guile-3.0 guile-json-3
(package
(name "guest-script")
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments
(list
#:guile guile-3.0
#:builder
#~(let ((out #$output))
(mkdir out)
(call-with-output-file (string-append out "/a.scm")
(lambda (port)
(display "(display \"hello world\n\")" port))))))
(synopsis "Display hello world using Guile")
(description "This package displays the text \"hello world\" on the
standard output device and then enters a new line.")
(home-page #f)
(license license:public-domain))))
'(#:entry-point "bin/guile"
#:localstatedir? #t
#:extra-options (#:image-tag "guile-guest")
#:symlinks (("/bin/Guile" -> "bin/guile")
("aa.scm" -> "a.scm")))
"guile-guest"
(%current-target-system)
(%current-system)
#f))
(define (run-rootless-podman-test)
(define (run-rootless-podman-test oci-tarball)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
(list %oci-tarball))
(list oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@ -292,7 +254,7 @@ standard output device and then enters a new line.")
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
,#$%oci-tarball))
,#$oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@ -345,11 +307,49 @@ standard output device and then enters a new line.")
(gexp->derivation "rootless-podman-test" test))
(define (build-tarball&run-rootless-podman-test)
(mlet* %store-monad
((_ (set-grafting #f))
(guile (set-guile-for-build (default-guile)))
(guest-script-package ->
(package
(name "guest-script")
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments `(#:guile ,guile-3.0
#:builder
(let ((out (assoc-ref %outputs "out")))
(mkdir out)
(call-with-output-file (string-append out "/a.scm")
(lambda (port)
(display "(display \"hello world\n\")" port)))
#t)))
(synopsis "Display hello world using Guile")
(description "This package displays the text \"hello world\" on the
standard output device and then enters a new line.")
(home-page #f)
(license license:public-domain)))
(profile (profile-derivation (packages->manifest
(list guile-3.0 guile-json-3
guest-script-package))
#:hooks '()
#:locales? #f))
(tarball (pack:docker-image
"docker-pack" profile
#:symlinks '(("/bin/Guile" -> "bin/guile")
("aa.scm" -> "a.scm"))
#:extra-options
'(#:image-tag "guile-guest")
#:entry-point "bin/guile"
#:localstatedir? #t)))
(run-rootless-podman-test tarball)))
(define %test-rootless-podman
(system-test
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (run-rootless-podman-test))))
(value (build-tarball&run-rootless-podman-test))))
(define %oci-network

View file

@ -26,7 +26,6 @@
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@ -49,9 +48,6 @@
%test-docker-system
%test-oci-container))
(define lower-oci-image-state
(@@ (gnu services containers) lower-oci-image-state))
(define %docker-os
(simple-operating-system
(service dhcpcd-service-type)
@ -61,41 +57,6 @@
(service containerd-service-type)
(service docker-service-type)))
(define %docker-tarball
(lower-oci-image-state
"guile-guest"
(packages->manifest
(list
guile-3.0 guile-json-3
(package
(name "guest-script")
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments
(list
#:guile guile-3.0
#:builder
#~(let ((out #$output))
(mkdir out)
(call-with-output-file (string-append out "/a.scm")
(lambda (port)
(display "(display \"hello world\n\")" port))))))
(synopsis "Display hello world using Guile")
(description "This package displays the text \"hello world\" on the
standard output device and then enters a new line.")
(home-page #f)
(license license:public-domain))))
'(#:entry-point "bin/guile"
#:localstatedir? #t
#:extra-options (#:image-tag "guile-guest")
#:symlinks (("/bin/Guile" -> "bin/guile")
("aa.scm" -> "a.scm")))
"guile-guest"
(%current-target-system)
(%current-system)
#f))
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@ -212,7 +173,40 @@ inside %DOCKER-OS."
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-test)
(run-docker-test %docker-tarball))
(mlet* %store-monad
((_ (set-grafting #f))
(guile (set-guile-for-build (default-guile)))
(guest-script-package ->
(package
(name "guest-script")
(version "0")
(source #f)
(build-system trivial-build-system)
(arguments `(#:guile ,guile-3.0
#:builder
(let ((out (assoc-ref %outputs "out")))
(mkdir out)
(call-with-output-file (string-append out "/a.scm")
(lambda (port)
(display "(display \"hello world\n\")" port)))
#t)))
(synopsis "Display hello world using Guile")
(description "This package displays the text \"hello world\" on the
standard output device and then enters a new line.")
(home-page #f)
(license license:public-domain)))
(profile (profile-derivation (packages->manifest
(list guile-3.0 guile-json-3
guest-script-package))
#:hooks '()
#:locales? #f))
(tarball (pack:docker-image
"docker-pack" profile
#:symlinks '(("/bin/Guile" -> "bin/guile")
("aa.scm" -> "a.scm"))
#:entry-point "bin/guile"
#:localstatedir? #t)))
(run-docker-test tarball)))
(define %test-docker
(system-test
@ -221,22 +215,8 @@ inside %DOCKER-OS."
(value (build-tarball&run-docker-test))))
(define %docker-system-tarball
(lower-oci-image-state
"guix-system-guest"
(operating-system
(inherit (simple-operating-system))
;; Use locales for a single libc to
;; reduce space requirements.
(locale-libcs (list glibc)))
'()
"guix-system-guest"
(%current-target-system)
(%current-system)
#f))
(define (run-docker-system-test tarball)
"Load TARBALL as Docker image and run it in a Docker container,
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@ -353,15 +333,21 @@ inside %DOCKER-OS."
(gexp->derivation "docker-system-test" test))
(define (build-tarball&run-docker-system-test)
(run-docker-system-test %docker-system-tarball))
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
(value (build-tarball&run-docker-system-test))))
(value (with-monad %store-monad
(>>= (lower-object
(system-image (os->image
(operating-system
(inherit (simple-operating-system))
;; Use locales for a single libc to
;; reduce space requirements.
(locale-libcs (list glibc)))
#:type docker-image-type)))
run-docker-system-test)))))
(define %oci-os