[bug#76081,v7,4/5] tests: Use lower-oci-image-state in container tests.
Commit Message
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
@@ -75,6 +75,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(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 `(#: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))))
+ '(#: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 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))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(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")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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 (build-tarball&run-rootless-podman-test))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#: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)
@@ -57,6 +58,40 @@ (define %docker-os
(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 `(#: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))))
+ '(#: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."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(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 DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(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 (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)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os