diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-09-07 22:29:40 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-09-10 12:12:50 +0200 |
commit | 19de8273eefceac1ba6ddc8d7e374a13f57c678b (patch) | |
tree | 66d77ef9a6500cc3feb630bf5c3c3a977d2bac21 /gnu/tests/web.scm | |
parent | d930374014eb159ef1e01d7c54d04fadd4889e4a (diff) | |
download | patches-19de8273eefceac1ba6ddc8d7e374a13f57c678b.tar patches-19de8273eefceac1ba6ddc8d7e374a13f57c678b.tar.gz |
services: tailon: Move to (gnu services web).
This allows (gnu services admin) to remain deeper in the module graph
and to be used by (gnu services web).
* gnu/services/admin.scm (<tailon-configuration-file>)
(tailon-configuration-files-string)
(tailon-configuration-file-compiler, <tailon-configuration>)
(tailon-shepherd-service, %tailon-accounts)
(tailon-service-type): Move to...
* gnu/services/web.scm: ... here.
* gnu/tests/admin.scm: Remove. Move test to...
* gnu/tests/web.scm (%tailon-os)
(run-tailon-test, %test-tailon): ... here.
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r-- | gnu/tests/web.scm | 99 |
1 files changed, 98 insertions, 1 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 73d502dd0e..45fcb668fb 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -33,7 +33,8 @@ #:export (%test-httpd %test-nginx %test-php-fpm - %test-hpcguix-web)) + %test-hpcguix-web + %test-tailon)) (define %index.html-contents ;; Contents of the /index.html file. @@ -359,3 +360,99 @@ HTTP-PORT, along with php-fpm." (name "hpcguix-web") (description "Connect to a running hpcguix-web server.") (value (run-hpcguix-web-server-test name %hpcguix-web-os)))) + + +(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-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'tailon)) + 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)))) |