Subject: [bug#72577] [PATCH v2] services: agate: Change variable names and add system test.

From: Rodion Goritskov <[email-masked]>
Date: Mon, 12 Aug 2024 09:31:14 +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        |  10 ++---
 gnu/services/web.scm |  38 ++++++++--------
 gnu/tests/web.scm    | 105 ++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 128 insertions(+), 25 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 6e03d8bbcc..8acba533c2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32955,7 +32955,7 @@ Web Services
 (service agate-service-type
 	 (agate-configuration
 	   (content "/srv/gemini")
-	   (certs "/srv/gemini-certs")))
+	   (certificates "/srv/gemini-certs")))
 @end lisp
 
 The example above represents the minimal tweaking necessary to get Agate
@@ -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..cc6f4e6d9b 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-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 @@ (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))))

base-commit: 174ecf5b1077d29498d9de22e27b13047f314feb
-- 
2.45.2