projects/guix·blob python-team · refs

1221 lines · 38.5 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017, 2020-2021, 2023 Ludovic Courtès <[email protected]>
3;;; Copyright © 2017, 2019 Christopher Baines <[email protected]>
4;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]>
5;;; Copyright © 2018 Pierre-Antoine Rouby <[email protected]>
6;;; Copyright © 2018 Marius Bakke <[email protected]>
7;;; Copyright © 2024 Maxim Cournoyer <[email protected]>
8;;; Copyright © 2025 Rodion Goritskov <[email protected]>
9;;;
10;;; This file is part of GNU Guix.
11;;;
12;;; GNU Guix is free software; you can redistribute it and/or modify it
13;;; under the terms of the GNU General Public License as published by
14;;; the Free Software Foundation; either version 3 of the License, or (at
15;;; your option) any later version.
16;;;
17;;; GNU Guix is distributed in the hope that it will be useful, but
18;;; WITHOUT ANY WARRANTY; without even the implied warranty of
19;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;;; GNU General Public License for more details.
21;;;
22;;; You should have received a copy of the GNU General Public License
23;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
24
25(define-module (gnu tests web)
26 #:use-module (gnu tests)
27 #:use-module (gnu system)
28 #:use-module (gnu system file-systems)
29 #:use-module (gnu system shadow)
30 #:use-module (gnu system vm)
31 #:use-module (gnu services)
32 #:use-module (gnu services web)
33 #:use-module (gnu services databases)
34 #:use-module (gnu services getmail)
35 #:use-module (gnu services networking)
36 #:use-module (gnu services shepherd)
37 #:use-module (gnu services mail)
38 #:use-module (gnu packages base)
39 #:use-module (gnu packages databases)
40 #:use-module (gnu packages guile-xyz)
41 #:use-module (gnu packages gnupg)
42 #:use-module (gnu packages golang-xyz)
43 #:use-module (gnu packages patchutils)
44 #:use-module (gnu packages python)
45 #:use-module (gnu packages python-web)
46 #:use-module (gnu packages tls)
47 #:use-module (gnu packages web)
48 #:use-module (guix packages)
49 #:use-module (guix modules)
50 #:use-module (guix records)
51 #:use-module (guix gexp)
52 #:use-module (guix store)
53 #:use-module (guix utils)
54 #:use-module (ice-9 match)
55 #:export (%test-httpd
56 %test-nginx
57 %test-nginx+anonip
58 %test-varnish
59 %test-php-fpm
60 %test-hpcguix-web
61 %test-anonip
62 %test-go-webdav
63 %test-gunicorn
64 %test-patchwork
65 %test-sogogi
66 %test-agate
67 %test-miniflux-admin-string
68 %test-miniflux-admin-file
69 %test-miniflux-socket))
70
71(define %index.html-contents
72 ;; Contents of the /index.html file.
73 "Hello, guix!")
74
75(define %make-http-root
76 ;; Create our server root in /srv.
77 #~(begin
78 (mkdir "/srv")
79 (mkdir "/srv/http")
80 (call-with-output-file "/srv/http/index.html"
81 (lambda (port)
82 (display #$%index.html-contents port)))))
83
84(define retry-on-error
85 #~(lambda* (f #:key times delay)
86 (let loop ((attempt 1))
87 (match (catch
88 #t
89 (lambda ()
90 (cons #t
91 (f)))
92 (lambda args
93 (cons #f
94 args)))
95 ((#t . return-value)
96 return-value)
97 ((#f . error-args)
98 (if (>= attempt times)
99 (apply throw error-args)
100 (begin
101 (sleep delay)
102 (loop (+ 1 attempt)))))))))
103
104(define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080)
105 extra-tests)
106 "Run tests in %NGINX-OS, which has nginx running and listening on HTTP-PORT.
107EXTRA-TESTS should be a sexp of gexp containing extra code to run as part of
108the tests."
109 (define os
110 (marionette-operating-system
111 test-os
112 #:imported-modules '((gnu services herd)
113 (guix combinators))))
114
115 (define forwarded-port 8080)
116
117 (define vm
118 (virtual-machine
119 (operating-system os)
120 (port-forwardings `((,http-port . ,forwarded-port)))))
121
122 (define test
123 (with-imported-modules '((gnu build marionette))
124 #~(begin
125 (use-modules (srfi srfi-11) (srfi srfi-64)
126 (gnu build marionette)
127 (web uri)
128 (web client)
129 (web response))
130
131 (define marionette
132 (make-marionette (list #$vm)))
133
134 (test-runner-current (system-test-runner #$output))
135 (test-begin #$name)
136
137 (test-assert #$(string-append name " service running")
138 (marionette-eval
139 '(begin
140 (use-modules (gnu services herd))
141 (match (start-service '#$(string->symbol name))
142 (#f #f)
143 (('service response-parts ...)
144 (match (assq-ref response-parts 'running)
145 ((#t) #t)
146 ((pid) pid)))))
147 marionette))
148
149 (test-assert "HTTP port ready"
150 (wait-for-tcp-port #$forwarded-port marionette))
151
152 ;; Retrieve the index.html file we put in /srv.
153 (test-equal "http-get"
154 '(200 #$%index.html-contents)
155 (let-values
156 (((response text)
157 (http-get #$(simple-format
158 #f "http://localhost:~A/index.html" forwarded-port)
159 #:decode-body? #t)))
160 (list (response-code response) text)))
161
162 #$@(if log-file
163 `((test-assert ,(string-append "log file exists " log-file)
164 (marionette-eval
165 '(file-exists? ,log-file)
166 marionette)))
167 '())
168
169 #$extra-tests
170
171 (test-end))))
172
173 (gexp->derivation (string-append name "-test") test))
174
175
176;;;
177;;; HTTPD
178;;;
179
180(define %httpd-os
181 (simple-operating-system
182 (service dhcpcd-service-type)
183 (service httpd-service-type
184 (httpd-configuration
185 (config
186 (httpd-config-file
187 (listen '("8080"))))))
188 (simple-service 'make-http-root activation-service-type
189 %make-http-root)))
190
191(define %test-httpd
192 (system-test
193 (name "httpd")
194 (description "Connect to a running HTTPD server.")
195 (value (run-webserver-test name %httpd-os
196 #:log-file "/var/log/httpd/error_log"))))
197
198
199;;;
200;;; NGINX
201;;;
202
203(define %nginx-servers
204 ;; Server blocks.
205 (list (nginx-server-configuration
206 (listen '("8080"))
207 (locations
208 ;; Dummy location to test the default configuration path.
209 (list (nginx-location-configuration
210 (uri "/")
211 (body (list "include fastcgi_params;"))))))))
212
213;;; For a manual test/inspection:
214#;(
215
216$(./pre-inst-env guix system vm \
217-e '(@@ (gnu tests web) %nginx-os)' --no-graphic) \
218-nic user,model=virtio-net-pci,hostfwd=tcp::8080-:80 -m 1024
219
220)
221(define %nginx-os
222 ;; Operating system under test.
223 (simple-operating-system
224 (service dhcpcd-service-type)
225 (service nginx-service-type
226 (nginx-configuration
227 (log-directory "/var/log/nginx")
228 (server-blocks %nginx-servers)))
229 (simple-service 'make-http-root activation-service-type
230 %make-http-root)))
231
232(define %test-nginx
233 (system-test
234 (name "nginx")
235 (description "Connect to a running NGINX server.")
236 (value (run-webserver-test name %nginx-os
237 #:log-file "/var/log/nginx/access.log"))))
238
239(define %nginx+anonip-os
240 (simple-operating-system
241 (service dhcpcd-service-type)
242 (service anonip-service-type
243 (anonip-configuration
244 (input "/var/run/anonip/access.log")
245 (output "/var/log/anonip/access.log")
246 (debug? #t)))
247 (service nginx-service-type
248 (nginx-configuration
249 (log-directory "/var/run/anonip/")
250 (server-blocks %nginx-servers)
251 (shepherd-requirement '(anonip-/var/log/anonip/access.log))))
252 (simple-service 'make-http-root activation-service-type
253 %make-http-root)))
254
255(define nginx-anonip-tests
256 #~(test-assert "anonip service is running"
257 (marionette-eval
258 '(begin
259 (use-modules (gnu services herd))
260 (wait-for-service 'anonip-/var/log/anonip/access.log))
261 marionette)))
262
263(define %test-nginx+anonip
264 (system-test
265 (name "nginx+anonip")
266 (description "Run a NGINX server with logs anonymized by Anonip")
267 (value (run-webserver-test "nginx" %nginx+anonip-os
268 #:log-file "/var/log/anonip/access.log"
269 #:extra-tests nginx-anonip-tests))))
270
271
272;;;
273;;; Varnish
274;;;
275
276(define %varnish-vcl
277 (mixed-text-file
278 "varnish-test.vcl"
279 "vcl 4.0;
280backend dummy { .host = \"127.1.1.1\"; }
281sub vcl_recv { return(synth(200, \"OK\")); }
282sub vcl_synth {
283 synthetic(\"" %index.html-contents "\");
284 set resp.http.Content-Type = \"text/plain\";
285 return(deliver);
286}"))
287
288(define %varnish-os
289 (simple-operating-system
290 (service dhcpcd-service-type)
291 ;; Pretend to be a web server that serves %index.html-contents.
292 (service varnish-service-type
293 (varnish-configuration
294 (name "/tmp/server")
295 ;; Use a small VSL buffer to fit in the test VM.
296 (parameters '(("vsl_space" . "4M")))
297 (vcl %varnish-vcl)))
298 ;; Proxy the "server" using the builtin configuration.
299 (service varnish-service-type
300 (varnish-configuration
301 (parameters '(("vsl_space" . "4M")))
302 (backend "localhost:80")
303 (listen '(":8080"))))))
304
305(define %test-varnish
306 (system-test
307 (name "varnish")
308 (description "Test the Varnish Cache server.")
309 (value (run-webserver-test "varnish-default" %varnish-os))))
310
311
312;;;
313;;; PHP-FPM
314;;;
315
316(define %make-php-fpm-http-root
317 ;; Create our server root in /srv.
318 #~(begin
319 (mkdir "/srv")
320 (call-with-output-file "/srv/index.php"
321 (lambda (port)
322 (display "<?php
323phpinfo();
324echo(\"Computed by php:\".((string)(2+3)));
325?>\n" port)))))
326
327(define %php-fpm-nginx-server-blocks
328 (list (nginx-server-configuration
329 (root "/srv")
330 (locations
331 (list (nginx-php-location)))
332 (listen '("8042"))
333 (ssl-certificate #f)
334 (ssl-certificate-key #f))))
335
336(define %php-fpm-os
337 ;; Operating system under test.
338 (simple-operating-system
339 (service dhcpcd-service-type)
340 (service php-fpm-service-type)
341 (service nginx-service-type
342 (nginx-configuration
343 (server-blocks %php-fpm-nginx-server-blocks)))
344 (simple-service 'make-http-root activation-service-type
345 %make-php-fpm-http-root)))
346
347(define* (run-php-fpm-test #:optional (http-port 8042))
348 "Run tests in %PHP-FPM-OS, which has nginx running and listening on
349HTTP-PORT, along with php-fpm."
350 (define os
351 (marionette-operating-system
352 %php-fpm-os
353 #:imported-modules '((gnu services herd)
354 (guix combinators))))
355
356 (define vm
357 (virtual-machine
358 (operating-system os)
359 (port-forwardings `((8080 . ,http-port)))))
360
361 (define test
362 (with-imported-modules '((gnu build marionette)
363 (guix build utils))
364 #~(begin
365 (use-modules (srfi srfi-11) (srfi srfi-64)
366 (gnu build marionette)
367 (web uri)
368 (web client)
369 (web response))
370
371 (define marionette
372 (make-marionette (list #$vm)))
373
374 (test-runner-current (system-test-runner #$output))
375 (test-begin "php-fpm")
376
377 (test-assert "php-fpm running"
378 (marionette-eval
379 '(begin
380 (use-modules (gnu services herd))
381 (match (start-service 'php-fpm)
382 (#f #f)
383 (('service response-parts ...)
384 (match (assq-ref response-parts 'running)
385 ((pid) pid)))))
386 marionette))
387
388 (test-assert "nginx running"
389 (marionette-eval
390 '(begin
391 (use-modules (gnu services herd))
392 (start-service 'nginx))
393 marionette))
394
395 (test-equal "http-get"
396 200
397 (let-values (((response text)
398 (http-get "http://localhost:8080/index.php"
399 #:decode-body? #t)))
400 (response-code response)))
401
402 (test-equal "php computed result is sent"
403 "Computed by php:5"
404 (let-values (((response text)
405 (http-get "http://localhost:8080/index.php"
406 #:decode-body? #t)))
407 (begin
408 (use-modules (ice-9 regex))
409 (let ((matches (string-match "Computed by php:5" text)))
410 (and matches
411 (match:substring matches 0))))))
412
413 (test-end))))
414
415 (gexp->derivation "php-fpm-test" test))
416
417(define %test-php-fpm
418 (system-test
419 (name "php-fpm")
420 (description "Test PHP-FPM through nginx.")
421 (value (run-php-fpm-test))))
422
423
424;;;
425;;; hpcguix-web
426;;;
427
428(define* (run-hpcguix-web-server-test name test-os)
429 "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
430 (define os
431 (marionette-operating-system
432 test-os
433 #:imported-modules '((gnu services herd)
434 (guix combinators))))
435
436 (define vm
437 (virtual-machine
438 (operating-system os)
439 (port-forwardings '((8080 . 5000)))
440 (memory-size 1024)))
441
442 (define test
443 (with-imported-modules '((gnu build marionette))
444 #~(begin
445 (use-modules (srfi srfi-11) (srfi srfi-64)
446 (ice-9 match)
447 (gnu build marionette)
448 (web uri)
449 (web client)
450 (web response))
451
452 (define marionette
453 (make-marionette (list #$vm)))
454
455 (test-runner-current (system-test-runner #$output))
456 (test-begin #$name)
457
458 (test-assert "hpcguix-web running"
459 (marionette-eval
460 '(begin
461 (use-modules (gnu services herd))
462 (match (start-service 'hpcguix-web)
463 (#f #f)
464 (('service response-parts ...)
465 (match (assq-ref response-parts 'running)
466 ((pid) pid)))))
467 marionette))
468
469 (test-equal "http-get"
470 200
471 (begin
472 (wait-for-tcp-port 5000 marionette)
473 (#$retry-on-error
474 (lambda ()
475 (let-values (((response text)
476 (http-get "http://localhost:8080")))
477 (response-code response)))
478 #:times 10
479 #:delay 5)))
480
481 (test-end))))
482
483 (gexp->derivation (string-append name "-test") test))
484
485(define %hpcguix-web-specs
486 ;; Server config gexp.
487 #~(hpcweb-configuration
488 (title-prefix "[TEST] HPCGUIX-WEB")))
489
490(define %hpcguix-web-os
491 (simple-operating-system
492 (service dhcpcd-service-type)
493 (service hpcguix-web-service-type
494 (hpcguix-web-configuration
495 (specs %hpcguix-web-specs)
496 (address "0.0.0.0")))))
497
498(define %test-hpcguix-web
499 (system-test
500 (name "hpcguix-web")
501 (description "Connect to a running hpcguix-web server.")
502 (value (run-hpcguix-web-server-test name %hpcguix-web-os))))
503
504
505;;;
506;;; Anonip
507;;;
508(define %anonip-os
509 ;; Operating system under test.
510 (simple-operating-system
511 (service anonip-service-type
512 (anonip-configuration
513 (input "/var/run/anonip/access.log")
514 (output "/var/log/anonip/access.log")
515 (debug? #t)))))
516
517(define (run-anonip-test)
518 (define os
519 (marionette-operating-system
520 %anonip-os
521 #:imported-modules '((gnu services herd)
522 (guix combinators))))
523
524 (define vm
525 (virtual-machine
526 (operating-system os)
527 ;; We are interested in verifying if anonip still launches following a
528 ;; reboot; thus make the base image writable.
529 (volatile? #f)))
530
531 (define test
532 (with-imported-modules '((gnu build marionette))
533 #~(begin
534 (use-modules (ice-9 match)
535 (srfi srfi-64)
536 (gnu build marionette))
537
538 (define marionette
539 (make-marionette (list #$vm)))
540
541 (test-runner-current (system-test-runner #$output))
542 (test-begin "anonip")
543
544 (test-assert "service is running"
545 (marionette-eval
546 '(begin
547 (use-modules (gnu services herd))
548 (wait-for-service 'anonip-/var/log/anonip/access.log))
549 marionette))
550
551 (test-assert "service can be restarted"
552 (marionette-eval
553 '(begin
554 (use-modules (gnu services herd))
555 (restart-service 'anonip-/var/log/anonip/access.log)
556 (wait-for-service 'anonip-/var/log/anonip/access.log))
557 marionette))
558
559 (test-assert "ip addresses are anonymized"
560 (marionette-eval
561 '(begin
562 (use-modules (ice-9 textual-ports))
563 (call-with-output-file "/var/run/anonip/access.log"
564 (lambda (port)
565 (display "192.168.100.200 - - \
566[30/Oct/2024:14:57:44 +0100] GET /xxx.narinfo HTTP/1.1\" 200 1065 \
567\"-\" \"GNU Guile\"\n" port)
568 (display "2001:0db8:85a3:0000:0000:8a2e:0370:7334 - - \
569[30/Oct/2024:14:57:44 +0100] \"GET /xxx.narinfo HTTP/1.1\" 200 1065 \
570\"-\" \"GNU Guile\"\n" port)))
571 (#$retry-on-error
572 (lambda ()
573 (call-with-input-file "/var/log/anonip/access.log"
574 (lambda (port)
575 (let ((content (get-string-all port)))
576 ;; The expected values are taken from anonip's test
577 ;; suite (see its test_module.py file).
578 (or (and (string-contains content "192.168.96.0")
579 (string-contains content "2001:db8:85a0::"))
580 (error "could not find expected anonymized IPs"
581 content))))))
582 #:times 20
583 #:delay 1))
584 marionette))
585
586 (test-assert "service is running after reboot"
587 (begin
588 (marionette-eval
589 '(begin
590 (use-modules (gnu services herd))
591 (eval-there '(begin
592 (use-modules (shepherd system))
593 (sync) ;ensure the log is fully written
594 (reboot))))
595 marionette)
596 ;; Note: a distinct marionette-eval call is needed here; if
597 ;; included in the previous one issuing the reboot,
598 ;; 'wait-for-service' would apparently run before the system had
599 ;; rebooted (and succeed), which would defeat the test.
600 (marionette-eval
601 '(begin
602 (use-modules (gnu services herd))
603 (wait-for-service 'anonip-/var/log/anonip/access.log))
604 marionette)))
605
606 (test-assert "service can be stopped"
607 (marionette-eval
608 '(begin
609 (use-modules (gnu services herd))
610 (stop-service 'anonip-/var/log/anonip/access.log))
611 marionette))
612
613 (test-end))))
614
615 (gexp->derivation "anonip-test" test))
616
617(define %test-anonip
618 (system-test
619 (name "anonip")
620 (description "Anonymize logs via Anonip")
621 (value (run-anonip-test))))
622
623
624;;;
625;;; go-webdav
626;;;
627
628(define %go-webdav-os
629 (simple-operating-system
630 (service dhcpcd-service-type)
631 (simple-service 'make-http-root activation-service-type
632 %make-http-root)
633 (service go-webdav-service-type
634 ;; run-webserver-test requires :8080 to be used as the port.
635 '("-addr" ":8080" "/srv/http/"))))
636
637(define %test-go-webdav
638 (system-test
639 (name "go-webdav")
640 (description "Test that go-webdav can handle HTTP requests.")
641 (value (run-webserver-test name %go-webdav-os))))
642
643
644;;;
645;;; gunicorn
646;;;
647
648(define %gunicorn-os
649 (simple-operating-system
650 (service dhcpcd-service-type)
651 (service gunicorn-service-type
652 (gunicorn-configuration
653 (apps
654 (list (gunicorn-app
655 (name "werkzeug")
656 (package python-werkzeug)
657 (wsgi-app-module "werkzeug.testapp:test_app")
658 (sockets (list "0.0.0.0:8080"))
659 (user "root")
660 (group "users"))))))))
661
662(define (run-gunicorn-test)
663 (define os
664 (marionette-operating-system
665 %gunicorn-os
666 #:imported-modules '((gnu services herd))))
667
668 (define forwarded-port 8080)
669
670 (define vm
671 (virtual-machine
672 (operating-system os)
673 (memory-size 1024)
674 (port-forwardings `((8080 . ,forwarded-port)))))
675
676 (define test
677 (with-imported-modules '((gnu build marionette))
678 #~(begin
679 (use-modules (srfi srfi-11) (srfi srfi-64)
680 (gnu build marionette)
681 (web uri)
682 (web client)
683 (web response))
684
685 (define marionette
686 (make-marionette (list #$vm)))
687
688 (test-runner-current (system-test-runner #$output))
689 (test-begin "gunicorn")
690
691 (test-assert "service is running"
692 (marionette-eval
693 '(begin
694 (use-modules (gnu services herd))
695 (match (start-service 'gunicorn-werkzeug)
696 (#f #f)
697 (('service response-parts ...)
698 (match (assq-ref response-parts 'running)
699 ((#t) #t)
700 ((pid) pid)))))
701 marionette))
702
703 (test-assert "HTTP port ready"
704 (wait-for-tcp-port #$forwarded-port marionette))
705
706 (test-assert "get index page"
707 (let-values
708 (((response text)
709 (http-get #$(simple-format
710 #f "http://localhost:~A/" forwarded-port)
711 #:decode-body? #t)))
712 (and (equal? (response-code response) 200)
713 (string-contains text "WSGI Information"))))
714
715 (test-end))))
716
717 (gexp->derivation "gunicorn-test" test))
718
719(define %test-gunicorn
720 (system-test
721 (name "gunicorn")
722 (description "Test that gunicorn can serve the Werkzeug testapp.")
723 (value (run-gunicorn-test))))
724
725
726;;;
727;;; Patchwork
728;;;
729
730(define (patchwork-initial-database-setup-service configuration)
731 (define start-gexp
732 #~(primitive-exit
733 (if (and
734 (zero?
735 (system* #$(file-append postgresql "/bin/createuser")
736 #$(patchwork-database-configuration-user
737 configuration)))
738 (zero?
739 (system* #$(file-append postgresql "/bin/createdb")
740 "-O"
741 #$(patchwork-database-configuration-user
742 configuration)
743 #$(patchwork-database-configuration-name
744 configuration))))
745 0
746 1)))
747
748 (shepherd-service
749 (requirement '(postgres))
750 (provision '(patchwork-postgresql-user-and-database))
751 (start #~(lambda _
752 (zero? (spawn-command
753 '(#$(program-file "patchwork-initial-database-setup"
754 start-gexp))
755 #:user "postgres"
756 #:group "postgres"))))
757 (stop #~(const #f))
758 (documentation "Setup patchwork database.")))
759
760(define (patchwork-os patchwork)
761 (simple-operating-system
762 (service dhcpcd-service-type)
763 (service httpd-service-type
764 (httpd-configuration
765 (config
766 (httpd-config-file
767 (listen '("8080"))))))
768 (service postgresql-service-type
769 (postgresql-configuration
770 (postgresql postgresql)))
771 (service patchwork-service-type
772 (patchwork-configuration
773 (patchwork patchwork)
774 (domain "localhost")
775 (settings-module
776 (patchwork-settings-module
777 (allowed-hosts (list domain))
778 (default-from-email "")))
779 (getmail-retriever-config
780 (getmail-retriever-configuration
781 (type "SimpleIMAPSSLRetriever")
782 (server "imap.example.com")
783 (port 993)
784 (username "username")
785 (password "password")
786 (extra-parameters
787 '((mailboxes . ("INBOX"))))))))
788 (simple-service 'patchwork-database-setup
789 shepherd-root-service-type
790 (list
791 (patchwork-initial-database-setup-service
792 (patchwork-database-configuration))))))
793
794(define (run-patchwork-test patchwork)
795 "Run tests in %NGINX-OS, which has nginx running and listening on
796HTTP-PORT."
797 (define os
798 (marionette-operating-system
799 (patchwork-os patchwork)
800 #:imported-modules '((gnu services herd)
801 (guix combinators))))
802
803 (define forwarded-port 8080)
804
805 (define vm
806 (virtual-machine
807 (operating-system os)
808 (port-forwardings `((8080 . ,forwarded-port)))
809 (memory-size 1024)))
810
811 (define test
812 (with-imported-modules '((gnu build marionette))
813 #~(begin
814 (use-modules (srfi srfi-11) (srfi srfi-64)
815 (ice-9 match)
816 (gnu build marionette)
817 (web uri)
818 (web client)
819 (web response))
820
821 (define marionette
822 (make-marionette (list #$vm)))
823
824 (test-runner-current (system-test-runner #$output))
825 (test-begin "patchwork")
826
827 (test-assert "patchwork-postgresql-user-and-service started"
828 (marionette-eval
829 '(begin
830 (use-modules (gnu services herd))
831 (match (start-service 'patchwork-postgresql-user-and-database)
832 (#f #f)
833 (('service response-parts ...)
834 (match (assq-ref response-parts 'running)
835 ((#t) #t)
836 ((pid) pid)))))
837 marionette))
838
839 (test-assert "patchwork-setup started"
840 (marionette-eval
841 '(begin
842 (use-modules (gnu services herd))
843 (match (start-service 'patchwork-setup)
844 (#f #f)
845 (('service response-parts ...)
846 (match (assq-ref response-parts 'running)
847 ((#t) #t)
848 ((pid) pid)))))
849 marionette))
850
851 (test-assert "httpd running"
852 (marionette-eval
853 '(begin
854 (use-modules (gnu services herd))
855 (start-service 'httpd))
856 marionette))
857
858 (test-equal "http-get"
859 200
860 (#$retry-on-error
861 (lambda ()
862 (let-values
863 (((response text)
864 (http-get #$(simple-format
865 #f "http://localhost:~A/" forwarded-port)
866 #:decode-body? #t)))
867 (response-code response)))
868 #:times 10
869 #:delay 5))
870
871 (test-end))))
872
873 (gexp->derivation "patchwork-test" test))
874
875(define %test-patchwork
876 (system-test
877 (name "patchwork")
878 (description "Connect to a running Patchwork service.")
879 (value (run-patchwork-test patchwork))))
880
881
882;;;
883;;; sogogi
884;;;
885
886(define %sogogi-os
887 (simple-operating-system
888 (service dhcpcd-service-type)
889 (simple-service 'make-http-root activation-service-type
890 %make-http-root)
891 (service sogogi-service-type
892 (sogogi-configuration
893 (listen ":8080")
894 (user
895 (list
896 (sogogi-user
897 (name "testuser")
898 (password "testpass"))))
899 (location
900 (list
901 (sogogi-location
902 (path "/")
903 (dir "/srv/http/")
904 (grant '("all ro" "user:testuser rw")))))))))
905
906(define %test-sogogi
907 (system-test
908 (name "sogogi")
909 (description "Test that the sogogi can handle HTTP requests.")
910 (value
911 (let ((http-port 8080))
912 (run-webserver-test name %sogogi-os
913 #:http-port http-port
914 #:extra-tests
915 #~(begin
916 (use-modules (srfi srfi-11) (srfi srfi-64)
917 (gnu build marionette)
918 (web uri)
919 (web client)
920 (web response))
921
922 (test-equal "unauthenticated delete"
923 401
924 (let-values
925 (((response _)
926 (http-delete #$(simple-format
927 #f "http://localhost:~A/index.html" http-port))))
928 (response-code response)))))))))
929
930
931;;;
932;;; Agate
933;;;
934
935(define %index.gmi-contents
936 ;; Contents of the /index.gmi file.
937 "Hello, guix!")
938
939(define %make-agate-root
940 ;; Create our server root in /srv.
941 #~(begin
942 (mkdir "/srv")
943 (mkdir "/srv/gemini")
944 (mkdir "/srv/gemini-certs")
945 ;; Directory should be writable for Agate user to generate certificates
946 (let ((user (getpw "agate")))
947 (chown "/srv/gemini-certs" (passwd:uid user) (passwd:gid user)))
948 (call-with-output-file (string-append "/srv/gemini/index.gmi")
949 (lambda (port)
950 (display #$%index.gmi-contents port)))))
951
952(define %agate-os
953 (simple-operating-system
954 (service dhcpcd-service-type)
955 (simple-service 'make-agate-root activation-service-type
956 %make-agate-root)
957 (service agate-service-type
958 (agate-configuration
959 (hostnames '("localhost"))))))
960
961(define* (run-agate-test name test-os expected-content)
962 (define os
963 (marionette-operating-system
964 test-os
965 #:imported-modules '((gnu services herd)
966 (guix combinators))
967 #:extensions (list guile-gemini guile-gnutls)))
968
969 (define forwarded-port 1965)
970
971 (define vm
972 (virtual-machine
973 (operating-system os)
974 (port-forwardings `((1965 . ,forwarded-port)))))
975
976 (define test
977 (with-imported-modules '((gnu build marionette))
978 #~(begin
979 (use-modules (srfi srfi-64)
980 (gnu build marionette))
981
982 (define marionette
983 (make-marionette (list #$vm)))
984
985 (test-runner-current (system-test-runner #$output))
986 (test-begin #$name)
987
988 (test-assert #$(string-append name " service running")
989 (marionette-eval
990 '(begin
991 (use-modules (gnu services herd))
992 (match (start-service '#$(string->symbol name))
993 (#f #f)
994 (('service response-parts ...)
995 (match (assq-ref response-parts 'running)
996 ((#t) #t)
997 ((pid) pid)))))
998 marionette))
999
1000 (test-assert "Agate TCP port ready, IPv4"
1001 (wait-for-tcp-port #$forwarded-port marionette))
1002
1003 (test-assert "Agate TCP port ready, IPv6"
1004 (wait-for-tcp-port #$forwarded-port marionette
1005 #:address
1006 '(make-socket-address
1007 AF_INET6 (inet-pton AF_INET6 "::1") #$forwarded-port)))
1008
1009 (test-equal "Agate responses with the specified index.gmi"
1010 #$expected-content
1011 (marionette-eval '(begin
1012 (use-modules (ice-9 iconv)
1013 (gemini client)
1014 (gemini request)
1015 (gemini response))
1016 (bytevector->string (gemini-response-body-bytes
1017 (send-gemini-request
1018 (build-gemini-request #:host "localhost" #:port #$forwarded-port)))
1019 "utf8")) marionette))
1020
1021 (test-end))))
1022 (gexp->derivation "agate-test" test))
1023
1024(define %test-agate
1025 (system-test
1026 (name "agate")
1027 (description "Connect to a running Agate service.")
1028 (value (run-agate-test name %agate-os %index.gmi-contents))))
1029
1030
1031;;;
1032;;; Miniflux
1033;;;
1034
1035(define %miniflux-create-admin-credentials
1036 #~(begin
1037 (mkdir "/var/miniflux")
1038 (call-with-output-file "/var/miniflux/admin-username"
1039 (lambda (port)
1040 (display "test" port)))
1041 (call-with-output-file "/var/miniflux/admin-password"
1042 (lambda (port)
1043 (display "testpassword" port)))))
1044
1045(define miniflux-base-system
1046 (lambda (miniflux-config)
1047 (simple-operating-system
1048 (simple-service 'create-admin-credentials
1049 activation-service-type
1050 %miniflux-create-admin-credentials)
1051 (service dhcpcd-service-type)
1052 (service postgresql-service-type
1053 (postgresql-configuration
1054 (postgresql postgresql)))
1055 (service miniflux-service-type
1056 miniflux-config))))
1057
1058(define %miniflux-with-admin-as-string
1059 (miniflux-base-system
1060 (miniflux-configuration
1061 (listen-address "0.0.0.0:8080")
1062 (create-administrator-account? #t)
1063 (administrator-account-name "test")
1064 (administrator-account-password "testpassword"))))
1065
1066(define %miniflux-with-admin-as-file
1067 (miniflux-base-system
1068 (miniflux-configuration
1069 (listen-address "0.0.0.0:8080")
1070 (create-administrator-account? #t)
1071 (administrator-account-name "/var/miniflux/admin-username")
1072 (administrator-account-password "/var/miniflux/admin-password"))))
1073
1074(define %miniflux-with-socket
1075 (miniflux-base-system
1076 (miniflux-configuration
1077 (listen-address "/var/run/miniflux/miniflux.sock"))))
1078
1079(define* (run-miniflux-test name test-os)
1080 (define os
1081 (marionette-operating-system
1082 test-os
1083 #:imported-modules '((gnu services herd)
1084 (guix combinators))))
1085
1086 (define forwarded-port 8080)
1087
1088 (define vm
1089 (virtual-machine
1090 (operating-system os)
1091 (memory-size 512)
1092 (port-forwardings `((8080 . ,forwarded-port)))))
1093
1094 (define test
1095 (with-extensions (list guile-gcrypt)
1096 (with-imported-modules '((gnu build marionette))
1097 #~(begin
1098 (use-modules (srfi srfi-64)
1099 (srfi srfi-11)
1100 (gnu build marionette)
1101 (web client)
1102 (web uri)
1103 (web response)
1104 (ice-9 match)
1105 (ice-9 iconv)
1106 (gcrypt base64))
1107
1108 (define marionette
1109 (make-marionette (list #$vm)))
1110
1111 (test-runner-current (system-test-runner #$output))
1112 (test-begin #$name)
1113
1114 (test-assert "Check Miniflux service is running"
1115 (begin
1116 (#$retry-on-error
1117 (lambda ()
1118 (marionette-eval
1119 '(begin
1120 (use-modules (gnu services herd))
1121 (match (start-service '#$(string->symbol "miniflux"))
1122 (#f #f)
1123 (('service response-parts ...)
1124 (match (assq-ref response-parts 'running)
1125 (#f #f)
1126 ((running) #t)))))
1127 marionette))
1128 #:delay 1
1129 #:times 10)))
1130
1131 (test-assert "Miniflux TCP port ready, IPv4"
1132 (wait-for-tcp-port #$forwarded-port marionette))
1133
1134 (test-assert "Miniflux login page is opened"
1135 (begin
1136 (wait-for-tcp-port #$forwarded-port marionette)
1137 (#$retry-on-error
1138 (lambda ()
1139 (let-values (((_ text)
1140 (http-get
1141 #$(format #f "http://localhost:~A/" forwarded-port)
1142 #:decode-body? #t)))
1143 (string-contains text "<title>Sign In - Miniflux</title>")))
1144 #:times 10
1145 #:delay 2)))
1146
1147 (define authorization-header
1148 (let ((encoded (base64-encode (string->bytevector "test:testpassword" "utf-8"))))
1149 `(authorization . (basic . ,encoded))))
1150
1151 (test-equal "Miniflux initial admin API call is successful"
1152 200
1153 (begin
1154 (wait-for-tcp-port #$forwarded-port marionette)
1155 (#$retry-on-error
1156 (lambda ()
1157 (let-values (((response _)
1158 (http-get #$(format #f "http://localhost:~A/v1/me" forwarded-port)
1159 #:headers (list authorization-header)
1160 #:decode-body? #t)))
1161
1162 (response-code response)))
1163 #:times 10
1164 #:delay 2)))
1165
1166 (test-assert "Miniflux configuration action returns an existing file path"
1167 (marionette-eval '(with-shepherd-action 'miniflux ('configuration)
1168 results
1169 (file-exists? (car results)))
1170 marionette))
1171
1172 (test-end)))))
1173 (gexp->derivation (string-append name "-test") test))
1174
1175(define* (run-miniflux-socket-test name test-os)
1176 (define os
1177 (marionette-operating-system
1178 test-os
1179 #:imported-modules '((gnu services herd)
1180 (guix combinators))))
1181
1182 (define vm
1183 (virtual-machine
1184 (operating-system os)
1185 (memory-size 512)))
1186
1187 (define test
1188 (with-imported-modules '((gnu build marionette))
1189 #~(begin
1190 (use-modules (srfi srfi-64)
1191 (gnu build marionette))
1192
1193 (define marionette
1194 (make-marionette (list #$vm)))
1195
1196 (test-runner-current (system-test-runner #$output))
1197 (test-begin #$name)
1198
1199 (test-assert "Check socket file is created"
1200 (wait-for-unix-socket "/var/run/miniflux/miniflux.sock" marionette))
1201
1202 (test-end))))
1203 (gexp->derivation (string-append name "-test") test))
1204
1205(define %test-miniflux-admin-string
1206 (system-test
1207 (name "miniflux-admin-string")
1208 (description "Run Miniflux with initial admin credentials as string.")
1209 (value (run-miniflux-test name %miniflux-with-admin-as-string))))
1210
1211(define %test-miniflux-admin-file
1212 (system-test
1213 (name "miniflux-admin-file")
1214 (description "Run Miniflux with initial admin credentials as file.")
1215 (value (run-miniflux-test name %miniflux-with-admin-as-file))))
1216
1217(define %test-miniflux-socket
1218 (system-test
1219 (name "miniflux-socket")
1220 (description "Run Miniflux on unix socket.")
1221 (value (run-miniflux-socket-test name %miniflux-with-socket))))