1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
4 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
5 ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
6 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
8 ;;; This file is part of GNU Guix.
10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
11 ;;; under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or (at
13 ;;; your option) any later version.
15 ;;; GNU Guix is distributed in the hope that it will be useful, but
16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
23 (define-module (gnu tests web)
24 #:use-module (gnu tests)
25 #:use-module (gnu system)
26 #:use-module (gnu system file-systems)
27 #:use-module (gnu system shadow)
28 #:use-module (gnu system vm)
29 #:use-module (gnu services)
30 #:use-module (gnu services web)
31 #:use-module (gnu services databases)
32 #:use-module (gnu services getmail)
33 #:use-module (gnu services networking)
34 #:use-module (gnu services shepherd)
35 #:use-module (gnu services mail)
36 #:use-module (gnu packages databases)
37 #:use-module (gnu packages patchutils)
38 #:use-module (gnu packages python)
39 #:use-module (gnu packages web)
40 #:use-module (guix packages)
41 #:use-module (guix modules)
42 #:use-module (guix records)
43 #:use-module (guix gexp)
44 #:use-module (guix store)
45 #:use-module (guix utils)
46 #:use-module (ice-9 match)
55 (define %index.html-contents
56 ;; Contents of the /index.html file.
59 (define %make-http-root
60 ;; Create our server root in /srv.
64 (call-with-output-file "/srv/http/index.html"
66 (display #$%index.html-contents port)))))
68 (define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
69 "Run tests in %NGINX-OS, which has nginx running and listening on
72 (marionette-operating-system
74 #:imported-modules '((gnu services herd)
77 (define forwarded-port 8080)
82 (port-forwardings `((,http-port . ,forwarded-port)))))
85 (with-imported-modules '((gnu build marionette))
87 (use-modules (srfi srfi-11) (srfi srfi-64)
88 (gnu build marionette)
94 (make-marionette (list #$vm)))
101 (test-assert #$(string-append name " service running")
104 (use-modules (gnu services herd))
105 (match (start-service '#$(string->symbol name))
107 (('service response-parts ...)
108 (match (assq-ref response-parts 'running)
110 ((pid) (number? pid))))))
113 (test-assert "HTTP port ready"
114 (wait-for-tcp-port #$forwarded-port marionette))
116 ;; Retrieve the index.html file we put in /srv.
117 (test-equal "http-get"
118 '(200 #$%index.html-contents)
121 (http-get #$(simple-format
122 #f "http://localhost:~A/index.html" forwarded-port)
124 (list (response-code response) text)))
127 `((test-assert ,(string-append "log file exists " log-file)
129 '(file-exists? ,log-file)
134 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
136 (gexp->derivation (string-append name "-test") test))
144 (simple-operating-system
145 (service dhcp-client-service-type)
146 (service httpd-service-type
150 (listen '("8080"))))))
151 (simple-service 'make-http-root activation-service-type
157 (description "Connect to a running HTTPD server.")
158 (value (run-webserver-test name %httpd-os
159 #:log-file "/var/log/httpd/error_log"))))
166 (define %nginx-servers
168 (list (nginx-server-configuration
169 (listen '("8080")))))
172 ;; Operating system under test.
173 (simple-operating-system
174 (service dhcp-client-service-type)
175 (service nginx-service-type
177 (log-directory "/var/log/nginx")
178 (server-blocks %nginx-servers)))
179 (simple-service 'make-http-root activation-service-type
185 (description "Connect to a running NGINX server.")
186 (value (run-webserver-test name %nginx-os
187 #:log-file "/var/log/nginx/access.log"))))
198 backend dummy { .host = \"127.1.1.1\"; }
199 sub vcl_recv { return(synth(200, \"OK\")); }
201 synthetic(\"" %index.html-contents "\");
202 set resp.http.Content-Type = \"text/plain\";
207 (simple-operating-system
208 (service dhcp-client-service-type)
209 ;; Pretend to be a web server that serves %index.html-contents.
210 (service varnish-service-type
211 (varnish-configuration
213 ;; Use a small VSL buffer to fit in the test VM.
214 (parameters '(("vsl_space" . "4M")))
216 ;; Proxy the "server" using the builtin configuration.
217 (service varnish-service-type
218 (varnish-configuration
219 (parameters '(("vsl_space" . "4M")))
220 (backend "localhost:80")
221 (listen '(":8080"))))))
223 (define %test-varnish
226 (description "Test the Varnish Cache server.")
227 (value (run-webserver-test "varnish-default" %varnish-os))))
234 (define %make-php-fpm-http-root
235 ;; Create our server root in /srv.
238 (call-with-output-file "/srv/index.php"
242 echo(\"Computed by php:\".((string)(2+3)));
245 (define %php-fpm-nginx-server-blocks
246 (list (nginx-server-configuration
249 (list (nginx-php-location)))
252 (ssl-certificate-key #f))))
255 ;; Operating system under test.
256 (simple-operating-system
257 (service dhcp-client-service-type)
258 (service php-fpm-service-type)
259 (service nginx-service-type
261 (server-blocks %php-fpm-nginx-server-blocks)))
262 (simple-service 'make-http-root activation-service-type
263 %make-php-fpm-http-root)))
265 (define* (run-php-fpm-test #:optional (http-port 8042))
266 "Run tests in %PHP-FPM-OS, which has nginx running and listening on
267 HTTP-PORT, along with php-fpm."
269 (marionette-operating-system
271 #:imported-modules '((gnu services herd)
272 (guix combinators))))
276 (operating-system os)
277 (port-forwardings `((8080 . ,http-port)))))
280 (with-imported-modules '((gnu build marionette)
283 (use-modules (srfi srfi-11) (srfi srfi-64)
284 (gnu build marionette)
290 (make-marionette (list #$vm)))
295 (test-begin "php-fpm")
297 (test-assert "php-fpm running"
300 (use-modules (gnu services herd))
301 (match (start-service 'php-fpm)
303 (('service response-parts ...)
304 (match (assq-ref response-parts 'running)
305 ((pid) (number? pid))))))
308 (test-assert "nginx running"
311 (use-modules (gnu services herd))
312 (start-service 'nginx))
315 (test-equal "http-get"
317 (let-values (((response text)
318 (http-get "http://localhost:8080/index.php"
320 (response-code response)))
322 (test-equal "php computed result is sent"
324 (let-values (((response text)
325 (http-get "http://localhost:8080/index.php"
328 (use-modules (ice-9 regex))
329 (let ((matches (string-match "Computed by php:5" text)))
331 (match:substring matches 0))))))
335 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
337 (gexp->derivation "php-fpm-test" test))
339 (define %test-php-fpm
342 (description "Test PHP-FPM through nginx.")
343 (value (run-php-fpm-test))))
350 (define* (run-hpcguix-web-server-test name test-os)
351 "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
353 (marionette-operating-system
355 #:imported-modules '((gnu services herd)
356 (guix combinators))))
360 (operating-system os)
361 (port-forwardings '((8080 . 5000)))))
364 (with-imported-modules '((gnu build marionette))
366 (use-modules (srfi srfi-11) (srfi srfi-64)
367 (gnu build marionette)
373 (make-marionette (list #$vm)))
380 (test-assert "hpcguix-web running"
383 (use-modules (gnu services herd))
384 (match (start-service 'hpcguix-web)
386 (('service response-parts ...)
387 (match (assq-ref response-parts 'running)
388 ((pid) (number? pid))))))
391 (test-equal "http-get"
394 (wait-for-tcp-port 5000 marionette)
395 (let-values (((response text)
396 (http-get "http://localhost:8080")))
397 (response-code response))))
400 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
402 (gexp->derivation (string-append name "-test") test))
404 (define %hpcguix-web-specs
405 ;; Server config gexp.
406 #~(define site-config
407 (hpcweb-configuration
408 (title-prefix "[TEST] HPCGUIX-WEB"))))
410 (define %hpcguix-web-os
411 (simple-operating-system
412 (service dhcp-client-service-type)
413 (service hpcguix-web-service-type
414 (hpcguix-web-configuration
415 (specs %hpcguix-web-specs)))))
417 (define %test-hpcguix-web
420 (description "Connect to a running hpcguix-web server.")
421 (value (run-hpcguix-web-server-test name %hpcguix-web-os))))
425 ;; Operating system under test.
426 (simple-operating-system
427 (service dhcp-client-service-type)
428 (service tailon-service-type
429 (tailon-configuration
431 (tailon-configuration-file
432 (bind "0.0.0.0:8080")))))))
434 (define* (run-tailon-test #:optional (http-port 8081))
435 "Run tests in %TAILON-OS, which has tailon running and listening on
438 (marionette-operating-system
440 #:imported-modules '((gnu services herd)
441 (guix combinators))))
445 (operating-system os)
446 (port-forwardings `((,http-port . 8080)))))
449 (with-imported-modules '((gnu build marionette))
451 (use-modules (srfi srfi-11) (srfi srfi-64)
453 (gnu build marionette)
459 ;; Forward the guest's HTTP-PORT, where tailon is listening, to
460 ;; port 8080 in the host.
461 (make-marionette (list #$vm)))
466 (test-begin "tailon")
468 (test-assert "service running"
471 (use-modules (gnu services herd))
472 (start-service 'tailon))
475 (define* (retry-on-error f #:key times delay)
476 (let loop ((attempt 1))
488 (if (>= attempt times)
492 (loop (+ 1 attempt))))))))
494 (test-equal "http-get"
498 (let-values (((response text)
501 "http://localhost:~A/"
504 (response-code response)))
509 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
511 (gexp->derivation "tailon-test" test))
516 (description "Connect to a running Tailon server.")
517 (value (run-tailon-test))))
524 (define patchwork-initial-database-setup-service
526 (($ <patchwork-database-configuration>
527 engine name user password host port)
531 (let ((pid (primitive-fork))
532 (postgres (getpwnam "postgres")))
537 (setgid (passwd:gid postgres))
538 (setuid (passwd:uid postgres))
542 (system* #$(file-append postgresql "/bin/createuser")
545 (system* #$(file-append postgresql "/bin/createdb")
546 "-O" #$user #$name)))
551 (zero? (cdr (waitpid pid)))))))
554 (requirement '(postgres))
555 (provision '(patchwork-postgresql-user-and-database))
559 (documentation "Setup patchwork database.")))))
561 (define (patchwork-os patchwork)
562 (simple-operating-system
563 (service dhcp-client-service-type)
564 (service httpd-service-type
568 (listen '("8080"))))))
569 (service postgresql-service-type)
570 (service patchwork-service-type
571 (patchwork-configuration
572 (patchwork patchwork)
575 (patchwork-settings-module
576 (allowed-hosts (list domain))
577 (default-from-email "")))
578 (getmail-retriever-config
579 (getmail-retriever-configuration
580 (type "SimpleIMAPSSLRetriever")
581 (server "imap.example.com")
583 (username "username")
584 (password "password")
586 '((mailboxes . ("INBOX"))))))))
587 (simple-service 'patchwork-database-setup
588 shepherd-root-service-type
590 (patchwork-initial-database-setup-service
591 (patchwork-database-configuration))))))
593 (define (run-patchwork-test patchwork)
594 "Run tests in %NGINX-OS, which has nginx running and listening on
597 (marionette-operating-system
598 (patchwork-os patchwork)
599 #:imported-modules '((gnu services herd)
600 (guix combinators))))
602 (define forwarded-port 8080)
606 (operating-system os)
607 (port-forwardings `((8080 . ,forwarded-port)))))
610 (with-imported-modules '((gnu build marionette))
612 (use-modules (srfi srfi-11) (srfi srfi-64)
613 (gnu build marionette)
619 (make-marionette (list #$vm)))
624 (test-begin "patchwork")
626 (test-assert "patchwork-postgresql-user-and-service started"
629 (use-modules (gnu services herd))
630 (match (start-service 'patchwork-postgresql-user-and-database)
632 (('service response-parts ...)
633 (match (assq-ref response-parts 'running)
635 ((pid) (number? pid))))))
638 (test-assert "httpd running"
641 (use-modules (gnu services herd))
642 (start-service 'httpd))
645 (test-equal "http-get"
649 (http-get #$(simple-format
650 #f "http://localhost:~A/" forwarded-port)
652 (response-code response)))
655 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
657 (gexp->derivation "patchwork-test" test))
659 (define %test-patchwork
662 (description "Connect to a running Patchwork service.")
663 (value (run-patchwork-test patchwork))))