diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/base.scm | 4 | ||||
| -rw-r--r-- | gnu/tests/ci.scm | 128 | ||||
| -rw-r--r-- | gnu/tests/docker.scm | 3 | ||||
| -rw-r--r-- | gnu/tests/guix.scm | 5 | ||||
| -rw-r--r-- | gnu/tests/monitoring.scm | 7 | ||||
| -rw-r--r-- | gnu/tests/networking.scm | 92 | ||||
| -rw-r--r-- | gnu/tests/nfs.scm | 2 | ||||
| -rw-r--r-- | gnu/tests/web.scm | 7 |
8 files changed, 225 insertions, 23 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index e5f9b87b1d..9429a10b75 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -555,10 +555,6 @@ functionality tests.") (start-service 'term-tty1)) marionette) (marionette-type "root\n" marionette) - (wait-for-screen-text marionette - (lambda (text) - (string-contains text "root@komputilo")) - #:ocrad ocrad) ;; Start tmux and wait for it to be ready. (marionette-type "tmux new-session 'echo 1 > /ready; bash'\n" diff --git a/gnu/tests/ci.scm b/gnu/tests/ci.scm new file mode 100644 index 0000000000..a8b39fcd01 --- /dev/null +++ b/gnu/tests/ci.scm @@ -0,0 +1,128 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019, 2020, 2021 Christopher Baines <mail@cbaines.net> +;;; 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> +;;; +;;; 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 ci) + #:use-module (gnu tests) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services ci) + #:use-module (gnu services web) + #:use-module (gnu services networking) + #:use-module (guix gexp) + #:use-module (guix store) + #:export (%test-laminar)) + + +(define %laminar-os + ;; Operating system under test. + (simple-operating-system + (service dhcp-client-service-type) + (service laminar-service-type))) + +(define* (run-laminar-test #:optional (http-port 8080)) + "Run tests in %LAMINAR-OS, which has laminar running and listening on +HTTP-PORT." + (define os + (marionette-operating-system + %laminar-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 laminar is listening, to + ;; port 8080 in the host. + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "laminar") + + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'laminar)) + marionette)) + + (define* (retry-on-error f #:key times delay) + (let loop ((attempt 1)) + (match (catch + #t + (lambda () + (cons #t + (f))) + (lambda args + (cons #f + args))) + ((#t . return-value) + return-value) + ((#f . error-args) + (if (>= attempt times) + error-args + (begin + (sleep delay) + (loop (+ 1 attempt)))))))) + + (test-equal "http-get" + 200 + (retry-on-error + (lambda () + (let-values (((response text) + (http-get #$(format + #f + "http://localhost:~A/" + http-port) + ;; TODO: Why does decoding fail? + #:decode-body? #f))) + (response-code response))) + #:times 10 + #:delay 5)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "laminar-test" test)) + +(define %test-laminar + (system-test + (name "laminar") + (description "Connect to a running Laminar server.") + (value (run-laminar-test)))) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index cbb856b016..92611b0a8d 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -303,5 +303,6 @@ docker-image} inside Docker.") (inherit (simple-operating-system)) ;; Use locales for a single libc to ;; reduce space requirements. - (locale-libcs (list glibc)))) + (locale-libcs (list glibc))) + #:memory-size 1024) run-docker-system-test))))) diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index 219b8b482f..af7d8f0b21 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -164,10 +164,7 @@ " local all all trust host all all 127.0.0.1/32 trust -host all all ::1/128 trust")) - ;; XXX: Remove when postgresql default socket directory is - ;; changed to /var/run/postgresql. - (socket-directory #f))))) +host all all ::1/128 trust")))))) (service guix-data-service-type (guix-data-service-configuration (host "0.0.0.0"))) diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index be69e1c259..8630f5818c 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -309,12 +309,7 @@ zabbix||{} (service dhcp-client-service-type) (service postgresql-service-type (postgresql-configuration - (postgresql postgresql) - ;; XXX: Remove when postgresql default socket directory is - ;; changed to /var/run/postgresql. - (config-file - (postgresql-config-file - (socket-directory #f))))) + (postgresql postgresql))) (service zabbix-front-end-service-type (zabbix-front-end-configuration (db-password "zabbix"))) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 022663aa67..453e63f52d 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017, 2020 Marius Bakke <marius@gnu.org> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,12 +30,15 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) + #:use-module (guix modules) #:use-module (gnu packages bash) #:use-module (gnu packages linux) #:use-module (gnu packages networking) + #:use-module (gnu packages guile) #:use-module (gnu services shepherd) #:use-module (ice-9 match) - #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables)) + #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables + %test-ipfs)) (define %inetd-os ;; Operating system with 2 inetd services. @@ -563,3 +567,89 @@ COMMIT (name "iptables") (description "Test a running iptables daemon.") (value (run-iptables-test)))) + + +;;; +;;; IPFS service +;;; + +(define %ipfs-os + (simple-operating-system + (service ipfs-service-type))) + +(define (run-ipfs-test) + (define os + (marionette-operating-system %ipfs-os + #:imported-modules (source-module-closure + '((gnu services herd) + (guix ipfs))) + #:extensions (list guile-json-4) + #:requirements '(ipfs))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (rnrs bytevectors) + (srfi srfi-64) + (ice-9 binary-ports)) + + (define marionette + (make-marionette (list #$(virtual-machine os)))) + + (define (ipfs-is-alive?) + (marionette-eval + '(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + (live-service-running + (find (lambda (live) + (memq 'ipfs + (live-service-provision live))) + (current-services)))) + marionette)) + + ;; The default API endpoint port 5001 is used, + ;; so there is no need to parameterize %ipfs-base-url. + (define (add-data data) + (marionette-eval `(content-name (add-data ,data)) marionette)) + (define (read-contents object) + (marionette-eval + `(let* ((input (read-contents ,object)) + (all-input (get-bytevector-all input))) + (close-port input) + all-input) + marionette)) + + (marionette-eval '(use-modules (guix ipfs)) marionette) + (mkdir #$output) + (chdir #$output) + + (test-begin "ipfs") + + ;; Test the IPFS service. + + (test-assert "ipfs is alive" (ipfs-is-alive?)) + + (test-assert "ipfs is listening on the gateway" + (let ((default-port 8082)) + (wait-for-tcp-port default-port marionette))) + + (test-assert "ipfs is listening on the API endpoint" + (let ((default-port 5001)) + (wait-for-tcp-port default-port marionette))) + + (define test-bv (string->utf8 "hello ipfs!")) + (test-equal "can upload and download a file to/from ipfs" + test-bv + (read-contents (add-data test-bv))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (gexp->derivation "ipfs-test" test)) + +(define %test-ipfs + (system-test + (name "ipfs") + (description "Test a running IPFS daemon configuration.") + (value (run-ipfs-test)))) diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index 5d04af38fb..9b2b785176 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -410,5 +410,5 @@ directories can be mounted.") (system-test (name "nfs-root-fs") (description "Test that an NFS server can be started and the exported -directory can be used as root filesystem.") +directory can be used as root file system.") (value (run-nfs-root-fs-test)))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index cc0e79c8b2..7f4518acd2 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -569,12 +569,7 @@ HTTP-PORT." (listen '("8080")))))) (service postgresql-service-type (postgresql-configuration - (postgresql postgresql-10) - ;; XXX: Remove when postgresql default socket directory is - ;; changed to /var/run/postgresql. - (config-file - (postgresql-config-file - (socket-directory #f))))) + (postgresql postgresql-10))) (service patchwork-service-type (patchwork-configuration (patchwork patchwork) |