diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/base.scm | 13 | ||||
| -rw-r--r-- | gnu/tests/docker.scm | 177 | ||||
| -rw-r--r-- | gnu/tests/emacs.scm | 101 | ||||
| -rw-r--r-- | gnu/tests/install.scm | 18 | ||||
| -rw-r--r-- | gnu/tests/ldap.scm | 2 | ||||
| -rw-r--r-- | gnu/tests/monitoring.scm | 4 | ||||
| -rw-r--r-- | gnu/tests/virtualization.scm | 3 | ||||
| -rw-r--r-- | gnu/tests/web.scm | 105 |
8 files changed, 410 insertions, 13 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index acba1ebd25..715b9036f9 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Marius Bakke <marius@gnu.org> @@ -200,14 +200,17 @@ info --version") (test-assert "shepherd services" (let ((services (marionette-eval '(begin - (use-modules (gnu services herd)) + (use-modules (gnu services herd) + (srfi srfi-1)) - (map (compose car live-service-provision) - (current-services))) + (append-map live-service-provision + (current-services))) marionette))) (lset= eq? (pk 'services services) - '(root #$@(operating-system-shepherd-service-names os))))) + '(root + shepherd + #$@(operating-system-shepherd-service-names os))))) (test-equal "libc honors /etc/localtime" -7200 ;CEST = GMT+2 diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 9e9d2e2d07..46c886580c 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -1,6 +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> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +30,7 @@ #:use-module (gnu services networking) #:use-module (gnu services docker) #:use-module (gnu services desktop) + #:use-module (gnu packages) #:use-module ((gnu packages base) #:select (glibc)) #:use-module (gnu packages guile) #:use-module (gnu packages docker) @@ -43,7 +45,8 @@ #:use-module (guix build-system trivial) #:use-module ((guix licenses) #:prefix license:) #:export (%test-docker - %test-docker-system)) + %test-docker-system + %test-oci-container)) (define %docker-os (simple-operating-system @@ -51,6 +54,7 @@ (service dbus-root-service-type) (service polkit-service-type) (service elogind-service-type) + (service containerd-service-type) (service docker-service-type))) (define (run-docker-test docker-tarball) @@ -85,7 +89,21 @@ inside %DOCKER-OS." (test-runner-current (system-test-runner #$output)) (test-begin "docker") - (test-assert "service running" + (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) (number? pid)))))) + marionette)) + + (test-assert "containerd PID file present" + (wait-for-file "/run/containerd/containerd.pid" marionette)) + + (test-assert "dockerd service running" (marionette-eval '(begin (use-modules (gnu services herd)) @@ -231,6 +249,20 @@ inside %DOCKER-OS." (test-runner-current (system-test-runner #$output)) (test-begin "docker") + (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) (number? pid)))))) + marionette)) + + (test-assert "containerd PID file present" + (wait-for-file "/run/containerd/containerd.pid" marionette)) + (test-assert "service running" (marionette-eval '(begin @@ -316,3 +348,144 @@ docker-image} inside Docker.") (locale-libcs (list glibc))) #:type docker-image-type))) run-docker-system-test))))) + + +(define %oci-os + (simple-operating-system + (service dhcp-client-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-container-service-type + (list + (oci-container-configuration + (image + (oci-image + (repository "guile") + (value + (specifications->manifest '("guile"))) + (pack-options + '(#:symlinks (("/bin" -> "bin")))))) + (entrypoint + "/bin/guile") + (command + '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))")) + (host-environment + '(("VARIABLE" . "value"))) + (volumes + '(("/shared.txt" . "/shared.txt:ro"))) + (extra-arguments + '("--env" "VARIABLE"))))))) + +(define (run-oci-container-test) + "Run IMAGE as an OCI backed Shepherd service, inside OS." + + (define os + (marionette-operating-system + (operating-system-with-gc-roots + %oci-os + (list)) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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 "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) (number? 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) (number? pid)))))) + marionette)) + + (sleep 10) ; let service start + + (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) (number? pid)))))) + marionette)) + + (test-equal "passing host environment variables and volumes" + '("value" "hello") + (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)) +(display (call-with-input-file \"/shared.txt\" read-line)))"))) + (list response1 response2))) + marionette)) + + (test-end)))) + + (gexp->derivation "oci-container-test" test)) + +(define %test-oci-container + (system-test + (name "oci-container") + (description "Test OCI backed Shepherd service.") + (value (run-oci-container-test)))) diff --git a/gnu/tests/emacs.scm b/gnu/tests/emacs.scm new file mode 100644 index 0000000000..f15eec70db --- /dev/null +++ b/gnu/tests/emacs.scm @@ -0,0 +1,101 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Liliana Marie Prikler <liliana.prikler@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu tests emacs) + #:use-module (gnu tests) + #:use-module (gnu packages emacs) + #:use-module (gnu packages vim) + #:use-module (gnu services) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (guix packages) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:export (%test-emacs-native-comp-replacable)) + +(define (run-native-comp-replacable-test old-emacs new-emacs) + (define vm (virtual-machine (marionette-operating-system %simple-os))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-1) + (srfi srfi-64)) + + (define marionette (make-marionette (list #$vm))) + (define (marionette-emacs-eval emacs code) + (marionette-eval + `(begin + (use-modules (ice-9 rdelim) (ice-9 popen)) + (read-line + (open-pipe* + OPEN_READ + ,emacs "--batch" + ,(string-append "--eval=" code)))) + marionette)) + + (define (emacs-native-comp-dir emacs) + (marionette-emacs-eval emacs "(princ comp-native-version-dir)")) + (define (emacs-abi-hash emacs) + (marionette-emacs-eval emacs "(princ comp-abi-hash)")) + (define (emacs-effective-version emacs) + (marionette-emacs-eval + emacs + "(princ + (format \"%s.%s\" emacs-major-version emacs-minor-version))")) + + (define old-emacs-bin #$(file-append old-emacs "/bin/emacs")) + (define new-emacs-bin #$(file-append new-emacs "/bin/emacs")) + + (test-runner-current (system-test-runner #$output)) + (test-begin "emacs-native-comp-replacable") + (test-equal "comp-abi-hash" + (emacs-abi-hash old-emacs-bin) + (emacs-abi-hash new-emacs-bin)) + (test-equal "native-comp-dir" + (emacs-native-comp-dir old-emacs-bin) + (emacs-native-comp-dir new-emacs-bin)) + (test-assert "old emacs has hierarchical layout" + (file-exists? + (string-append #$old-emacs "/lib/emacs/" + (emacs-effective-version old-emacs-bin) + "/native-lisp/" + (emacs-native-comp-dir old-emacs-bin) + "/preloaded/emacs-lisp/comp.eln"))) + (test-assert "new emacs has hierarchical layout" + (file-exists? + (string-append #$new-emacs "/lib/emacs/" + (emacs-effective-version new-emacs-bin) + "/native-lisp/" + (emacs-native-comp-dir new-emacs-bin) + "/preloaded/emacs-lisp/comp.eln"))) + (test-end)))) + + (gexp->derivation "emacs-native-comp-compatible" test)) + +(define (package-without-replacement pkg) + (package (inherit pkg) (replacement #f))) + +(define %test-emacs-native-comp-replacable + (system-test + (name "emacs-native-comp") + (description "Test whether an emacs replacement (if any) is valid.") + (value (run-native-comp-replacable-test + (package-without-replacement emacs) + emacs)))) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 16da320000..36dbd9111f 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -210,9 +210,11 @@ reboot\n") "Return the appropriate QEMU OVMF UEFI firmware for the given SYSTEM." (cond ((string-prefix? "x86_64" system) - (file-append ovmf "/share/firmware/ovmf_x64.bin")) + (file-append ovmf-x86-64 "/share/firmware/ovmf_x64.bin")) ((string-prefix? "i686" system) - (file-append ovmf "/share/firmware/ovmf_ia32.bin")) + (file-append ovmf-i686 "/share/firmware/ovmf_ia32.bin")) + ((string-prefix? "aarch64" system) + (file-append ovmf-aarch64 "/share/firmware/ovmf_aarch64.bin")) (else #f))) (define* (run-install target-os target-os-source @@ -287,6 +289,12 @@ such as for RAID systems." (define marionette (make-marionette `(,(which #$(qemu-command system)) + ;; Neither of these architectures have a default machine. + ,@(if (or (string=? "aarch64-linux" #$system) + (string=? "armhf-linux" #$system)) + '("-machine" "virt" + "-cpu" "host") + '()) "-no-reboot" "-m" "1200" ,@(if #$uefi-firmware @@ -361,6 +369,12 @@ MiB of RAM." (use-modules (srfi srfi-1)) `(,(string-append #$qemu-minimal "/bin/" #$(qemu-command system)) + ;; Neither of these architectures have a default machine. + ,@(if (or (string=? "aarch64-linux" #$system) + (string=? "armhf-linux" #$system)) + '("-machine" "virt" + "-cpu" "host") + '()) "-snapshot" ;for the volatile, writable overlay ,@(if (file-exists? "/dev/kvm") '("-enable-kvm") diff --git a/gnu/tests/ldap.scm b/gnu/tests/ldap.scm index 47e77c0c53..d5ab6899cf 100644 --- a/gnu/tests/ldap.scm +++ b/gnu/tests/ldap.scm @@ -144,7 +144,7 @@ suffix = dc=example,dc=com"))) (test-assert "Can become LDAP user" (marionette-eval - '(zero? (system* "/run/setuid-programs/su" "eva" "-c" + '(zero? (system* "/run/privileged/bin/su" "eva" "-c" #$(file-append coreutils "/bin/true"))) marionette)) diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index bbab1d8acf..a0c8c929b1 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -189,11 +189,11 @@ cat ~a | sudo -u zabbix psql zabbix; (start-service 'postgres)) marionette)) - ;; Add /run/setuid-programs to $PATH so that the scripts passed to + ;; Add privileged programs to $PATH so that the scripts passed to ;; 'system' can find 'sudo'. (marionette-eval '(setenv "PATH" - "/run/setuid-programs:/run/current-system/profile/bin") + "/run/privileged/bin:/run/current-system/profile/bin") marionette) (test-eq "postgres create zabbix user" diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index c8b42eb1db..ed8d6b1c85 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -94,6 +94,9 @@ ((pid) (number? pid)))))) marionette)) + ;; Give the libvirtd service time to start up. + (sleep 1) + (test-eq "fetch version" 0 (marionette-eval diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 16dc6bea49..a071e05e1d 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -34,8 +34,10 @@ #:use-module (gnu services shepherd) #:use-module (gnu services mail) #:use-module (gnu packages databases) + #:use-module (gnu packages guile-xyz) #:use-module (gnu packages patchutils) #:use-module (gnu packages python) + #:use-module (gnu packages tls) #:use-module (gnu packages web) #:use-module (guix packages) #:use-module (guix modules) @@ -50,7 +52,8 @@ %test-php-fpm %test-hpcguix-web %test-tailon - %test-patchwork)) + %test-patchwork + %test-agate)) (define %index.html-contents ;; Contents of the /index.html file. @@ -657,3 +660,103 @@ HTTP-PORT." (name "patchwork") (description "Connect to a running Patchwork service.") (value (run-patchwork-test patchwork)))) + + +;;; +;;; Agate +;;; + +(define %index.gmi-contents + ;; Contents of the /index.gmi file. + "Hello, guix!") + +(define %make-agate-root + ;; Create our server root in /srv. + #~(begin + (mkdir "/srv") + (mkdir "/srv/gemini") + (mkdir "/srv/gemini-certs") + ;; Directory should be writable for Agate user to generate certificates + (let ((user (getpw "agate"))) + (chown "/srv/gemini-certs" (passwd:uid user) (passwd:gid user))) + (call-with-output-file (string-append "/srv/gemini/index.gmi") + (lambda (port) + (display #$%index.gmi-contents port))))) + +(define %agate-os + (simple-operating-system + (service dhcp-client-service-type) + (simple-service 'make-agate-root activation-service-type + %make-agate-root) + (service agate-service-type + (agate-configuration + (hostnames '("localhost")))))) + +(define* (run-agate-test name test-os expected-content) + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd) + (guix combinators)) + #:extensions (list guile-gemini guile-gnutls))) + + (define forwarded-port 1965) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((1965 . ,forwarded-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-64) + (gnu build marionette)) + + (define marionette + (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin #$name) + + (test-assert #$(string-append name " service running") + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service '#$(string->symbol name)) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((#t) #t) + ((pid) (number? pid)))))) + marionette)) + + (test-assert "Agate TCP port ready, IPv4" + (wait-for-tcp-port #$forwarded-port marionette)) + + (test-assert "Agate TCP port ready, IPv6" + (wait-for-tcp-port #$forwarded-port marionette + #:address + '(make-socket-address + AF_INET6 (inet-pton AF_INET6 "::1") #$forwarded-port))) + + (test-equal "Agate responses with the specified index.gmi" + #$expected-content + (marionette-eval '(begin + (use-modules (ice-9 iconv) + (gemini client) + (gemini request) + (gemini response)) + (bytevector->string (gemini-response-body-bytes + (send-gemini-request + (build-gemini-request #:host "localhost" #:port #$forwarded-port))) + "utf8")) marionette)) + + (test-end)))) + (gexp->derivation "agate-test" test)) + +(define %test-agate + (system-test + (name "agate") + (description "Connect to a running Agate service.") + (value (run-agate-test name %agate-os %index.gmi-contents)))) |