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) | |
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 73d502dd0e0..45fcb668fb3 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm | |||
| @@ -33,7 +33,8 @@ | |||
| 33 | #:export (%test-httpd | 33 | #:export (%test-httpd |
| 34 | %test-nginx | 34 | %test-nginx |
| 35 | %test-php-fpm | 35 | %test-php-fpm |
| 36 | %test-hpcguix-web)) | 36 | %test-hpcguix-web |
| 37 | %test-tailon)) | ||
| 37 | 38 | ||
| 38 | (define %index.html-contents | 39 | (define %index.html-contents |
| 39 | ;; Contents of the /index.html file. | 40 | ;; Contents of the /index.html file. |
| @@ -359,3 +360,99 @@ HTTP-PORT, along with php-fpm." | |||
| 359 | (name "hpcguix-web") | 360 | (name "hpcguix-web") |
| 360 | (description "Connect to a running hpcguix-web server.") | 361 | (description "Connect to a running hpcguix-web server.") |
| 361 | (value (run-hpcguix-web-server-test name %hpcguix-web-os)))) | 362 | (value (run-hpcguix-web-server-test name %hpcguix-web-os)))) |
| 363 | |||
| 364 | |||
| 365 | (define %tailon-os | ||
| 366 | ;; Operating system under test. | ||
| 367 | (simple-operating-system | ||
| 368 | (dhcp-client-service) | ||
| 369 | (service tailon-service-type | ||
| 370 | (tailon-configuration | ||
| 371 | (config-file | ||
| 372 | (tailon-configuration-file | ||
| 373 | (bind "0.0.0.0:8080"))))))) | ||
| 374 | |||
| 375 | (define* (run-tailon-test #:optional (http-port 8081)) | ||
| 376 | "Run tests in %TAILON-OS, which has tailon running and listening on | ||
| 377 | HTTP-PORT." | ||
| 378 | (define os | ||
| 379 | (marionette-operating-system | ||
| 380 | %tailon-os | ||
| 381 | #:imported-modules '((gnu services herd) | ||
| 382 | (guix combinators)))) | ||
| 383 | |||
| 384 | (define vm | ||
| 385 | (virtual-machine | ||
| 386 | (operating-system os) | ||
| 387 | (port-forwardings `((,http-port . 8080))))) | ||
| 388 | |||
| 389 | (define test | ||
| 390 | (with-imported-modules '((gnu build marionette)) | ||
| 391 | #~(begin | ||
| 392 | (use-modules (srfi srfi-11) (srfi srfi-64) | ||
| 393 | (ice-9 match) | ||
| 394 | (gnu build marionette) | ||
| 395 | (web uri) | ||
| 396 | (web client) | ||
| 397 | (web response)) | ||
| 398 | |||
| 399 | (define marionette | ||
| 400 | ;; Forward the guest's HTTP-PORT, where tailon is listening, to | ||
| 401 | ;; port 8080 in the host. | ||
| 402 | (make-marionette (list #$vm))) | ||
| 403 | |||
| 404 | (mkdir #$output) | ||
| 405 | (chdir #$output) | ||
| 406 | |||
| 407 | (test-begin "tailon") | ||
| 408 | |||
| 409 | (test-assert "service running" | ||
| 410 | (marionette-eval | ||
| 411 | '(begin | ||
| 412 | (use-modules (gnu services herd)) | ||
| 413 | (start-service 'tailon)) | ||
| 414 | marionette)) | ||
| 415 | |||
| 416 | (define* (retry-on-error f #:key times delay) | ||
| 417 | (let loop ((attempt 1)) | ||
| 418 | (match (catch | ||
| 419 | #t | ||
| 420 | (lambda () | ||
| 421 | (cons #t | ||
| 422 | (f))) | ||
| 423 | (lambda args | ||
| 424 | (cons #f | ||
| 425 | args))) | ||
| 426 | ((#t . return-value) | ||
| 427 | return-value) | ||
| 428 | ((#f . error-args) | ||
| 429 | (if (>= attempt times) | ||
| 430 | error-args | ||
| 431 | (begin | ||
| 432 | (sleep delay) | ||
| 433 | (loop (+ 1 attempt)))))))) | ||
| 434 | |||
| 435 | (test-equal "http-get" | ||
| 436 | 200 | ||
| 437 | (retry-on-error | ||
| 438 | (lambda () | ||
| 439 | (let-values (((response text) | ||
| 440 | (http-get #$(format | ||
| 441 | #f | ||
| 442 | "http://localhost:~A/" | ||
| 443 | http-port) | ||
| 444 | #:decode-body? #t))) | ||
| 445 | (response-code response))) | ||
| 446 | #:times 10 | ||
| 447 | #:delay 5)) | ||
| 448 | |||
| 449 | (test-end) | ||
| 450 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | ||
| 451 | |||
| 452 | (gexp->derivation "tailon-test" test)) | ||
| 453 | |||
| 454 | (define %test-tailon | ||
| 455 | (system-test | ||
| 456 | (name "tailon") | ||
| 457 | (description "Connect to a running Tailon server.") | ||
| 458 | (value (run-tailon-test)))) | ||
