aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/base.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests/base.scm')
-rw-r--r--gnu/tests/base.scm468
1 files changed, 315 insertions, 153 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 4fe779802b..479403e5c1 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -22,10 +22,15 @@
#:use-module (gnu system grub)
#:use-module (gnu system file-systems)
#: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 mcron)
#:use-module (gnu services shepherd)
+ #:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
@@ -33,7 +38,8 @@
#:use-module (srfi srfi-1)
#:export (run-basic-test
%test-basic-os
- %test-mcron))
+ %test-mcron
+ %test-nss-mdns))
(define %simple-os
(operating-system
@@ -64,104 +70,123 @@
using COMMAND, a gexp that evaluates to a list of strings. Compare some
properties of running system to what's declared in OS, an <operating-system>."
(define test
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-1)
- (srfi srfi-26)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette #$command))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "basic")
-
- (test-assert "uname"
- (match (marionette-eval '(uname) marionette)
- (#("Linux" host-name version _ architecture)
- (and (string=? host-name
- #$(operating-system-host-name os))
- (string-prefix? #$(package-version
- (operating-system-kernel os))
- version)
- (string-prefix? architecture %host-type)))))
-
- (test-assert "shell and user commands"
- ;; Is everything in $PATH?
- (zero? (marionette-eval '(system "
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette #$command))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "mcron")
+
+ (test-assert "uname"
+ (match (marionette-eval '(uname) marionette)
+ (#("Linux" host-name version _ architecture)
+ (and (string=? host-name
+ #$(operating-system-host-name os))
+ (string-prefix? #$(package-version
+ (operating-system-kernel os))
+ version)
+ (string-prefix? architecture %host-type)))))
+
+ (test-assert "shell and user commands"
+ ;; Is everything in $PATH?
+ (zero? (marionette-eval '(system "
. /etc/profile
set -e -x
guix --version
ls --version
grep --version
info --version")
- marionette)))
-
- (test-assert "accounts"
- (let ((users (marionette-eval '(begin
- (use-modules (ice-9 match))
- (let loop ((result '()))
- (match (getpw)
- (#f (reverse result))
- (x (loop (cons x result))))))
- marionette)))
- (lset= string=?
- (map passwd:name users)
- (list
- #$@(map user-account-name
- (operating-system-user-accounts os))))))
-
- (test-assert "shepherd services"
- (let ((services (marionette-eval '(begin
- (use-modules (gnu services herd))
- (call-with-values current-services
- append))
- marionette)))
- (lset= eq?
- (pk 'services services)
- '(root #$@(operating-system-shepherd-service-names os)))))
-
- (test-equal "login on tty1"
- "root\n"
- (begin
- (marionette-control "sendkey ctrl-alt-f1" marionette)
- ;; Wait for the 'term-tty1' service to be running (using
- ;; 'start-service' is the simplest and most reliable way to do
- ;; that.)
+ marionette)))
+
+ (test-assert "accounts"
+ (let ((users (marionette-eval '(begin
+ (use-modules (ice-9 match))
+ (let loop ((result '()))
+ (match (getpw)
+ (#f (reverse result))
+ (x (loop (cons x result))))))
+ marionette)))
+ (lset= string=?
+ (map passwd:name users)
+ (list
+ #$@(map user-account-name
+ (operating-system-user-accounts os))))))
+
+ (test-assert "shepherd services"
+ (let ((services (marionette-eval '(begin
+ (use-modules (gnu services herd))
+ (call-with-values current-services
+ append))
+ marionette)))
+ (lset= eq?
+ (pk 'services services)
+ '(root #$@(operating-system-shepherd-service-names os)))))
+
+ (test-equal "login on tty1"
+ "root\n"
+ (begin
+ (marionette-control "sendkey ctrl-alt-f1" marionette)
+ ;; Wait for the 'term-tty1' service to be running (using
+ ;; 'start-service' is the simplest and most reliable way to do
+ ;; that.)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'term-tty1))
+ marionette)
+
+ ;; Now we can type.
+ (marionette-type "root\n\nid -un > logged-in\n" marionette)
+
+ ;; It can take a while before the shell commands are executed.
+ (let loop ((i 0))
+ (unless (or (file-exists? "/root/logged-in") (> i 15))
+ (sleep 1)
+ (loop (+ i 1))))
+ (marionette-eval '(use-modules (rnrs io ports)) marionette)
+ (marionette-eval '(call-with-input-file "/root/logged-in"
+ get-string-all)
+ marionette)))
+
+ (test-assert "host name resolution"
+ (match (marionette-eval
+ '(begin
+ ;; Wait for nscd or our requests go through it.
+ (use-modules (gnu services herd))
+ (start-service 'nscd)
+
+ (list (getaddrinfo "localhost")
+ (getaddrinfo #$(operating-system-host-name os))))
+ marionette)
+ ((((? vector?) ..1) ((? vector?) ..1))
+ #t)
+ (x
+ (pk 'failure x #f))))
+
+ (test-equal "host not found"
+ #f
(marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'term-tty1))
- marionette)
-
- ;; Now we can type.
- (marionette-type "root\n\nid -un > logged-in\n" marionette)
-
- ;; It can take a while before the shell commands are executed.
- (let loop ((i 0))
- (unless (or (file-exists? "/root/logged-in") (> i 15))
- (sleep 1)
- (loop (+ i 1))))
- (marionette-eval '(use-modules (rnrs io ports)) marionette)
- (marionette-eval '(call-with-input-file "/root/logged-in"
- get-string-all)
- marionette)))
-
- (test-assert "screendump"
- (begin
- (marionette-control (string-append "screendump " #$output
- "/tty1.ppm")
- marionette)
- (file-exists? "tty1.ppm")))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
- (gexp->derivation name test
- #:modules '((gnu build marionette))))
+ '(false-if-exception (getaddrinfo "does-not-exist"))
+ marionette))
+
+ (test-assert "screendump"
+ (begin
+ (marionette-control (string-append "screendump " #$output
+ "/tty1.ppm")
+ marionette)
+ (file-exists? "tty1.ppm")))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %test-basic-os
(system-test
@@ -216,70 +241,207 @@ functionality tests.")
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define test
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$command)))
-
- (define (wait-for-file file)
- ;; Wait until FILE exists in the guest; 'read' its content and
- ;; return it.
- (marionette-eval
- `(let loop ((i 10))
- (cond ((file-exists? ,file)
- (call-with-input-file ,file read))
- ((> i 0)
- (sleep 1)
- (loop (- i 1)))
- (else
- (error "file didn't show up" ,file))))
- marionette))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "mcron")
-
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'mcron)
- 'running!)
- marionette))
-
- ;; Make sure root's mcron job runs, has its cwd set to "/root", and
- ;; runs with the right UID/GID.
- (test-equal "root's job"
- '(0 0)
- (wait-for-file "/root/witness"))
-
- ;; Likewise for Alice's job. We cannot know what its GID is since
- ;; it's chosen by 'groupadd', but it's strictly positive.
- (test-assert "alice's job"
- (match (wait-for-file "/home/alice/witness")
- ((1000 gid)
- (>= gid 100))))
-
- ;; Last, the job that uses a command; allows us to test whether
- ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
- ;; that don't have a read syntax, hence the string.)
- (test-equal "root's job with command"
- "#<eof>"
- (wait-for-file "/root/witness-touch"))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
- (gexp->derivation name test
- #:modules '((gnu build marionette)))))
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$command)))
+
+ (define (wait-for-file file)
+ ;; Wait until FILE exists in the guest; 'read' its content and
+ ;; return it.
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ (call-with-input-file ,file read))
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" ,file))))
+ marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "mcron")
+
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mcron)
+ 'running!)
+ marionette))
+
+ ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+ ;; runs with the right UID/GID.
+ (test-equal "root's job"
+ '(0 0)
+ (wait-for-file "/root/witness"))
+
+ ;; Likewise for Alice's job. We cannot know what its GID is since
+ ;; it's chosen by 'groupadd', but it's strictly positive.
+ (test-assert "alice's job"
+ (match (wait-for-file "/home/alice/witness")
+ ((1000 gid)
+ (>= gid 100))))
+
+ ;; Last, the job that uses a command; allows us to test whether
+ ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
+ ;; that don't have a read syntax, hence the string.)
+ (test-equal "root's job with command"
+ "#<eof>"
+ (wait-for-file "/root/witness-touch"))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test)))
(define %test-mcron
(system-test
(name "mcron")
(description "Make sure the mcron service works as advertised.")
(value (run-mcron-test name))))
+
+
+;;;
+;;; Avahi and NSS-mDNS.
+;;;
+
+(define %avahi-os
+ (operating-system
+ (inherit %simple-os)
+ (name-service-switch %mdns-host-lookup-nss)
+ (services (cons* (avahi-service #:debug? #t)
+ (dbus-service)
+ (dhcp-client-service) ;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
+ =>
+ (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.
+ (mlet* %store-monad ((os -> (marionette-operating-system
+ %avahi-os
+ #:requirements '(nscd)
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (run (system-qemu-image/shared-store-script
+ os #:graphic? #f)))
+ (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 #$run)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "avahi")
+
+ (test-assert "wait for services"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ (start-service 'nscd)
+
+ ;; 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~%"))
+ (lambda args
+ (format #t "waiting for nscd...~%")
+ (usleep 500000)
+ (try)))))
+
+ ;; Wait for the other useful things.
+ (start-service 'avahi-daemon)
+ (start-service 'networking)
+
+ #t)
+ 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* "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)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (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))))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-05 00:53:06 +0000