Subject: [PATCH 2/5] tests: Move Avahi test to its own file.

From: Ludovic Courtès <[email-masked]>
Date: Fri, 28 Feb 2025 11:04:29 +0100

This mirrors the (gnu services avahi) module.

* gnu/tests/base.scm (%avahi-os, run-nss-mdns-test, %test-nss-mdns):
Move to…
* gnu/tests/avahi.scm: … here.  New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: I04705e57408619d948c928873c40c470aa4e949d
---
 gnu/local.mk        |   1 +
 gnu/tests/avahi.scm | 183 ++++++++++++++++++++++++++++++++++++++++++++
 gnu/tests/base.scm  | 156 -------------------------------------
 3 files changed, 184 insertions(+), 156 deletions(-)
 create mode 100644 gnu/tests/avahi.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 4b31f8a4a0b..d923afd633e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -838,6 +838,7 @@ GNU_SYSTEM_MODULES =				\
 						\
   %D%/tests.scm					\
   %D%/tests/audio.scm				\
+  %D%/tests/avahi.scm				\
   %D%/tests/base.scm				\
   %D%/tests/cachefilesd.scm			\
   %D%/tests/ci.scm				\
diff --git a/gnu/tests/avahi.scm b/gnu/tests/avahi.scm
new file mode 100644
index 00000000000..261ec8a7312
--- /dev/null
+++ b/gnu/tests/avahi.scm
@@ -0,0 +1,183 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016-2020, 2022, 2024 Ludovic Courtès <[email-masked]>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests avahi)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system nss)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services avahi)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:export (%test-nss-mdns))
+
+;;;
+;;; Avahi and NSS-mDNS.
+;;;
+
+(define %avahi-os
+  (operating-system
+    (inherit (simple-operating-system))
+    (name-service-switch %mdns-host-lookup-nss)
+    (services (cons* (service avahi-service-type
+                              (avahi-configuration (debug? #t)))
+                     (service dbus-root-service-type)
+                     (service dhcp-client-service-type) ;needed for multicast
+
+                     ;; Enable heavyweight debugging output.
+                     (modify-services (operating-system-user-services
+                                       %simple-os)
+                       (nscd-service-type config
+                                          => (nscd-configuration
+                                              (inherit config)
+                                              (debug-level 3)
+                                              (log-file "/dev/console")))
+                       (syslog-service-type config
+                                            =>
+                                            (syslog-configuration
+                                             (inherit config)
+                                             (config-file
+                                              (plain-file
+                                               "syslog.conf"
+                                               "*.* /dev/console\n")))))))))
+
+(define (run-nss-mdns-test)
+  ;; Test resolution of '.local' names via libc.  Start the marionette service
+  ;; *after* nscd.  Failing to do that, libc will try to connect to nscd,
+  ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
+  ;; leading to '.local' resolution failures.
+  (define os
+    (marionette-operating-system
+     %avahi-os
+     #:requirements '(nscd)
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define mdns-host-name
+    (string-append (operating-system-host-name os)
+                   ".local"))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-runner-current (system-test-runner))
+          (test-begin "avahi")
+
+          (test-assert "nscd PID file is created"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'nscd))
+             marionette))
+
+          (test-assert "nscd is listening on its socket"
+            (marionette-eval
+             ;; XXX: Work around a race condition in nscd: nscd creates its
+             ;; PID file before it is listening on its socket.
+             '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+                (let try ()
+                  (catch 'system-error
+                    (lambda ()
+                      (connect sock AF_UNIX "/var/run/nscd/socket")
+                      (close-port sock)
+                      (format #t "nscd is ready~%")
+                      #t)
+                    (lambda args
+                      (format #t "waiting for nscd...~%")
+                      (usleep 500000)
+                      (try)))))
+             marionette))
+
+          (test-assert "avahi is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'avahi-daemon))
+             marionette))
+
+          (test-assert "network is up"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'networking))
+             marionette))
+
+          (test-equal "avahi-resolve-host-name"
+            0
+            (marionette-eval
+             '(system*
+               "/run/current-system/profile/bin/avahi-resolve-host-name"
+               "-v" #$mdns-host-name)
+             marionette))
+
+          (test-equal "avahi-browse"
+            0
+            (marionette-eval
+             '(system* "/run/current-system/profile/bin/avahi-browse" "-avt")
+             marionette))
+
+          (test-assert "getaddrinfo .local"
+            ;; Wait for the 'avahi-daemon' service and perform a resolution.
+            (match (marionette-eval
+                    '(getaddrinfo #$mdns-host-name)
+                    marionette)
+              (((? vector? addrinfos) ..1)
+               (pk 'getaddrinfo addrinfos)
+               (and (any (lambda (ai)
+                           (= AF_INET (addrinfo:fam ai)))
+                         addrinfos)
+                    (any (lambda (ai)
+                           (= AF_INET6 (addrinfo:fam ai)))
+                         addrinfos)))))
+
+          (test-assert "gethostbyname .local"
+            (match (pk 'gethostbyname
+                       (marionette-eval '(gethostbyname #$mdns-host-name)
+                                        marionette))
+              ((? vector? result)
+               (and (string=? (hostent:name result) #$mdns-host-name)
+                    (= (hostent:addrtype result) AF_INET)))))
+
+
+          (test-end))))
+
+  (gexp->derivation "nss-mdns" test))
+
+(define %test-nss-mdns
+  (system-test
+   (name "nss-mdns")
+   (description
+    "Test Avahi's multicast-DNS implementation, and in particular, test its
+glibc name service switch (NSS) module.")
+   (value (run-nss-mdns-test))))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index c3040002d37..89e797259dc 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -27,12 +27,9 @@ (define-module (gnu tests base)
   #:autoload   (gnu system image) (system-image)
   #:use-module (gnu system privilege)
   #:use-module (gnu system shadow)
-  #:use-module (gnu system nss)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
-  #:use-module (gnu services dbus)
-  #:use-module (gnu services avahi)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services networking)
   #:use-module (gnu packages base)
@@ -59,7 +56,6 @@ (define-module (gnu tests base)
             %test-halt
             %test-root-unmount
             %test-cleanup
-            %test-nss-mdns
             %test-activation))
 
 (define %simple-os
@@ -870,158 +866,6 @@ (define %test-cleanup
 non-ASCII names from /tmp.")
    (value (run-cleanup-test name))))
 
-
-;;;
-;;; Avahi and NSS-mDNS.
-;;;
-
-(define %avahi-os
-  (operating-system
-    (inherit %simple-os)
-    (name-service-switch %mdns-host-lookup-nss)
-    (services (cons* (service avahi-service-type
-                              (avahi-configuration (debug? #t)))
-                     (service dbus-root-service-type)
-                     (service dhcp-client-service-type) ;needed for multicast
-
-                     ;; Enable heavyweight debugging output.
-                     (modify-services (operating-system-user-services
-                                       %simple-os)
-                       (nscd-service-type config
-                                          => (nscd-configuration
-                                              (inherit config)
-                                              (debug-level 3)
-                                              (log-file "/dev/console")))
-                       (syslog-service-type config
-                                            =>
-                                            (syslog-configuration
-                                             (inherit config)
-                                             (config-file
-                                              (plain-file
-                                               "syslog.conf"
-                                               "*.* /dev/console\n")))))))))
-
-(define (run-nss-mdns-test)
-  ;; Test resolution of '.local' names via libc.  Start the marionette service
-  ;; *after* nscd.  Failing to do that, libc will try to connect to nscd,
-  ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
-  ;; leading to '.local' resolution failures.
-  (define os
-    (marionette-operating-system
-     %avahi-os
-     #:requirements '(nscd)
-     #:imported-modules '((gnu services herd)
-                          (guix combinators))))
-
-  (define mdns-host-name
-    (string-append (operating-system-host-name os)
-                   ".local"))
-
-  (define test
-    (with-imported-modules '((gnu build marionette))
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (srfi srfi-1)
-                       (srfi srfi-64)
-                       (ice-9 match))
-
-          (define marionette
-            (make-marionette (list #$(virtual-machine os))))
-
-          (mkdir #$output)
-          (chdir #$output)
-
-          (test-runner-current (system-test-runner))
-          (test-begin "avahi")
-
-          (test-assert "nscd PID file is created"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'nscd))
-             marionette))
-
-          (test-assert "nscd is listening on its socket"
-            (marionette-eval
-             ;; XXX: Work around a race condition in nscd: nscd creates its
-             ;; PID file before it is listening on its socket.
-             '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
-                (let try ()
-                  (catch 'system-error
-                    (lambda ()
-                      (connect sock AF_UNIX "/var/run/nscd/socket")
-                      (close-port sock)
-                      (format #t "nscd is ready~%")
-                      #t)
-                    (lambda args
-                      (format #t "waiting for nscd...~%")
-                      (usleep 500000)
-                      (try)))))
-             marionette))
-
-          (test-assert "avahi is running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'avahi-daemon))
-             marionette))
-
-          (test-assert "network is up"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'networking))
-             marionette))
-
-          (test-equal "avahi-resolve-host-name"
-            0
-            (marionette-eval
-             '(system*
-               "/run/current-system/profile/bin/avahi-resolve-host-name"
-               "-v" #$mdns-host-name)
-             marionette))
-
-          (test-equal "avahi-browse"
-            0
-            (marionette-eval
-             '(system* "/run/current-system/profile/bin/avahi-browse" "-avt")
-             marionette))
-
-          (test-assert "getaddrinfo .local"
-            ;; Wait for the 'avahi-daemon' service and perform a resolution.
-            (match (marionette-eval
-                    '(getaddrinfo #$mdns-host-name)
-                    marionette)
-              (((? vector? addrinfos) ..1)
-               (pk 'getaddrinfo addrinfos)
-               (and (any (lambda (ai)
-                           (= AF_INET (addrinfo:fam ai)))
-                         addrinfos)
-                    (any (lambda (ai)
-                           (= AF_INET6 (addrinfo:fam ai)))
-                         addrinfos)))))
-
-          (test-assert "gethostbyname .local"
-            (match (pk 'gethostbyname
-                       (marionette-eval '(gethostbyname #$mdns-host-name)
-                                        marionette))
-              ((? vector? result)
-               (and (string=? (hostent:name result) #$mdns-host-name)
-                    (= (hostent:addrtype result) AF_INET)))))
-
-
-          (test-end))))
-
-  (gexp->derivation "nss-mdns" test))
-
-(define %test-nss-mdns
-  (system-test
-   (name "nss-mdns")
-   (description
-    "Test Avahi's multicast-DNS implementation, and in particular, test its
-glibc name service switch (NSS) module.")
-   (value (run-nss-mdns-test))))
-
 
 ;;;
 ;;; Activation: Order of activation scripts
-- 
2.48.1