diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/messaging.scm | 89 | ||||
| -rw-r--r-- | gnu/tests/web.scm | 123 |
2 files changed, 164 insertions, 48 deletions
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm index 60e2f332a3..f17dfe6265 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -1,6 +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> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,9 @@ #:use-module (gnu packages messaging) #:use-module (guix gexp) #:use-module (guix store) - #:export (%test-prosody)) + #:use-module (guix modules) + #:export (%test-prosody + %test-bitlbee)) (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." @@ -158,3 +160,86 @@ (service prosody-service-type config) (prosody-configuration-pidfile config) %create-prosody-account))))) + + +;;; +;;; BitlBee. +;;; + +(define (run-bitlbee-test) + (define os + (marionette-operating-system + (simple-operating-system (dhcp-client-service) + (service bitlbee-service-type + (bitlbee-configuration + (interface "0.0.0.0")))) + #:imported-modules (source-module-closure + '((gnu services herd))))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((6667 . 6667))))) + + (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))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "bitlbee") + + (test-eq "service started" + 'running! + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'bitlbee) + 'running!) + marionette)) + + (test-equal "valid PID" + #$(file-append bitlbee "/sbin/bitlbee") + (marionette-eval + '(begin + (use-modules (srfi srfi-1) + (gnu services herd)) + + (let ((bitlbee + (find (lambda (service) + (equal? '(bitlbee) + (live-service-provision service))) + (current-services)))) + (and (pk 'bitlbee-service bitlbee) + (let ((pid (live-service-running bitlbee))) + (readlink (string-append "/proc/" + (number->string pid) + "/exe")))))) + marionette)) + + (test-assert "connect" + (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK + 6667)) + (sock (socket AF_INET SOCK_STREAM 0))) + (connect sock address) + ;; See <https://tools.ietf.org/html/rfc1459>. + (->bool (string-contains (pk 'message (read-line sock)) + "BitlBee")))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "bitlbee-test" test)) + +(define %test-bitlbee + (system-test + (name "bitlbee") + (description "Connect to a BitlBee IRC server.") + (value (run-bitlbee-test)))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 336f25b3c7..1912f8f79d 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -29,51 +29,38 @@ #:use-module (gnu services networking) #:use-module (guix gexp) #:use-module (guix store) - #:export (%test-nginx + #:export (%test-httpd + %test-nginx %test-php-fpm)) (define %index.html-contents - ;; Contents of the /index.html file served by nginx. - "Hello, nginx!") + ;; Contents of the /index.html file. + "Hello, guix!") (define %make-http-root ;; Create our server root in /srv. #~(begin (mkdir "/srv") - (call-with-output-file "/srv/index.html" + (mkdir "/srv/http") + (call-with-output-file "/srv/http/index.html" (lambda (port) (display #$%index.html-contents port))))) -(define %nginx-servers - ;; Server blocks. - (list (nginx-server-configuration - (root "/srv") - (listen '("8042" "443 ssl"))))) - -(define %nginx-os - ;; Operating system under test. - (simple-operating-system - (dhcp-client-service) - (service nginx-service-type - (nginx-configuration - (log-directory "/var/log/nginx") - (server-blocks %nginx-servers))) - (simple-service 'make-http-root activation-service-type - %make-http-root))) - -(define* (run-nginx-test #:optional (http-port 8042)) +(define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080)) "Run tests in %NGINX-OS, which has nginx running and listening on HTTP-PORT." (define os (marionette-operating-system - %nginx-os + test-os #:imported-modules '((gnu services herd) (guix combinators)))) + (define forwarded-port 8080) + (define vm (virtual-machine (operating-system os) - (port-forwardings `((8080 . ,http-port))))) + (port-forwardings `((,http-port . ,forwarded-port))))) (define test (with-imported-modules '((gnu build marionette)) @@ -90,48 +77,92 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) - (test-begin "nginx") + (test-begin #$name) - ;; Wait for nginx to be up and running. - (test-eq "service running" - 'running! + (test-assert #$(string-append name " service 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") + (match (start-service '#$(string->symbol name)) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((#t) #t) + ((pid) (number? 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))) + (let-values + (((response text) + (http-get #$(simple-format + #f "http://localhost:~A/index.html" forwarded-port) + #: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)) + #$@(if log-file + `((test-assert ,(string-append "log file exists " log-file) + (marionette-eval + '(file-exists? ,log-file) + marionette))) + '()) (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - (gexp->derivation "nginx-test" test)) + (gexp->derivation (string-append name "-test") test)) + + +;;; +;;; HTTPD +;;; + +(define %httpd-os + (simple-operating-system + (dhcp-client-service) + (service httpd-service-type + (httpd-configuration + (config + (httpd-config-file + (listen '("8080")))))) + (simple-service 'make-http-root activation-service-type + %make-http-root))) + +(define %test-httpd + (system-test + (name "httpd") + (description "Connect to a running HTTPD server.") + (value (run-webserver-test name %httpd-os + #:log-file "/var/log/httpd/error_log")))) + + +;;; +;;; NGINX +;;; + +(define %nginx-servers + ;; Server blocks. + (list (nginx-server-configuration + (listen '("8080"))))) + +(define %nginx-os + ;; Operating system under test. + (simple-operating-system + (dhcp-client-service) + (service nginx-service-type + (nginx-configuration + (log-directory "/var/log/nginx") + (server-blocks %nginx-servers))) + (simple-service 'make-http-root activation-service-type + %make-http-root))) (define %test-nginx (system-test (name "nginx") (description "Connect to a running NGINX server.") - (value (run-nginx-test)))) + (value (run-webserver-test name %nginx-os + #:log-file "/var/log/nginx/access.log")))) ;;; |