diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/web.scm | 38 | ||||
| -rw-r--r-- | gnu/tests/web.scm | 105 |
2 files changed, 123 insertions, 20 deletions
diff --git a/gnu/services/web.scm b/gnu/services/web.scm index e8ddb1d987..cc6f4e6d9b 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -2186,20 +2186,20 @@ root=/srv/gemini (default agate)) (content agate-configuration-content (default "/srv/gemini")) - (certs agate-configuration-certs - (default "/srv/gemini-certs")) - (addr agate-configuration-addr - (default '("0.0.0.0:1965" "[::]:1965"))) - (hostname agate-configuration-hostname - (default '())) - (lang agate-configuration-lang - (default #f)) + (certificates agate-configuration-certificates + (default "/srv/gemini-certs")) + (addresses agate-configuration-addresses + (default '("[::]:1965" "0.0.0.0:1965"))) + (hostnames agate-configuration-hostnames + (default '())) + (languages agate-configuration-languages + (default #f)) (only-tls13? agate-configuration-only-tls13 (default #f)) (serve-secret? agate-configuration-serve-secret (default #f)) - (central-conf? agate-configuration-central-conf - (default #f)) + (central-configuration? agate-configuration-central-configuration + (default #f)) (ed25519? agate-configuration-ed25519 (default #f)) (skip-port-check? agate-configuration-skip-port-check @@ -2215,9 +2215,9 @@ root=/srv/gemini (define agate-shepherd-service (match-lambda - (($ <agate-configuration> package content certs addr - hostname lang only-tls13? - serve-secret? central-conf? + (($ <agate-configuration> package content certificates addresses + hostnames languages only-tls13? + serve-secret? central-configuration? ed25519? skip-port-check? log-ip? user group log-file) (list (shepherd-service @@ -2228,19 +2228,19 @@ root=/srv/gemini #~(make-forkexec-constructor (list #$agate "--content" #$content - "--certs" #$certs + "--certs" #$certificates #$@(append-map (lambda x (append '("--addr") x)) - addr) + addresses) #$@(append-map (lambda x (append '("--hostname") x)) - hostname) - #$@(if lang - (list "--lang" lang) + hostnames) + #$@(if languages + (list "--lang" languages) '()) #$@(if serve-secret? '("--serve-secret") '()) #$@(if only-tls13? '("--only-tls13") '()) - #$@(if central-conf? '("--central-conf") '()) + #$@(if central-configuration? '("--central-conf") '()) #$@(if ed25519? '("--ed25519") '()) #$@(if skip-port-check? '("--skip-port-check") '()) #$@(if log-ip? '("--log-ip") '())) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 16dc6bea49..a071e05e1d 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -34,8 +34,10 @@ #:use-module (gnu services shepherd) #:use-module (gnu services mail) #:use-module (gnu packages databases) + #:use-module (gnu packages guile-xyz) #:use-module (gnu packages patchutils) #:use-module (gnu packages python) + #:use-module (gnu packages tls) #:use-module (gnu packages web) #:use-module (guix packages) #:use-module (guix modules) @@ -50,7 +52,8 @@ %test-php-fpm %test-hpcguix-web %test-tailon - %test-patchwork)) + %test-patchwork + %test-agate)) (define %index.html-contents ;; Contents of the /index.html file. @@ -657,3 +660,103 @@ HTTP-PORT." (name "patchwork") (description "Connect to a running Patchwork service.") (value (run-patchwork-test patchwork)))) + + +;;; +;;; Agate +;;; + +(define %index.gmi-contents + ;; Contents of the /index.gmi file. + "Hello, guix!") + +(define %make-agate-root + ;; Create our server root in /srv. + #~(begin + (mkdir "/srv") + (mkdir "/srv/gemini") + (mkdir "/srv/gemini-certs") + ;; Directory should be writable for Agate user to generate certificates + (let ((user (getpw "agate"))) + (chown "/srv/gemini-certs" (passwd:uid user) (passwd:gid user))) + (call-with-output-file (string-append "/srv/gemini/index.gmi") + (lambda (port) + (display #$%index.gmi-contents port))))) + +(define %agate-os + (simple-operating-system + (service dhcp-client-service-type) + (simple-service 'make-agate-root activation-service-type + %make-agate-root) + (service agate-service-type + (agate-configuration + (hostnames '("localhost")))))) + +(define* (run-agate-test name test-os expected-content) + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd) + (guix combinators)) + #:extensions (list guile-gemini guile-gnutls))) + + (define forwarded-port 1965) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((1965 . ,forwarded-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-64) + (gnu build marionette)) + + (define marionette + (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin #$name) + + (test-assert #$(string-append name " service running") + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service '#$(string->symbol name)) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((#t) #t) + ((pid) (number? pid)))))) + marionette)) + + (test-assert "Agate TCP port ready, IPv4" + (wait-for-tcp-port #$forwarded-port marionette)) + + (test-assert "Agate TCP port ready, IPv6" + (wait-for-tcp-port #$forwarded-port marionette + #:address + '(make-socket-address + AF_INET6 (inet-pton AF_INET6 "::1") #$forwarded-port))) + + (test-equal "Agate responses with the specified index.gmi" + #$expected-content + (marionette-eval '(begin + (use-modules (ice-9 iconv) + (gemini client) + (gemini request) + (gemini response)) + (bytevector->string (gemini-response-body-bytes + (send-gemini-request + (build-gemini-request #:host "localhost" #:port #$forwarded-port))) + "utf8")) marionette)) + + (test-end)))) + (gexp->derivation "agate-test" test)) + +(define %test-agate + (system-test + (name "agate") + (description "Connect to a running Agate service.") + (value (run-agate-test name %agate-os %index.gmi-contents)))) |