summaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/admin.scm128
-rw-r--r--gnu/tests/audio.scm78
-rw-r--r--gnu/tests/base.scm310
-rw-r--r--gnu/tests/databases.scm123
-rw-r--r--gnu/tests/dict.scm165
-rw-r--r--gnu/tests/install.scm16
-rw-r--r--gnu/tests/mail.scm388
-rw-r--r--gnu/tests/messaging.scm198
-rw-r--r--gnu/tests/networking.scm95
-rw-r--r--gnu/tests/nfs.scm142
-rw-r--r--gnu/tests/ssh.scm268
-rw-r--r--gnu/tests/virtualization.scm95
-rw-r--r--gnu/tests/web.scm125
13 files changed, 1279 insertions, 852 deletions
diff --git a/gnu/tests/admin.scm b/gnu/tests/admin.scm
new file mode 100644
index 0000000000..3c7deb5426
--- /dev/null
+++ b/gnu/tests/admin.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 admin)
+ #: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 admin)
+ #:use-module (gnu services networking)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:export (%test-tailon))
+
+(define %tailon-os
+ ;; Operating system under test.
+ (simple-operating-system
+ (dhcp-client-service)
+ (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)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "tailon")
+
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'tailon)
+ 'running!)
+ 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)
+ #:decode-body? #t)))
+ (response-code response)))
+ #:times 10
+ #:delay 5))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "tailon-test" test))
+
+(define %test-tailon
+ (system-test
+ (name "tailon")
+ (description "Connect to a running Tailon server.")
+ (value (run-tailon-test))))
diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm
new file mode 100644
index 0000000000..8eadaf02e1
--- /dev/null
+++ b/gnu/tests/audio.scm
@@ -0,0 +1,78 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@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 audio)
+ #:use-module (gnu tests)
+ #:use-module (gnu system)
+ #:use-module (gnu system vm)
+ #:use-module (gnu services)
+ #:use-module (gnu services audio)
+ #:use-module (gnu packages mpd)
+ #:use-module (guix gexp)
+ #:export (%test-mpd))
+
+(define %mpd-os
+ (simple-operating-system
+ (service mpd-service-type
+ (mpd-configuration
+ (user "root")))))
+
+(define (run-mpd-test)
+ "Run tests in %mpd-os, which has mpd running."
+ (define os
+ (marionette-operating-system
+ %mpd-os
+ #:imported-modules '((gnu services herd))))
+
+ (define vm
+ (virtual-machine os))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-64)
+ (gnu build marionette))
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "mpd")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mpd))
+ marionette))
+
+ (test-assert "mpc connect"
+ (marionette-eval
+ '(zero? (system #$(file-append mpd-mpc "/bin/mpc")))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+ (gexp->derivation "mpd-test" test))
+
+(define %test-mpd
+ (system-test
+ (name "mpd")
+ (description "Test that the mpd can run and be connected to.")
+ (value (run-mpd-test))))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 8389b67f68..6132aa96ef 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -34,7 +34,6 @@
#:use-module (gnu packages package-management)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:export (run-basic-test
@@ -393,17 +392,16 @@ info --version")
"Instrument %SIMPLE-OS, run it in a VM, and run a series of basic
functionality tests.")
(value
- (mlet* %store-monad ((os -> (marionette-operating-system
- %simple-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (run (system-qemu-image/shared-store-script
- os #:graphic? #f)))
+ (let* ((os (marionette-operating-system
+ %simple-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (vm (virtual-machine os)))
;; XXX: Add call to 'virtualized-operating-system' to get the exact same
;; set of services as the OS produced by
;; 'system-qemu-image/shared-store-script'.
(run-basic-test (virtualized-operating-system os '())
- #~(list #$run))))))
+ #~(list #$vm))))))
;;;
@@ -430,60 +428,60 @@ functionality tests.")
(mcron-service (list job1 job2 job3)))))
(define (run-mcron-test name)
- (mlet* %store-monad ((os -> (marionette-operating-system
- %mcron-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$command)))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "mcron")
-
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'mcron)
- 'running!)
- marionette))
-
- ;; Make sure root's mcron job runs, has its cwd set to "/root", and
- ;; runs with the right UID/GID.
- (test-equal "root's job"
- '(0 0)
- (wait-for-file "/root/witness" marionette))
-
- ;; Likewise for Alice's job. We cannot know what its GID is since
- ;; it's chosen by 'groupadd', but it's strictly positive.
- (test-assert "alice's job"
- (match (wait-for-file "/home/alice/witness" marionette)
- ((1000 gid)
- (>= gid 100))))
-
- ;; Last, the job that uses a command; allows us to test whether
- ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
- ;; that don't have a read syntax, hence the string.)
- (test-equal "root's job with command"
- "#<eof>"
- (wait-for-file "/root/witness-touch" marionette))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation name test)))
+ (define os
+ (marionette-operating-system
+ %mcron-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "mcron")
+
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mcron)
+ 'running!)
+ marionette))
+
+ ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+ ;; runs with the right UID/GID.
+ (test-equal "root's job"
+ '(0 0)
+ (wait-for-file "/root/witness" marionette))
+
+ ;; Likewise for Alice's job. We cannot know what its GID is since
+ ;; it's chosen by 'groupadd', but it's strictly positive.
+ (test-assert "alice's job"
+ (match (wait-for-file "/home/alice/witness" marionette)
+ ((1000 gid)
+ (>= gid 100))))
+
+ ;; Last, the job that uses a command; allows us to test whether
+ ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
+ ;; that don't have a read syntax, hence the string.)
+ (test-equal "root's job with command"
+ "#<eof>"
+ (wait-for-file "/root/witness-touch" marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %test-mcron
(system-test
@@ -526,102 +524,102 @@ functionality tests.")
;; *after* nscd. Failing to do that, libc will try to connect to nscd,
;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
;; leading to '.local' resolution failures.
- (mlet* %store-monad ((os -> (marionette-operating-system
- %avahi-os
- #:requirements '(nscd)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (run (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define mdns-host-name
- (string-append (operating-system-host-name os)
- ".local"))
-
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-1)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$run)))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "avahi")
-
- (test-assert "wait for services"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
+ (define os
+ (marionette-operating-system
+ %avahi-os
+ #:requirements '(nscd)
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
- (start-service 'nscd)
-
- ;; XXX: Work around a race condition in nscd: nscd creates its
- ;; PID file before it is listening on its socket.
- (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
- (let try ()
- (catch 'system-error
- (lambda ()
- (connect sock AF_UNIX "/var/run/nscd/socket")
- (close-port sock)
- (format #t "nscd is ready~%"))
- (lambda args
- (format #t "waiting for nscd...~%")
- (usleep 500000)
- (try)))))
-
- ;; Wait for the other useful things.
- (start-service 'avahi-daemon)
- (start-service 'networking)
-
- #t)
- marionette))
-
- (test-equal "avahi-resolve-host-name"
- 0
- (marionette-eval
- '(system*
- "/run/current-system/profile/bin/avahi-resolve-host-name"
- "-v" #$mdns-host-name)
- marionette))
+ (define mdns-host-name
+ (string-append (operating-system-host-name os)
+ ".local"))
- (test-equal "avahi-browse"
- 0
- (marionette-eval
- '(system* "avahi-browse" "-avt")
- marionette))
-
- (test-assert "getaddrinfo .local"
- ;; Wait for the 'avahi-daemon' service and perform a resolution.
- (match (marionette-eval
- '(getaddrinfo #$mdns-host-name)
- marionette)
- (((? vector? addrinfos) ..1)
- (pk 'getaddrinfo addrinfos)
- (and (any (lambda (ai)
- (= AF_INET (addrinfo:fam ai)))
- addrinfos)
- (any (lambda (ai)
- (= AF_INET6 (addrinfo:fam ai)))
- addrinfos)))))
-
- (test-assert "gethostbyname .local"
- (match (pk 'gethostbyname
- (marionette-eval '(gethostbyname #$mdns-host-name)
- marionette))
- ((? vector? result)
- (and (string=? (hostent:name result) #$mdns-host-name)
- (= (hostent:addrtype result) AF_INET)))))
-
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation "nss-mdns" test)))
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-1)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "avahi")
+
+ (test-assert "wait for services"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ (start-service 'nscd)
+
+ ;; XXX: Work around a race condition in nscd: nscd creates its
+ ;; PID file before it is listening on its socket.
+ (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (connect sock AF_UNIX "/var/run/nscd/socket")
+ (close-port sock)
+ (format #t "nscd is ready~%"))
+ (lambda args
+ (format #t "waiting for nscd...~%")
+ (usleep 500000)
+ (try)))))
+
+ ;; Wait for the other useful things.
+ (start-service 'avahi-daemon)
+ (start-service 'networking)
+
+ #t)
+ marionette))
+
+ (test-equal "avahi-resolve-host-name"
+ 0
+ (marionette-eval
+ '(system*
+ "/run/current-system/profile/bin/avahi-resolve-host-name"
+ "-v" #$mdns-host-name)
+ marionette))
+
+ (test-equal "avahi-browse"
+ 0
+ (marionette-eval
+ '(system* "avahi-browse" "-avt")
+ marionette))
+
+ (test-assert "getaddrinfo .local"
+ ;; Wait for the 'avahi-daemon' service and perform a resolution.
+ (match (marionette-eval
+ '(getaddrinfo #$mdns-host-name)
+ marionette)
+ (((? vector? addrinfos) ..1)
+ (pk 'getaddrinfo addrinfos)
+ (and (any (lambda (ai)
+ (= AF_INET (addrinfo:fam ai)))
+ addrinfos)
+ (any (lambda (ai)
+ (= AF_INET6 (addrinfo:fam ai)))
+ addrinfos)))))
+
+ (test-assert "gethostbyname .local"
+ (match (pk 'gethostbyname
+ (marionette-eval '(gethostbyname #$mdns-host-name)
+ marionette))
+ ((? vector? result)
+ (and (string=? (hostent:name result) #$mdns-host-name)
+ (= (hostent:addrtype result) AF_INET)))))
+
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "nss-mdns" test))
(define %test-nss-mdns
(system-test
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
new file mode 100644
index 0000000000..9d9a753747
--- /dev/null
+++ b/gnu/tests/databases.scm
@@ -0,0 +1,123 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 databases)
+ #: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 databases)
+ #:use-module (gnu services networking)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #:export (%test-memcached))
+
+(define %memcached-os
+ (simple-operating-system
+ (dhcp-client-service)
+ (service memcached-service-type)))
+
+(define* (run-memcached-test #:optional (port 11211))
+ "Run tests in %MEMCACHED-OS, forwarding PORT."
+ (define os
+ (marionette-operating-system
+ %memcached-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((11211 . ,port)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (gnu build marionette)
+ (ice-9 rdelim))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "memcached")
+
+ ;; Wait for memcached to be up and running.
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (match (start-service 'memcached)
+ (#f #f)
+ (('service response-parts ...)
+ (match (assq-ref response-parts 'running)
+ ((pid) (number? pid))))))
+ marionette))
+
+ (let* ((ai (car (getaddrinfo "localhost"
+ #$(number->string port))))
+ (s (socket (addrinfo:fam ai)
+ (addrinfo:socktype ai)
+ (addrinfo:protocol ai)))
+ (key "testkey")
+ (value "guix"))
+ (connect s (addrinfo:addr ai))
+
+ (test-equal "set"
+ "STORED\r"
+ (begin
+ (simple-format s "set ~A 0 60 ~A\r\n~A\r\n"
+ key
+ (string-length value)
+ value)
+ (read-line s)))
+
+ (test-equal "get"
+ (simple-format #f "VALUE ~A 0 ~A\r~A\r"
+ key
+ (string-length value)
+ value)
+ (begin
+ (simple-format s "get ~A\r\n" key)
+ (string-append
+ (read-line s)
+ (read-line s))))
+
+ (close-port s))
+
+ ;; There should be a log file in here.
+ (test-assert "log file"
+ (marionette-eval
+ '(file-exists? "/var/log/memcached")
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "memcached-test" test))
+
+(define %test-memcached
+ (system-test
+ (name "memcached")
+ (description "Connect to a running MEMCACHED server.")
+ (value (run-memcached-test))))
diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm
index 16b6edbd9e..b9c741e3e0 100644
--- a/gnu/tests/dict.scm
+++ b/gnu/tests/dict.scm
@@ -27,7 +27,6 @@
#:use-module (gnu packages wordnet)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix modules)
#:export (%test-dicod))
@@ -54,86 +53,90 @@
(define* (run-dicod-test)
"Run tests of 'dicod-service-type'."
- (mlet* %store-monad ((os -> (marionette-operating-system
- %dicod-os
- #:imported-modules
- (source-module-closure '((gnu services herd)))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (ice-9 rdelim)
- (ice-9 regex)
- (srfi srfi-64)
- (gnu build marionette))
- (define marionette
- ;; Forward the guest's DICT port to local port 8000.
- (make-marionette (list #$command "-net"
- "user,hostfwd=tcp::8000-:2628")))
-
- (define %dico-socket
- (socket PF_INET SOCK_STREAM 0))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "dicod")
-
- ;; Wait for the service to be started.
- (test-eq "service is running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'dicod)
- 'running!)
- marionette))
-
- ;; Wait until dicod is actually listening.
- ;; TODO: Use a PID file instead.
- (test-assert "connect inside"
- (marionette-eval
- '(begin
- (use-modules (ice-9 rdelim))
- (let ((sock (socket PF_INET SOCK_STREAM 0)))
- (let loop ((i 0))
- (pk 'try i)
- (catch 'system-error
- (lambda ()
- (connect sock AF_INET INADDR_LOOPBACK 2628))
- (lambda args
- (pk 'connection-error args)
- (when (< i 20)
- (sleep 1)
- (loop (+ 1 i))))))
- (read-line sock 'concat)))
- marionette))
-
- (test-assert "connect"
- (let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
- (connect %dico-socket addr)
- (read-line %dico-socket 'concat)))
-
- (test-equal "CLIENT"
- "250 ok\r\n"
- (begin
- (display "CLIENT \"GNU Guile\"\r\n" %dico-socket)
- (read-line %dico-socket 'concat)))
-
- (test-assert "DEFINE"
- (begin
- (display "DEFINE ! hello\r\n" %dico-socket)
- (display "QUIT\r\n" %dico-socket)
- (let ((result (read-string %dico-socket)))
- (and (string-contains result "gcide")
- (string-contains result "hello")
- result))))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation "dicod" test)))
+ (define os
+ (marionette-operating-system
+ %dicod-os
+ #:imported-modules
+ (source-module-closure '((gnu services herd)))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '((8000 . 2628)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (ice-9 rdelim)
+ (ice-9 regex)
+ (srfi srfi-64)
+ (gnu build marionette))
+ (define marionette
+ ;; Forward the guest's DICT port to local port 8000.
+ (make-marionette (list #$vm)))
+
+ (define %dico-socket
+ (socket PF_INET SOCK_STREAM 0))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "dicod")
+
+ ;; Wait for the service to be started.
+ (test-eq "service is running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'dicod)
+ 'running!)
+ marionette))
+
+ ;; Wait until dicod is actually listening.
+ ;; TODO: Use a PID file instead.
+ (test-assert "connect inside"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 rdelim))
+ (let ((sock (socket PF_INET SOCK_STREAM 0)))
+ (let loop ((i 0))
+ (pk 'try i)
+ (catch 'system-error
+ (lambda ()
+ (connect sock AF_INET INADDR_LOOPBACK 2628))
+ (lambda args
+ (pk 'connection-error args)
+ (when (< i 20)
+ (sleep 1)
+ (loop (+ 1 i))))))
+ (read-line sock 'concat)))
+ marionette))
+
+ (test-assert "connect"
+ (let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
+ (connect %dico-socket addr)
+ (read-line %dico-socket 'concat)))
+
+ (test-equal "CLIENT"
+ "250 ok\r\n"
+ (begin
+ (display "CLIENT \"GNU Guile\"\r\n" %dico-socket)
+ (read-line %dico-socket 'concat)))
+
+ (test-assert "DEFINE"
+ (begin
+ (display "DEFINE ! hello\r\n" %dico-socket)
+ (display "QUIT\r\n" %dico-socket)
+ (let ((result (read-string %dico-socket)))
+ (and (string-contains result "gcide")
+ (string-contains result "hello")
+ result))))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "dicod" test))
(define %test-dicod
(system-test
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 7c5d48104e..866bf885ce 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -27,8 +27,8 @@
#:use-module ((gnu build vm) #:select (qemu-command))
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages ocr)
- #:use-module (gnu packages qemu)
#:use-module (gnu packages package-management)
+ #:use-module (gnu packages virtualization)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
@@ -59,7 +59,7 @@
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/vdb")))
+ (bootloader (grub-configuration (target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device "my-root")
@@ -98,7 +98,7 @@
(bootloader (bootloader-configuration
(bootloader extlinux-bootloader-gpt)
- (device "/dev/vdb")))
+ (target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device "my-root")
@@ -326,7 +326,7 @@ per %test-installed-os, this test is expensive in terms of CPU and storage.")
(timezone "Europe/Paris")
(locale "en_US.utf8")
- (bootloader (grub-configuration (device "/dev/vdb")))
+ (bootloader (grub-configuration (target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device "my-root")
@@ -384,7 +384,7 @@ partition. In particular, home directories must be correctly created (see
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/vdb")))
+ (bootloader (grub-configuration (target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device "root-fs")
@@ -460,7 +460,7 @@ where /gnu lives on a separate partition.")
(timezone "Europe/Paris")
(locale "en_US.utf8")
- (bootloader (grub-configuration (device "/dev/vdb")))
+ (bootloader (grub-configuration (target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(initrd (lambda (file-systems . rest)
;; Add a kernel module for RAID-0 (aka. "stripe").
@@ -543,7 +543,7 @@ by 'mdadm'.")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/vdb")))
+ (bootloader (grub-configuration (target "/dev/vdb")))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -670,7 +670,7 @@ build (current-guix) and then store a couple of full system images.")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/vdb")))
+ (bootloader (grub-configuration (target "/dev/vdb")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device "my-root")
diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 247f4f667f..312df9b1cd 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,7 +26,6 @@
#:use-module (gnu services mail)
#:use-module (gnu services networking)
#:use-module (guix gexp)
- #:use-module (guix monads)
#:use-module (guix store)
#:use-module (ice-9 ftw)
#:export (%test-opensmtpd
@@ -44,105 +44,105 @@ accept from any for local deliver to mbox
(define (run-opensmtpd-test)
"Return a test of an OS running OpenSMTPD service."
- (mlet* %store-monad ((command (system-qemu-image/shared-store-script
- (marionette-operating-system
- %opensmtpd-os
- #:imported-modules '((gnu services herd)))
- #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (rnrs base)
- (srfi srfi-64)
- (ice-9 rdelim)
- (ice-9 regex)
- (gnu build marionette))
-
- (define marionette
- (make-marionette
- ;; Enable TCP forwarding of the guest's port 25.
- '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
-
- (define (read-reply-code port)
- "Read a SMTP reply from PORT and return its reply code."
- (let* ((line (read-line port))
- (mo (string-match "([0-9]+)([ -]).*" line))
- (code (string->number (match:substring mo 1)))
- (finished? (string= " " (match:substring mo 2))))
- (if finished?
- code
- (read-reply-code port))))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "opensmptd")
-
- (test-assert "service is running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'smtpd)
- #t)
- marionette))
-
- (test-assert "mbox is empty"
- (marionette-eval
- '(and (file-exists? "/var/mail")
- (not (file-exists? "/var/mail/root")))
- marionette))
-
- (test-eq "accept an email"
- #t
- (let* ((smtp (socket AF_INET SOCK_STREAM 0))
- (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
- (connect smtp addr)
- ;; Be greeted.
- (read-reply-code smtp) ;220
- ;; Greet the server.
- (write-line "EHLO somehost" smtp)
- (read-reply-code smtp) ;250
- ;; Set sender email.
- (write-line "MAIL FROM: <someone>" smtp)
- (read-reply-code smtp) ;250
- ;; Set recipient email.
- (write-line "RCPT TO: <root>" smtp)
- (read-reply-code smtp) ;250
- ;; Send message.
- (write-line "DATA" smtp)
- (read-reply-code smtp) ;354
- (write-line "Subject: Hello" smtp)
- (newline smtp)
- (write-line "Nice to meet you!" smtp)
- (write-line "." smtp)
- (read-reply-code smtp) ;250
- ;; Say goodbye.
- (write-line "QUIT" smtp)
- (read-reply-code smtp) ;221
- (close smtp)
- #t))
-
- (test-assert "mail arrived"
- (marionette-eval
- '(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define (queue-empty?)
- (eof-object?
- (read-line
- (open-input-pipe "smtpctl show queue"))))
-
- (let wait ()
- (if (queue-empty?)
- (file-exists? "/var/mail/root")
- (begin (sleep 1) (wait)))))
- marionette))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation "opensmtpd-test" test)))
+ (define vm
+ (virtual-machine
+ (operating-system (marionette-operating-system
+ %opensmtpd-os
+ #:imported-modules '((gnu services herd))))
+ (port-forwardings '((1025 . 25)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (rnrs base)
+ (srfi srfi-64)
+ (ice-9 rdelim)
+ (ice-9 regex)
+ (gnu build marionette))
+
+ (define marionette
+ (make-marionette '(#$vm)))
+
+ (define (read-reply-code port)
+ "Read a SMTP reply from PORT and return its reply code."
+ (let* ((line (read-line port))
+ (mo (string-match "([0-9]+)([ -]).*" line))
+ (code (string->number (match:substring mo 1)))
+ (finished? (string= " " (match:substring mo 2))))
+ (if finished?
+ code
+ (read-reply-code port))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "opensmptd")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'smtpd)
+ #t)
+ marionette))
+
+ (test-assert "mbox is empty"
+ (marionette-eval
+ '(and (file-exists? "/var/mail")
+ (not (file-exists? "/var/mail/root")))
+ marionette))
+
+ (test-eq "accept an email"
+ #t
+ (let* ((smtp (socket AF_INET SOCK_STREAM 0))
+ (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
+ (connect smtp addr)
+ ;; Be greeted.
+ (read-reply-code smtp) ;220
+ ;; Greet the server.
+ (write-line "EHLO somehost" smtp)
+ (read-reply-code smtp) ;250
+ ;; Set sender email.
+ (write-line "MAIL FROM: <someone>" smtp)
+ (read-reply-code smtp) ;250
+ ;; Set recipient email.
+ (write-line "RCPT TO: <root>" smtp)
+ (read-reply-code smtp) ;250
+ ;; Send message.
+ (write-line "DATA" smtp)
+ (read-reply-code smtp) ;354
+ (write-line "Subject: Hello" smtp)
+ (newline smtp)
+ (write-line "Nice to meet you!" smtp)
+ (write-line "." smtp)
+ (read-reply-code smtp) ;250
+ ;; Say goodbye.
+ (write-line "QUIT" smtp)
+ (read-reply-code smtp) ;221
+ (close smtp)
+ #t))
+
+ (test-assert "mail arrived"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define (queue-empty?)
+ (eof-object?
+ (read-line
+ (open-input-pipe "smtpctl show queue"))))
+
+ (let wait ()
+ (if (queue-empty?)
+ (file-exists? "/var/mail/root")
+ (begin (sleep 1) (wait)))))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "opensmtpd-test" test))
(define %test-opensmtpd
(system-test
@@ -179,100 +179,100 @@ acl_check_data:
(define (run-exim-test)
"Return a test of an OS running an Exim service."
- (mlet* %store-monad ((command (system-qemu-image/shared-store-script
- (marionette-operating-system
- %exim-os
- #:imported-modules '((gnu services herd)))
- #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette)
- (ice-9 ftw))
- #~(begin
- (use-modules (rnrs base)
- (srfi srfi-64)
- (ice-9 ftw)
- (ice-9 rdelim)
- (ice-9 regex)
- (gnu build marionette))
-
- (define marionette
- (make-marionette
- ;; Enable TCP forwarding of the guest's port 25.
- '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
-
- (define (read-reply-code port)
- "Read a SMTP reply from PORT and return its reply code."
- (let* ((line (read-line port))
- (mo (string-match "([0-9]+)([ -]).*" line))
- (code (string->number (match:substring mo 1)))
- (finished? (string= " " (match:substring mo 2))))
- (if finished?
- code
- (read-reply-code port))))
-
- (define smtp (socket AF_INET SOCK_STREAM 0))
- (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "exim")
-
- (test-assert "service is running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'exim)
- #t)
- marionette))
-
- (sleep 1) ;; give the service time to start talking
-
- (connect smtp addr)
- ;; Be greeted.
- (test-eq "greeting received"
- 220 (read-reply-code smtp))
- ;; Greet the server.
- (write-line "EHLO somehost" smtp)
- (test-eq "greeting successful"
- 250 (read-reply-code smtp))
- ;; Set sender email.
- (write-line "MAIL FROM: test@example.com" smtp)
- (test-eq "sender set"
- 250 (read-reply-code smtp)) ;250
- ;; Set recipient email.
- (write-line "RCPT TO: root@komputilo" smtp)
- (test-eq "recipient set"
- 250 (read-reply-code smtp)) ;250
- ;; Send message.
- (write-line "DATA" smtp)
- (test-eq "data begun"
- 354 (read-reply-code smtp)) ;354
- (write-line "Subject: Hello" smtp)
- (newline smtp)
- (write-line "Nice to meet you!" smtp)
- (write-line "." smtp)
- (test-eq "message sent"
- 250 (read-reply-code smtp)) ;250
- ;; Say goodbye.
- (write-line "QUIT" smtp)
- (test-eq "quit successful"
- 221 (read-reply-code smtp)) ;221
- (close smtp)
-
- (test-eq "the email is received"
- 1
- (marionette-eval
- '(begin
- (use-modules (ice-9 ftw))
- (length (scandir "/var/spool/exim/msglog"
- (lambda (x) (not (string-prefix? "." x))))))
- marionette))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation "exim-test" test)))
+ (define vm
+ (virtual-machine
+ (operating-system (marionette-operating-system
+ %exim-os
+ #:imported-modules '((gnu services herd))))
+ (port-forwardings '((1025 . 25)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette)
+ (ice-9 ftw))
+ #~(begin
+ (use-modules (rnrs base)
+ (srfi srfi-64)
+ (ice-9 ftw)
+ (ice-9 rdelim)
+ (ice-9 regex)
+ (gnu build marionette))
+
+ (define marionette
+ (make-marionette '(#$vm)))
+
+ (define (read-reply-code port)
+ "Read a SMTP reply from PORT and return its reply code."
+ (let* ((line (read-line port))
+ (mo (string-match "([0-9]+)([ -]).*" line))
+ (code (string->number (match:substring mo 1)))
+ (finished? (string= " " (match:substring mo 2))))
+ (if finished?
+ code
+ (read-reply-code port))))
+
+ (define smtp (socket AF_INET SOCK_STREAM 0))
+ (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "exim")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'exim)
+ #t)
+ marionette))
+
+ (sleep 1) ;; give the service time to start talking
+
+ (connect smtp addr)
+ ;; Be greeted.
+ (test-eq "greeting received"
+ 220 (read-reply-code smtp))
+ ;; Greet the server.
+ (write-line "EHLO somehost" smtp)
+ (test-eq "greeting successful"
+ 250 (read-reply-code smtp))
+ ;; Set sender email.
+ (write-line "MAIL FROM: test@example.com" smtp)
+ (test-eq "sender set"
+ 250 (read-reply-code smtp)) ;250
+ ;; Set recipient email.
+ (write-line "RCPT TO: root@komputilo" smtp)
+ (test-eq "recipient set"
+ 250 (read-reply-code smtp)) ;250
+ ;; Send message.
+ (write-line "DATA" smtp)
+ (test-eq "data begun"
+ 354 (read-reply-code smtp)) ;354
+ (write-line "Subject: Hello" smtp)
+ (newline smtp)
+ (write-line "Nice to meet you!" smtp)
+ (write-line "." smtp)
+ (test-eq "message sent"
+ 250 (read-reply-code smtp)) ;250
+ ;; Say goodbye.
+ (write-line "QUIT" smtp)
+ (test-eq "quit successful"
+ 221 (read-reply-code smtp)) ;221
+ (close smtp)
+
+ (test-eq "the email is received"
+ 1
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 ftw))
+ (length (scandir "/var/spool/exim/msglog"
+ (lambda (x) (not (string-prefix? "." x))))))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "exim-test" test))
(define %test-exim
(system-test
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index b76b8e8434..0ba0c839de 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,108 +27,109 @@
#:use-module (gnu packages messaging)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:export (%test-prosody))
(define (run-xmpp-test name xmpp-service pid-file create-account)
"Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
- (mlet* %store-monad ((os -> (marionette-operating-system
- (simple-operating-system (dhcp-client-service)
- xmpp-service)
- #:imported-modules '((gnu services herd))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f))
- (username -> "alice")
- (server -> "localhost")
- (jid -> (string-append username "@" server))
- (password -> "correct horse battery staple")
- (port -> 15222)
- (message -> "hello world")
- (witness -> "/tmp/freetalk-witness"))
-
- (define script.ft
- (scheme-file
- "script.ft"
- #~(begin
- (define (handle-received-message time from nickname message)
- (define (touch file-name)
- (call-with-output-file file-name (const #t)))
- (when (equal? message #$message)
- (touch #$witness)))
- (add-hook! ft-message-receive-hook handle-received-message)
-
- (ft-set-jid! #$jid)
- (ft-set-password! #$password)
- (ft-set-server! #$server)
- (ft-set-port! #$port)
- (ft-set-sslconn! #f)
- (ft-connect-blocking)
- (ft-send-message #$jid #$message)
-
- (ft-set-daemon)
- (ft-main-loop))))
-
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64))
-
- (define marionette
- ;; Enable TCP forwarding of the guest's port 5222.
- (make-marionette (list #$command "-net"
- (string-append "user,hostfwd=tcp::"
- (number->string #$port)
- "-:5222"))))
-
- (define (host-wait-for-file file)
- ;; Wait until FILE exists in the host.
- (let loop ((i 60))
- (cond ((file-exists? file)
- #t)
- ((> i 0)
- (begin
- (sleep 1))
- (loop (- i 1)))
- (else
- (error "file didn't show up" file)))))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "xmpp")
-
- ;; Wait for XMPP service to be up and running.
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'xmpp-daemon)
- 'running!)
- marionette))
-
- ;; Check XMPP service's PID.
- (test-assert "service process id"
- (let ((pid (number->string (wait-for-file #$pid-file
- marionette))))
- (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
- marionette)))
-
- ;; Alice sends an XMPP message to herself, with Freetalk.
- (test-assert "client-to-server communication"
- (let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
- (marionette-eval '(system* #$create-account #$jid #$password)
- marionette)
- ;; Freetalk requires write access to $HOME.
- (setenv "HOME" "/tmp")
- (system* freetalk-bin "-s" #$script.ft)
- (host-wait-for-file #$witness)))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation name test)))
+ (define os
+ (marionette-operating-system
+ (simple-operating-system (dhcp-client-service)
+ xmpp-service)
+ #:imported-modules '((gnu services herd))))
+
+ (define port 15222)
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((,port . 5222)))))
+
+ (define username "alice")
+ (define server "localhost")
+ (define jid (string-append username "@" server))
+ (define password "correct horse battery staple")
+ (define message "hello world")
+ (define witness "/tmp/freetalk-witness")
+
+ (define script.ft
+ (scheme-file
+ "script.ft"
+ #~(begin
+ (define (handle-received-message time from nickname message)
+ (define (touch file-name)
+ (call-with-output-file file-name (const #t)))
+ (when (equal? message #$message)
+ (touch #$witness)))
+ (add-hook! ft-message-receive-hook handle-received-message)
+
+ (ft-set-jid! #$jid)
+ (ft-set-password! #$password)
+ (ft-set-server! #$server)
+ (ft-set-port! #$port)
+ (ft-set-sslconn! #f)
+ (ft-connect-blocking)
+ (ft-send-message #$jid #$message)
+
+ (ft-set-daemon)
+ (ft-main-loop))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (define (host-wait-for-file file)
+ ;; Wait until FILE exists in the host.
+ (let loop ((i 60))
+ (cond ((file-exists? file)
+ #t)
+ ((> i 0)
+ (begin
+ (sleep 1))
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" file)))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "xmpp")
+
+ ;; Wait for XMPP service to be up and running.
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'xmpp-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check XMPP service's PID.
+ (test-assert "service process id"
+ (let ((pid (number->string (wait-for-file #$pid-file
+ marionette))))
+ (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
+ marionette)))
+
+ ;; Alice sends an XMPP message to herself, with Freetalk.
+ (test-assert "client-to-server communication"
+ (let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
+ (marionette-eval '(system* #$create-account #$jid #$password)
+ marionette)
+ ;; Freetalk requires write access to $HOME.
+ (setenv "HOME" "/tmp")
+ (system* freetalk-bin "-s" #$script.ft)
+ (host-wait-for-file #$witness)))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %create-prosody-account
(program-file
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index cfcb490874..aeee105a1c 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -74,60 +74,61 @@ done" ))))))))))
(define* (run-inetd-test)
"Run tests in %INETD-OS, where the inetd service provides an echo service on
port 7, and a dict service on port 2628."
- (mlet* %store-monad ((os -> (marionette-operating-system %inetd-os))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (ice-9 rdelim)
- (srfi srfi-64)
- (gnu build marionette))
- (define marionette
- ;; Forward guest ports 7 and 2628 to host ports 8007 and 8628.
- (make-marionette (list #$command "-net"
- (string-append
- "user"
- ",hostfwd=tcp::8007-:7"
- ",hostfwd=tcp::8628-:2628"))))
+ (define os
+ (marionette-operating-system %inetd-os))
- (mkdir #$output)
- (chdir #$output)
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((8007 . 7)
+ (8628 . 2628)))))
- (test-begin "inetd")
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (ice-9 rdelim)
+ (srfi srfi-64)
+ (gnu build marionette))
+ (define marionette
+ (make-marionette (list #$vm)))
- ;; Make sure the PID file is created.
- (test-assert "PID file"
- (marionette-eval
- '(file-exists? "/var/run/inetd.pid")
- marionette))
+ (mkdir #$output)
+ (chdir #$output)
- ;; Test the echo service.
- (test-equal "echo response"
- "Hello, Guix!"
- (let ((echo (socket PF_INET SOCK_STREAM 0))
- (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
- (connect echo addr)
- (display "Hello, Guix!\n" echo)
- (let ((response (read-line echo)))
- (close echo)
- response)))
+ (test-begin "inetd")
- ;; Test the dict service
- (test-equal "dict response"
- "GNU Guix is a package management tool for the GNU system."
- (let ((dict (socket PF_INET SOCK_STREAM 0))
- (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
- (connect dict addr)
- (display "DEFINE Guix\n" dict)
- (let ((response (read-line dict)))
- (close dict)
- response)))
+ ;; Make sure the PID file is created.
+ (test-assert "PID file"
+ (marionette-eval
+ '(file-exists? "/var/run/inetd.pid")
+ marionette))
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+ ;; Test the echo service.
+ (test-equal "echo response"
+ "Hello, Guix!"
+ (let ((echo (socket PF_INET SOCK_STREAM 0))
+ (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
+ (connect echo addr)
+ (display "Hello, Guix!\n" echo)
+ (let ((response (read-line echo)))
+ (close echo)
+ response)))
- (gexp->derivation "inetd-test" test)))
+ ;; Test the dict service
+ (test-equal "dict response"
+ "GNU Guix is a package management tool for the GNU system."
+ (let ((dict (socket PF_INET SOCK_STREAM 0))
+ (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
+ (connect dict addr)
+ (display "DEFINE Guix\n" dict)
+ (let ((response (read-line dict)))
+ (close dict)
+ response)))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "inetd-test" test))
(define %test-inetd
(system-test
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 9e1ac1d55a..889f578d01 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
@@ -41,7 +41,7 @@
(timezone "Europe/Berlin")
(locale "en_US.UTF-8")
- (bootloader (grub-configuration (device "/dev/sdX")))
+ (bootloader (grub-configuration (target "/dev/sdX")))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons*
@@ -55,75 +55,75 @@
(define (run-nfs-test name socket)
"Run a test of an OS running RPC-SERVICE, which should create SOCKET."
- (mlet* %store-monad ((os -> (marionette-operating-system
- %base-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$command)))
-
- (define (wait-for-socket file)
- ;; Wait until SOCKET exists in the guest
- (marionette-eval
- `(let loop ((i 10))
- (cond ((and (file-exists? ,file)
- (eq? 'socket (stat:type (stat ,file))))
- #t)
- ((> i 0)
- (sleep 1)
- (loop (- i 1)))
- (else
- (error "Socket didn't show up: " ,file))))
- marionette))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "rpc-daemon")
-
- ;; Wait for the rpcbind daemon to be up and running.
- (test-eq "RPC service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'rpcbind-daemon)
- 'running!)
- marionette))
-
- ;; Check the socket file and that the service is still running.
- (test-assert "RPC socket exists"
- (and
- (wait-for-socket #$socket)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd)
- (srfi srfi-1))
-
- (live-service-running
- (find (lambda (live)
- (memq 'rpcbind-daemon
- (live-service-provision live)))
- (current-services))))
- marionette)))
-
- (test-assert "Probe RPC daemon"
- (marionette-eval
- '(zero? (system* "rpcinfo" "-p"))
- marionette))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation name test)))
+ (define os
+ (marionette-operating-system
+ %base-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (define (wait-for-socket file)
+ ;; Wait until SOCKET exists in the guest
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((and (file-exists? ,file)
+ (eq? 'socket (stat:type (stat ,file))))
+ #t)
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "Socket didn't show up: " ,file))))
+ marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "rpc-daemon")
+
+ ;; Wait for the rpcbind daemon to be up and running.
+ (test-eq "RPC service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'rpcbind-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check the socket file and that the service is still running.
+ (test-assert "RPC socket exists"
+ (and
+ (wait-for-socket #$socket)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd)
+ (srfi srfi-1))
+
+ (live-service-running
+ (find (lambda (live)
+ (memq 'rpcbind-daemon
+ (live-service-provision live)))
+ (current-services))))
+ marionette)))
+
+ (test-assert "Probe RPC daemon"
+ (marionette-eval
+ '(zero? (system* "rpcinfo" "-p"))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %test-nfs
(system-test
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 9c83a9cd48..41be360355 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -27,7 +27,6 @@
#:use-module (gnu packages ssh)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:export (%test-openssh
%test-dropbear))
@@ -37,142 +36,143 @@ SSH-SERVICE must be configured to listen on port 22 and to allow for root and
empty-password logins.
When SFTP? is true, run an SFTP server test."
- (mlet* %store-monad ((os -> (marionette-operating-system
- (simple-operating-system
- (dhcp-client-service)
- ssh-service)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (eval-when (expand load eval)
- ;; Prepare to use Guile-SSH.
- (set! %load-path
- (cons (string-append #+guile2.0-ssh "/share/guile/site/"
- (effective-version))
- %load-path)))
-
- (use-modules (gnu build marionette)
- (srfi srfi-26)
- (srfi srfi-64)
- (ice-9 match)
- (ssh session)
- (ssh auth)
- (ssh channel)
- (ssh sftp))
-
- (define marionette
- ;; Enable TCP forwarding of the guest's port 22.
- (make-marionette (list #$command "-net"
- "user,hostfwd=tcp::2222-:22")))
-
- (define (make-session-for-test)
- "Make a session with predefined parameters for a test."
- (make-session #:user "root"
- #:port 2222
- #:host "localhost"
- #:log-verbosity 'protocol))
-
- (define (call-with-connected-session proc)
- "Call the one-argument procedure PROC with a freshly created and
+ (define os
+ (marionette-operating-system
+ (simple-operating-system (dhcp-client-service) ssh-service)
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '((2222 . 22)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (eval-when (expand load eval)
+ ;; Prepare to use Guile-SSH.
+ (set! %load-path
+ (cons (string-append #+guile-ssh "/share/guile/site/"
+ (effective-version))
+ %load-path)))
+
+ (use-modules (gnu build marionette)
+ (srfi srfi-26)
+ (srfi srfi-64)
+ (ice-9 match)
+ (ssh session)
+ (ssh auth)
+ (ssh channel)
+ (ssh sftp))
+
+ (define marionette
+ ;; Enable TCP forwarding of the guest's port 22.
+ (make-marionette (list #$vm)))
+
+ (define (make-session-for-test)
+ "Make a session with predefined parameters for a test."
+ (make-session #:user "root"
+ #:port 2222
+ #:host "localhost"
+ #:log-verbosity 'protocol))
+
+ (define (call-with-connected-session proc)
+ "Call the one-argument procedure PROC with a freshly created and
connected SSH session object, return the result of the procedure call. The
session is disconnected when the PROC is finished."
- (let ((session (make-session-for-test)))
- (dynamic-wind
- (lambda ()
- (let ((result (connect! session)))
- (unless (equal? result 'ok)
- (error "Could not connect to a server"
- session result))))
- (lambda () (proc session))
- (lambda () (disconnect! session)))))
-
- (define (call-with-connected-session/auth proc)
- "Make an authenticated session. We should be able to connect as
+ (let ((session (make-session-for-test)))
+ (dynamic-wind
+ (lambda ()
+ (let ((result (connect! session)))
+ (unless (equal? result 'ok)
+ (error "Could not connect to a server"
+ session result))))
+ (lambda () (proc session))
+ (lambda () (disconnect! session)))))
+
+ (define (call-with-connected-session/auth proc)
+ "Make an authenticated session. We should be able to connect as
root with an empty password."
- (call-with-connected-session
- (lambda (session)
- ;; Try the simple authentication methods. Dropbear requires
- ;; 'none' when there are no passwords, whereas OpenSSH accepts
- ;; 'password' with an empty password.
- (let loop ((methods (list (cut userauth-password! <> "")
- (cut userauth-none! <>))))
- (match methods
- (()
- (error "all the authentication methods failed"))
- ((auth rest ...)
- (match (pk 'auth (auth session))
- ('success
- (proc session))
- ('denied
- (loop rest)))))))))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "ssh-daemon")
-
- ;; Wait for sshd to be up and running.
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'ssh-daemon)
- 'running!)
- marionette))
-
- ;; Check sshd's PID file.
- (test-equal "sshd PID"
- (wait-for-file #$pid-file marionette)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd)
- (srfi srfi-1))
-
- (live-service-running
- (find (lambda (live)
- (memq 'ssh-daemon
- (live-service-provision live)))
- (current-services))))
- marionette))
-
- ;; Connect to the guest over SSH. Make sure we can run a shell
- ;; command there.
- (test-equal "shell command"
- 'hello
- (call-with-connected-session/auth
- (lambda (session)
- ;; FIXME: 'get-server-public-key' segfaults.
- ;; (get-server-public-key session)
- (let ((channel (make-channel session)))
- (channel-open-session channel)
- (channel-request-exec channel "echo hello > /root/witness")
- (and (zero? (channel-get-exit-status channel))
- (wait-for-file "/root/witness" marionette))))))
-
- ;; Connect to the guest over SFTP. Make sure we can write and
- ;; read a file there.
- (unless #$sftp?
- (test-skip 1))
- (test-equal "SFTP file writing and reading"
- 'hello
- (call-with-connected-session/auth
- (lambda (session)
- (let ((sftp-session (make-sftp-session session))
- (witness "/root/sftp-witness"))
- (call-with-remote-output-file sftp-session witness
- (cut display "hello" <>))
- (call-with-remote-input-file sftp-session witness
- read)))))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation name test)))
+ (call-with-connected-session
+ (lambda (session)
+ ;; Try the simple authentication methods. Dropbear requires
+ ;; 'none' when there are no passwords, whereas OpenSSH accepts
+ ;; 'password' with an empty password.
+ (let loop ((methods (list (cut userauth-password! <> "")
+ (cut userauth-none! <>))))
+ (match methods
+ (()
+ (error "all the authentication methods failed"))
+ ((auth rest ...)
+ (match (pk 'auth (auth session))
+ ('success
+ (proc session))
+ ('denied
+ (loop rest)))))))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "ssh-daemon")
+
+ ;; Wait for sshd to be up and running.
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'ssh-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check sshd's PID file.
+ (test-equal "sshd PID"
+ (wait-for-file #$pid-file marionette)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd)
+ (srfi srfi-1))
+
+ (live-service-running
+ (find (lambda (live)
+ (memq 'ssh-daemon
+ (live-service-provision live)))
+ (current-services))))
+ marionette))
+
+ ;; Connect to the guest over SSH. Make sure we can run a shell
+ ;; command there.
+ (test-equal "shell command"
+ 'hello
+ (call-with-connected-session/auth
+ (lambda (session)
+ ;; FIXME: 'get-server-public-key' segfaults.
+ ;; (get-server-public-key session)
+ (let ((channel (make-channel session)))
+ (channel-open-session channel)
+ (channel-request-exec channel "echo hello > /root/witness")
+ (and (zero? (channel-get-exit-status channel))
+ (wait-for-file "/root/witness" marionette))))))
+
+ ;; Connect to the guest over SFTP. Make sure we can write and
+ ;; read a file there.
+ (unless #$sftp?
+ (test-skip 1))
+ (test-equal "SFTP file writing and reading"
+ 'hello
+ (call-with-connected-session/auth
+ (lambda (session)
+ (let ((sftp-session (make-sftp-session session))
+ (witness "/root/sftp-witness"))
+ (call-with-remote-output-file sftp-session witness
+ (cut display "hello" <>))
+ (call-with-remote-input-file sftp-session witness
+ read)))))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %test-openssh
(system-test
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
new file mode 100644
index 0000000000..c2939355b2
--- /dev/null
+++ b/gnu/tests/virtualization.scm
@@ -0,0 +1,95 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 virtualization)
+ #:use-module (gnu tests)
+ #:use-module (gnu system)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system vm)
+ #:use-module (gnu services)
+ #:use-module (gnu services dbus)
+ #:use-module (gnu services networking)
+ #:use-module (gnu services virtualization)
+ #:use-module (gnu packages virtualization)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #:export (%test-libvirt))
+
+(define %libvirt-os
+ (simple-operating-system
+ (dhcp-client-service)
+ (dbus-service)
+ (polkit-service)
+ (service libvirt-service-type)))
+
+(define (run-libvirt-test)
+ "Run tests in %LIBVIRT-OS."
+ (define os
+ (marionette-operating-system
+ %libvirt-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '())))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (gnu build marionette))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "libvirt")
+
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (match (start-service 'libvirtd)
+ (#f #f)
+ (('service response-parts ...)
+ (match (assq-ref response-parts 'running)
+ ((pid) (number? pid))))))
+ marionette))
+
+ (test-eq "fetch version"
+ 0
+ (marionette-eval
+ `(begin
+ (system* ,(string-append #$libvirt "/bin/virsh")
+ "-c" "qemu:///system" "version"))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "libvirt-test" test))
+
+(define %test-libvirt
+ (system-test
+ (name "libvirt")
+ (description "Connect to the running LIBVIRT service.")
+ (value (run-libvirt-test))))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index bc7e3b89a9..3fa272c676 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -27,7 +27,6 @@
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:export (%test-nginx))
(define %index.html-contents
@@ -65,68 +64,68 @@
(define* (run-nginx-test #:optional (http-port 8042))
"Run tests in %NGINX-OS, which has nginx running and listening on
HTTP-PORT."
- (mlet* %store-monad ((os -> (marionette-operating-system
- %nginx-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (srfi srfi-11) (srfi srfi-64)
- (gnu build marionette)
- (web uri)
- (web client)
- (web response))
-
- (define marionette
- ;; Forward the guest's HTTP-PORT, where nginx is listening, to
- ;; port 8080 in the host.
- (make-marionette (list #$command "-net"
- (string-append
- "user,hostfwd=tcp::8080-:"
- #$(number->string http-port)))))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "nginx")
-
- ;; Wait for nginx to be up and running.
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'nginx)
- 'running!)
- marionette))
-
- ;; Make sure the PID file is created.
- (test-assert "PID file"
- (marionette-eval
- '(file-exists? "/var/run/nginx/pid")
- marionette))
-
- ;; Retrieve the index.html file we put in /srv.
- (test-equal "http-get"
- '(200 #$%index.html-contents)
- (let-values (((response text)
- (http-get "http://localhost:8080/index.html"
- #:decode-body? #t)))
- (list (response-code response) text)))
-
- ;; There should be a log file in here.
- (test-assert "log file"
- (marionette-eval
- '(file-exists? "/var/log/nginx/access.log")
- marionette))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation "nginx-test" test)))
+ (define os
+ (marionette-operating-system
+ %nginx-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((8080 . ,http-port)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (gnu build marionette)
+ (web uri)
+ (web client)
+ (web response))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "nginx")
+
+ ;; Wait for nginx to be up and running.
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'nginx)
+ 'running!)
+ marionette))
+
+ ;; Make sure the PID file is created.
+ (test-assert "PID file"
+ (marionette-eval
+ '(file-exists? "/var/run/nginx/pid")
+ marionette))
+
+ ;; Retrieve the index.html file we put in /srv.
+ (test-equal "http-get"
+ '(200 #$%index.html-contents)
+ (let-values (((response text)
+ (http-get "http://localhost:8080/index.html"
+ #:decode-body? #t)))
+ (list (response-code response) text)))
+
+ ;; There should be a log file in here.
+ (test-assert "log file"
+ (marionette-eval
+ '(file-exists? "/var/log/nginx/access.log")
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "nginx-test" test))
(define %test-nginx
(system-test
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-25 09:22:54 +0000