Package: guix-patches;
Reported by: Rodion Goritskov <rodion.goritskov <at> gmail.com>
Date: Sun, 11 Aug 2024 14:34:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Rodion Goritskov <rodion.goritskov <at> gmail.com> To: 72577 <at> debbugs.gnu.org Cc: Rodion Goritskov <rodion.goritskov <at> gmail.com>, Florian Pelz <pelzflorian <at> pelzflorian.de>, Ludovic Courtès <ludo <at> gnu.org>, Matthew Trzcinski <matt <at> excalamus.com>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [bug#72577] [PATCH 1/1] services: agate: Change variable names and add system test. Date: Sun, 11 Aug 2024 18:40:59 +0400
* doc/guix.texi (Web Services): Update documentation for agate-service-type.
* gnu/services/web.scm (agate-configuration): Rename certs, addr, lang and
central-conf variables.
* gnu/tests/web.scm (%test-agate): Add system test for agate-service-type.
Change-Id: Ie14814fca1d5158acd67899da0c3fc2c5b586c72
---
doc/guix.texi | 8 ++--
gnu/services/web.scm | 38 ++++++++--------
gnu/tests/web.scm | 105 ++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 127 insertions(+), 24 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 6e03d8bbcc..271219c4db 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32992,10 +32992,10 @@ Web Services
@item @code{content} (default: @file{"/srv/gemini"})
The directory from which Agate will serve files.
-@item @code{certs} (default: @file{"/srv/gemini-certs"})
+@item @code{certificates} (default: @file{"/srv/gemini-certs"})
Root of the certificate directory. Must be filled in with a value from the user.
-@item @code{addr} (default: @code{'("0.0.0.0:1965" "[::]:1965")})
+@item @code{addresses} (default: @code{'("[::]:1965" "0.0.0.0:1965")})
A list of the addresses to listen on.
@item @code{hostnames} (default: @code{'()})
@@ -33003,7 +33003,7 @@ Web Services
specified, corresponding directory names should be present in the @code{content}
directory. Optional.
-@item @code{lang} (default: @code{#f})
+@item @code{languages} (default: @code{#f})
RFC 4646 language code(s) for text/gemini documents. Optional.
@item @code{only-tls13?} (default: @code{#f})
@@ -33013,7 +33013,7 @@ Web Services
Set to @code{#t} to serve secret files (files/directories starting with
a dot).
-@item @code{central-conf?} (default: @code{#f})
+@item @code{central-configuration?} (default: @code{#f})
Set to @code{#t} to look for the .meta configuration file in the @code{content}
root directory and will ignore @code{.meta} files in other directories
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index e8ddb1d987..7adb416c39 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -2186,20 +2186,20 @@ (define-record-type* <agate-configuration>
(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-certificatess
+ (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 @@ (define-record-type* <agate-configuration>
(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 @@ (define agate-shepherd-service
#~(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 @@ (define-module (gnu tests web)
#: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 @@ (define-module (gnu tests web)
%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 @@ (define %test-patchwork
(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))))
--
2.45.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.