mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
tests: Use lower-oci-image-state in container tests.
This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * 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 Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
This commit is contained in:
Giacomo Leidi
Maxim Cournoyer
parent
60f4d72590
commit
cc07ecd7cc
2 changed files with 101 additions and 87 deletions
|
|
@ -46,6 +46,9 @@
|
|||
%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
|
||||
|
|
@ -69,13 +72,48 @@
|
|||
(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
|
||||
(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 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 +292,7 @@
|
|||
(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 +345,11 @@
|
|||
|
||||
(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-network
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@
|
|||
#: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)
|
||||
|
|
@ -48,6 +49,9 @@
|
|||
%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)
|
||||
|
|
@ -57,6 +61,41 @@
|
|||
(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."
|
||||
|
|
@ -173,40 +212,7 @@ inside %DOCKER-OS."
|
|||
(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 +221,22 @@ standard output device and then enters a new line.")
|
|||
(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 +353,15 @@ 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 (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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue