summaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/base.scm2
-rw-r--r--gnu/tests/containers.scm561
-rw-r--r--gnu/tests/docker.scm97
-rw-r--r--gnu/tests/install.scm2
-rw-r--r--gnu/tests/lightdm.scm2
-rw-r--r--gnu/tests/messaging.scm2
-rw-r--r--gnu/tests/networking.scm2
-rw-r--r--gnu/tests/telephony.scm2
-rw-r--r--gnu/tests/virtualization.scm34
-rw-r--r--gnu/tests/vnc.scm2
-rw-r--r--gnu/tests/web.scm73
11 files changed, 637 insertions, 142 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index fd758f6586..f96d781b52 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2020, 2022, 2024-2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
-;;; Copyright © 2022, 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2022, 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
;;; Copyright © 2024 Dariqq <dariqq@posteo.net>
;;;
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 618da2a92c..1a442cddc6 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -133,7 +138,7 @@
(status (close-pipe port)))
output)))
(let* ((bash
- ,(string-append #$bash "/bin/bash"))
+ (string-append #$bash "/bin/bash"))
(response1
(slurp bash "-c"
(string-append "ls -la /sys/fs/cgroup | "
@@ -345,3 +350,555 @@ standard output device and then enters a new line.")
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-network
+ (oci-network-configuration (name "my-network")))
+
+(define %oci-volume
+ (oci-volume-configuration (name "my-volume")))
+
+(define %oci-wait-for-file
+ #~(define (wait-for-file file)
+ ;; Wait until FILE shows up.
+ (let loop ((i 6))
+ (cond ((file-exists? file)
+ #t)
+ ((zero? i)
+ (error "file didn't show up" file))
+ (else
+ (pk 'wait-for-file file)
+ (sleep 1)
+ (loop (- i 1)))))))
+
+(define %oci-read-lines
+ #~(define (read-lines file-or-port)
+ (define (loop-lines port)
+ (let loop ((lines '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (reverse lines))
+ (line
+ (loop (cons line lines))))))
+
+ (if (port? file-or-port)
+ (loop-lines file-or-port)
+ (call-with-input-file file-or-port
+ loop-lines))))
+
+(define %oci-slurp
+ #~(define slurp
+ (lambda args
+ (let* ((port
+ (apply open-pipe* OPEN_READ
+ (list "sh" "-l" "-c"
+ (string-join args " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output))))
+
+(define (%oci-rootless-podman-run commands)
+ #~((use-modules (srfi srfi-1)
+ (ice-9 format)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 rdelim)
+ (gnu build oci-containers))
+
+ #$%oci-wait-for-file
+ #$%oci-read-lines
+ #$%oci-slurp
+
+ (define responses
+ (map
+ (lambda (index)
+ (format #f "/tmp/response_~a" index))
+ (iota (length '#$commands))))
+
+ (match (primitive-fork)
+ (0
+ (begin
+ (setgid (passwd:gid (getpwnam "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let* ((outputs
+ (list #$@commands))
+ (outputs-responses
+ (zip outputs responses)))
+ (for-each
+ (match-lambda
+ ((output response)
+ (call-with-output-file response
+ (lambda (port)
+ (display (string-join output "\n") port)))))
+ outputs-responses))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (for-each wait-for-file responses)
+ (map
+ (lambda (response)
+ (sort (slurp "cat" response) string<=?))
+ responses)))
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcpcd-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list %oci-network))
+ (volumes
+ (list %oci-volume))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))
+(display c)
+(newline)
+(sleep 1)
+(when (positive? c)
+ (l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #:imported-modules '((gnu build oci-containers)
+ (gnu build dbus-service)
+ (gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (volatile? #f)
+ (memory-size 1024)
+ (disk-image-size (* 5000 (expt 2 20)))
+ (port-forwardings '())))
+
+ (define test
+ (with-imported-modules '((gnu build oci-containers)
+ (gnu build dbus-service)
+ (gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+ (gnu build dbus-service)
+ (gnu build marionette))
+
+ (define marionette
+ ;; Relax timeout to accommodate older systems and
+ ;; allow for pulling the image.
+ (make-marionette (list #$vm) #:timeout 60))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "rootless-podman-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((oci-object-service-available?
+ "/run/current-system/profile/bin/podman"
+ "volume"
+ '("my-volume")
+ #:verbose? #t))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1 (equal? '("my-volume") (run-test)))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((oci-object-service-available?
+ "/run/current-system/profile/bin/podman"
+ "network"
+ '("my-network")
+ #:verbose? #t))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1 (equal? '("my-network" "podman") (run-test)))))
+
+ (test-assert "image loaded"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((oci-object-service-available?
+ "/run/current-system/profile/bin/podman"
+ "image"
+ '("localhost/guile:latest")
+ #:format-string "{{.Repository}}:{{.Tag}}"
+ #:verbose? #t))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1
+ (equal?
+ '("localhost/guile:latest")
+ (run-test)))))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c"
+ "'(display (getenv \"VARIABLE\"))'"))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1 (equal? '("value") (run-test)))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'"))))
+ marionette)))
+
+ (test-equal "read and write to provisioned volumes"
+ '("world")
+ (second
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\"
+ (lambda (p) (display \"world\" p))))'")
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(display
+ (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))))
+ marionette)))
+
+ (test-equal
+ "can read and write to ports over provisioned network"
+ '("out of office")
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-rootless-podman-run
+ #~((slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin
+(use-modules (web client))
+(define-values (response out) (http-get \"http://first:8080\"))
+(display out))'"))))
+ marionette)))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define (%oci-docker-run commands)
+ #~((use-modules (srfi srfi-1)
+ (ice-9 format)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 rdelim)
+ (gnu build oci-containers))
+
+ #$%oci-read-lines
+ #$%oci-slurp
+
+ (let ((outputs (list #$@commands)))
+ (map
+ (lambda (output)
+ (sort output string<=?))
+ outputs))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcpcd-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list %oci-network))
+ (volumes
+ (list %oci-volume))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))
+(display c)
+(newline)
+(sleep 1)
+(when (positive? c)
+ (l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #:imported-modules '((gnu build oci-containers)
+ (gnu build dbus-service)
+ (gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (volatile? #f)
+ (memory-size 1024)
+ (disk-image-size (* 5000 (expt 2 20)))
+ (port-forwardings '())))
+
+ (define test
+ (with-imported-modules '((gnu build oci-containers)
+ (gnu build dbus-service)
+ (gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+ (gnu build dbus-service)
+ (gnu build marionette))
+
+ (define marionette
+ ;; Relax timeout to accommodate older systems and
+ ;; allow for pulling the image.
+ (make-marionette (list #$vm) #:timeout 60))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-docker-run
+ #~((oci-object-service-available?
+ "/run/current-system/profile/bin/docker"
+ "volume"
+ '("my-volume")
+ #:verbose? #t))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1 (equal? '("my-volume") (run-test)))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-docker-run
+ #~((oci-object-service-available?
+ "/run/current-system/profile/bin/docker"
+ "network"
+ '("my-network")
+ #:verbose? #t))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1 (equal?
+ '("my-network" "none")
+ (run-test)))))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-docker-run
+ #~((slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c"
+ "'(display (getenv \"VARIABLE\"))'"))))
+ marionette)))
+ ;; Allow services to come up on slower machines.
+ (with-retries 80 1 (equal? '("value") (run-test)))))
+
+ (test-equal "read and write to provisioned volumes"
+ '("world")
+ (second
+ (marionette-eval
+ `(begin
+ #$@(%oci-docker-run
+ #~((slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\"
+ (lambda (p) (display \"world\" p))))'")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(display
+ (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))))
+ marionette)))
+
+ (test-equal
+ "can read and write to ports over provisioned network"
+ '("out of office")
+ (first
+ (marionette-eval
+ `(begin
+ #$@(%oci-docker-run
+ #~((slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+ (define-values (response out)
+ (http-get \"http://first:8080\"))
+ (display out))'"))))
+ marionette)))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 8952daab2f..9fee3905f0 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ docker-image} inside Docker.")
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index ec31cf2bdf..be3de699a4 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -4,7 +4,7 @@
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim@guixotic.coop>
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/tests/lightdm.scm b/gnu/tests/lightdm.scm
index fd5c77677e..353954c509 100644
--- a/gnu/tests/lightdm.scm
+++ b/gnu/tests/lightdm.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
+;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim@guixotic.coop>.
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index 0601ff6f69..83ccca8891 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -2,7 +2,7 @@
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017-2018, 2021-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;; Copyright © 2025 Evgeny Pisemsky <mail@pisemsky.site>
;;;
;;; This file is part of GNU Guix.
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index b640d8c67a..a8e752ad41 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index ef5474bef0..f921835c9a 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
+;;; Copyright © 2021, 2022, 2023 Maxim Cournoyer <maxim@guixotic.coop>.
;;;
;;; This file is part of GNU Guix.
;;;
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
index c55a944845..070ceecc2c 100644
--- a/gnu/tests/virtualization.scm
+++ b/gnu/tests/virtualization.scm
@@ -4,7 +4,7 @@
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
-;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,6 +27,7 @@
#:use-module (gnu system)
#:use-module (gnu system accounts)
#:use-module (gnu system file-systems)
+ #:use-module (gnu system hurd)
#:use-module (gnu system image)
#:use-module (gnu system images hurd)
#:use-module ((gnu system shadow) #:select (%base-user-accounts))
@@ -45,6 +46,7 @@
#:export (%test-libvirt
%test-qemu-guest-agent
%test-childhurd
+ %test-childhurd64
%test-build-vm))
@@ -277,6 +279,22 @@
(password "")) ;empty password
%base-user-accounts))))))))
+(define %childhurd64-os
+ (simple-operating-system
+ (service dhcpcd-service-type)
+ (service hurd-vm-service-type
+ (hurd-vm-configuration
+ (type 'hurd64-qcow2)
+ (os (operating-system
+ (inherit %hurd-vm-operating-system)
+ (kernel %hurd64-default-operating-system-kernel)
+ (kernel-arguments '("noide")) ;use rumpdisk
+ (users (cons (user-account
+ (name "test")
+ (group "users")
+ (password "")) ;empty password
+ %base-user-accounts))))))))
+
(define* (run-command-over-ssh command
#:key (port 10022) (user "test"))
"Return a program that runs COMMAND over SSH and prints the result on standard
@@ -307,7 +325,7 @@ output."
(program-file "run-command-over-ssh" run))
-(define (run-childhurd-test)
+(define (run-childhurd-test childhurd-os)
(define (import-module? module)
;; This module is optional and depends on Guile-Gcrypt, do skip it.
(and (guix-module-name? module)
@@ -315,7 +333,7 @@ output."
(define os
(marionette-operating-system
- %childhurd-os
+ childhurd-os
#:imported-modules (source-module-closure
'((gnu services herd)
(guix combinators)
@@ -454,7 +472,15 @@ output."
(description
"Connect to the GNU/Hurd virtual machine service, aka. a childhurd, making
sure that the childhurd boots and runs its SSH server.")
- (value (run-childhurd-test))))
+ (value (run-childhurd-test %childhurd-os))))
+
+(define %test-childhurd64
+ (system-test
+ (name "childhurd64")
+ (description
+ "Connect to the 64-bit GNU/Hurd virtual machine service, aka. a childhurd,
+ making sure that the childhurd boots and runs its SSH server.")
+ (value (run-childhurd-test %childhurd64-os))))
;;;
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
index ab1c2749f3..335ef9bdc7 100644
--- a/gnu/tests/vnc.scm
+++ b/gnu/tests/vnc.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>.
+;;; Copyright © 2022 Maxim Cournoyer <maxim@guixotic.coop>.
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;;
;;; This file is part of GNU Guix.
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 08151951fa..431996ede4 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -4,7 +4,7 @@
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2024 Maxim Cournoyer <maxim@guixotic.coop>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -54,7 +54,6 @@
%test-varnish
%test-php-fpm
%test-hpcguix-web
- %test-tailon
%test-anonip
%test-patchwork
%test-agate))
@@ -480,76 +479,6 @@ HTTP-PORT, along with php-fpm."
(value (run-hpcguix-web-server-test name %hpcguix-web-os))))
-(define %tailon-os
- ;; Operating system under test.
- (simple-operating-system
- (service dhcpcd-service-type)
- (service tailon-service-type
- (tailon-configuration
- (config-file
- (tailon-configuration-file
- (bind "0.0.0.0:8080")))))))
-
-(define* (run-tailon-test #:optional (http-port 8081))
- "Run tests in %TAILON-OS, which has tailon running and listening on
-HTTP-PORT."
- (define os
- (marionette-operating-system
- %tailon-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define vm
- (virtual-machine
- (operating-system os)
- (port-forwardings `((,http-port . 8080)))))
-
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (srfi srfi-11) (srfi srfi-64)
- (ice-9 match)
- (gnu build marionette)
- (web uri)
- (web client)
- (web response))
-
- (define marionette
- ;; Forward the guest's HTTP-PORT, where tailon is listening, to
- ;; port 8080 in the host.
- (make-marionette (list #$vm)))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "tailon")
-
- (test-assert "service running"
- (wait-for-tcp-port 8080 marionette))
-
- (test-equal "http-get"
- 200
- (#$retry-on-error
- (lambda ()
- (let-values (((response text)
- (http-get #$(format
- #f
- "http://localhost:~A/"
- http-port)
- #:decode-body? #t)))
- (response-code response)))
- #:times 10
- #:delay 5))
-
- (test-end))))
-
- (gexp->derivation "tailon-test" test))
-
-(define %test-tailon
- (system-test
- (name "tailon")
- (description "Connect to a running Tailon server.")
- (value (run-tailon-test))))
-
-
;;;
;;; Anonip
;;;
generated by cgit v1.2.3 (git 2.50.1) at 2025-09-21 07:03:12 +0000