diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/databases.scm | 15 | ||||
| -rw-r--r-- | gnu/tests/docker.scm | 8 | ||||
| -rw-r--r-- | gnu/tests/install.scm | 3 | ||||
| -rw-r--r-- | gnu/tests/mail.scm | 8 | ||||
| -rw-r--r-- | gnu/tests/monitoring.scm | 14 | ||||
| -rw-r--r-- | gnu/tests/pam.scm | 6 | ||||
| -rw-r--r-- | gnu/tests/reconfigure.scm | 13 | ||||
| -rw-r--r-- | gnu/tests/security-token.scm | 4 | ||||
| -rw-r--r-- | gnu/tests/telephony.scm | 418 |
9 files changed, 267 insertions, 222 deletions
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm index 92be1a829b..7c8b87942f 100644 --- a/gnu/tests/databases.scm +++ b/gnu/tests/databases.scm @@ -196,7 +196,9 @@ (marionette-eval '(begin (use-modules (ice-9 ftw) - (ice-9 match)) + (ice-9 match) + (rnrs io ports)) + (current-output-port (open-file "/dev/console" "w0")) (let ((server-log-file @@ -317,6 +319,8 @@ (begin (marionette-eval '(begin + (use-modules (rnrs io ports)) + (let loop ((i 10)) (unless (or (zero? i) (and (file-exists? #$%role-log-file) @@ -331,8 +335,9 @@ (test-assert "database creation" (marionette-eval '(begin - (current-output-port - (open-file "/dev/console" "w0")) + (use-modules (guix build utils)) + + (current-output-port (open-file "/dev/console" "w0")) (invoke #$(file-append postgresql "/bin/psql") "-tA" "-c" "CREATE DATABASE test")) marionette)) @@ -466,7 +471,9 @@ data double PRECISION NULL "awesome\n" (marionette-eval '(begin - (use-modules (ice-9 popen)) + (use-modules (ice-9 popen) + (rnrs io ports)) + (let* ((port (open-pipe* OPEN_READ #$(file-append mariadb "/bin/mysql") "guix" diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 0276e398a7..c084ac53ee 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> -;;; Copyright © 2019-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019-2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -108,6 +108,9 @@ inside %DOCKER-OS." '("hello world" "hi!" "JSON!" #o1777) (marionette-eval `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + (define slurp (lambda args (let* ((port (apply open-pipe* OPEN_READ args)) @@ -242,6 +245,9 @@ inside %DOCKER-OS." (test-assert "load system image and run it" (marionette-eval `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + (define (slurp command . args) ;; Return the output from COMMAND. (let* ((port (apply open-pipe* OPEN_READ command args)) diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 57e9df4421..0f4204d1a6 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -1733,7 +1733,8 @@ build (current-guix) and then store a couple of full system images.") (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) - (marionette-eval* '(use-modules (gnu installer tests)) + (marionette-eval* '(use-modules (gnu installer tests) + (guix build utils)) #$marionette) ;; Arrange so that 'converse' prints debugging output to the console. diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index dc1f18b3f1..dcb8f08ea8 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -382,7 +382,9 @@ Subject: Hello Nice to meet you!") (marionette-eval '(begin (use-modules (ice-9 ftw) - (ice-9 match)) + (ice-9 match) + (rnrs io ports)) + (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) (match (scandir TESTBOX/new) (("." ".." message-file) @@ -556,7 +558,9 @@ Subject: Hello Nice to meet you!") (marionette-eval '(begin (use-modules (ice-9 ftw) - (ice-9 match)) + (ice-9 match) + (rnrs io ports)) + (let ((TESTBOX/new "/home/alice/TestMaildir/new/")) (match (scandir TESTBOX/new) (("." ".." message-file) diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index ae0a8e0845..bbab1d8acf 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -208,11 +208,15 @@ postgres|Superuser, Create role, Create DB, Replication, Bypass RLS|{} zabbix||{} " (marionette-eval - '(begin (let* ((port (open-pipe #$%psql-db-zabbix-create-script - OPEN_READ)) - (output (read-string port)) - (status (close-pipe port))) - output)) + '(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (let* ((port (open-pipe #$%psql-db-zabbix-create-script + OPEN_READ)) + (output (read-string port)) + (status (close-pipe port))) + output)) marionette)) (test-eq "postgres create zabbix db" diff --git a/gnu/tests/pam.scm b/gnu/tests/pam.scm index 5cf13d97d7..1654396e42 100644 --- a/gnu/tests/pam.scm +++ b/gnu/tests/pam.scm @@ -70,8 +70,10 @@ #$(string-join (map pam-limits-entry->string pam-limit-entries) "\n" 'suffix) (marionette-eval - '(call-with-input-file "/etc/security/limits.conf" - get-string-all) + '(begin + (use-modules (rnrs io ports)) + (call-with-input-file "/etc/security/limits.conf" + get-string-all)) marionette)) (test-end))))) diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index ec845fe4b0..00514e7020 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -104,10 +104,11 @@ generation of the system profile." (test-assert "script activated user accounts" (marionette-eval - '(string-contains (call-with-input-file "/etc/passwd" - (lambda (port) - (get-string-all port))) - "jakob") + '(begin + (use-modules (rnrs io ports)) + (string-contains (call-with-input-file "/etc/passwd" + get-string-all) + "jakob")) marionette))) (test-end)))) @@ -208,9 +209,9 @@ bootloader's configuration file." (define (generations-in-grub-cfg marionette) (let ((grub-cfg (marionette-eval '(begin + (use-modules (rnrs io ports)) (call-with-input-file "/boot/grub/grub.cfg" - (lambda (port) - (get-string-all port)))) + get-string-all)) marionette))) (map (lambda (parameter) (second (string-split (match:substring parameter) #\=))) diff --git a/gnu/tests/security-token.scm b/gnu/tests/security-token.scm index 07270c0bfd..d30b9e4d69 100644 --- a/gnu/tests/security-token.scm +++ b/gnu/tests/security-token.scm @@ -50,7 +50,9 @@ (test-assert "pcscd is alive" (marionette-eval '(begin - (use-modules (gnu services herd)) + (use-modules (gnu services herd) + (srfi srfi-1)) + (live-service-running (find (lambda (live) (memq 'pcscd (live-service-provision live))) diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm index 28a466ff67..5828784d27 100644 --- a/gnu/tests/telephony.scm +++ b/gnu/tests/telephony.scm @@ -138,7 +138,9 @@ jami account used as part of the jami configuration are left *unspecified*." %jami-os-provisioning) %jami-os) #:imported-modules '((gnu services herd) - (guix combinators)))) + (guix combinators) + (gnu build jami-service) + (gnu build dbus-service)))) (define vm (virtual-machine (operating-system os) (memory-size 512))) @@ -147,212 +149,228 @@ jami account used as part of the jami configuration are left *unspecified*." "Account.username")) (define test - (with-extensions (list guile-packrat ;used by guile-ac-d-bus - guile-ac-d-bus - ;; Fibers is needed to provide the non-blocking - ;; variant of the 'sleep' procedure. - guile-fibers) - (with-imported-modules (source-module-closure - '((gnu build marionette) - (gnu build dbus-service) - (gnu build jami-service))) - #~(begin - (use-modules (rnrs base) - (srfi srfi-11) - (srfi srfi-64) - (gnu build marionette) - (gnu build dbus-service) - (gnu build jami-service)) - - (setenv "DBUS_SESSION_BUS_ADDRESS" "unix:path=/var/run/jami/bus") - - (define marionette - (make-marionette (list #$vm))) - - (test-runner-current (system-test-runner #$output)) - (test-begin "jami") - - (test-assert "service is running" - (marionette-eval - '(begin - (use-modules (gnu build jami-service)) - (jami-service-available?)) - marionette)) - - (test-assert "service can be stopped" - (marionette-eval - '(begin - (use-modules (gnu build jami-service) - (gnu services herd) - (rnrs base)) - (assert (jami-service-available?)) - - (stop-service 'jami) - - (with-retries 20 1 (not (jami-service-available?)))) - marionette)) - - (test-assert "service can be restarted" - (marionette-eval - '(begin - (use-modules (gnu build dbus-service) - (gnu build jami-service) - (gnu services herd) - (rnrs base) ) - ;; Start the service. - (start-service 'jami) - (with-retries 20 1 (jami-service-available?)) - ;; Restart the service. - (restart-service 'jami) - (with-retries 20 1 (jami-service-available?))) - marionette)) - - (unless #$provisioning? (test-skip 1)) - (test-assert "jami accounts provisioning, account present" - (marionette-eval - '(begin - (use-modules (gnu build dbus-service) - (gnu services herd) - (rnrs base)) - ;; Accounts take some time to appear after being added. - (with-retries 20 1 - (with-shepherd-action 'jami ('list-accounts) results - (let ((account (assoc-ref (car results) #$username))) - (assert (string=? #$username - (assoc-ref account - "Account.username"))))))) - marionette)) - - (unless #$(and provisioning? (not partial?)) (test-skip 1)) - (test-assert "jami accounts provisioning, allowed-contacts" - (marionette-eval - '(begin - (use-modules (gnu services herd) - (rnrs base) - (srfi srfi-1)) - - ;; Public mode is disabled. - (with-shepherd-action 'jami ('list-account-details) - results + (with-imported-modules (source-module-closure + '((gnu build marionette))) + #~(begin + (use-modules (rnrs base) + (srfi srfi-11) + (srfi srfi-64) + (gnu build marionette)) + + (setenv "DBUS_SESSION_BUS_ADDRESS" "unix:path=/var/run/jami/bus") + + (define marionette + (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "jami") + + (test-assert "d-bus tooling loaded" + ;; Add Guile-AC-D-Bus and related libraries to the marionette's + ;; search path. + (marionette-eval + '(let ((libraries '(#$guile-ac-d-bus + #$guile-packrat))) ;used by ac-d-bus + (set! %load-path + (append %load-path + (map (lambda (directory) + (string-append directory + "/share/guile/site/" + (effective-version))) + libraries))) + (set! %load-compiled-path + (append %load-compiled-path + (map (lambda (directory) + (string-append directory + "/lib/guile/3.0/site-ccache")) + libraries))) + %load-path) + marionette)) + + (test-assert "service is running" + (marionette-eval + '(begin + (use-modules (gnu build jami-service) + (gnu services herd)) + + (wait-for-service 'jami) + (jami-service-available?)) + marionette)) + + (test-assert "service can be stopped" + (marionette-eval + '(begin + (use-modules (gnu build jami-service) + (gnu services herd) + (rnrs base)) + (assert (jami-service-available?)) + + (stop-service 'jami) + + (with-retries 20 1 (not (jami-service-available?)))) + marionette)) + + (test-assert "service can be restarted" + (marionette-eval + '(begin + (use-modules (gnu build dbus-service) + (gnu build jami-service) + (gnu services herd) + (rnrs base) ) + ;; Start the service. + (start-service 'jami) + (with-retries 20 1 (jami-service-available?)) + ;; Restart the service. + (restart-service 'jami) + (with-retries 20 1 (jami-service-available?))) + marionette)) + + (unless #$provisioning? (test-skip 1)) + (test-assert "jami accounts provisioning, account present" + (marionette-eval + '(begin + (use-modules (gnu build dbus-service) + (gnu services herd) + (rnrs base)) + ;; Accounts take some time to appear after being added. + (with-retries 20 1 + (with-shepherd-action 'jami ('list-accounts) results + (let ((account (assoc-ref (car results) #$username))) + (assert (string=? #$username + (assoc-ref account + "Account.username"))))))) + marionette)) + + (unless #$(and provisioning? (not partial?)) (test-skip 1)) + (test-assert "jami accounts provisioning, allowed-contacts" + (marionette-eval + '(begin + (use-modules (gnu services herd) + (rnrs base) + (srfi srfi-1)) + + ;; Public mode is disabled. + (with-shepherd-action 'jami ('list-account-details) + results + (let ((account (assoc-ref (car results) #$username))) + (assert (string=? "false" + (assoc-ref account + "DHT.PublicInCalls"))))) + + ;; Allowed contacts match those declared in the configuration. + (with-shepherd-action 'jami ('list-contacts) results + (let ((contacts (assoc-ref (car results) #$username))) + (assert (lset= string-ci=? contacts '#$%allowed-contacts))))) + marionette)) + + (unless #$(and provisioning? (not partial?)) (test-skip 1)) + (test-assert "jami accounts provisioning, moderators" + (marionette-eval + '(begin + (use-modules (gnu services herd) + (rnrs base) + (srfi srfi-1)) + + ;; Moderators match those declared in the configuration. + (with-shepherd-action 'jami ('list-moderators) results + (let ((moderators (assoc-ref (car results) #$username))) + (assert (lset= string-ci=? moderators '#$%moderators)))) + + ;; Moderators can be added via the Shepherd action. + (with-shepherd-action 'jami + ('add-moderator "cccccccccccccccccccccccccccccccccccccccc" + #$username) results + (let ((moderators (car results))) + (assert (lset= string-ci=? moderators + (cons "cccccccccccccccccccccccccccccccccccccccc" + '#$%moderators)))))) + marionette)) + + (unless #$provisioning? (test-skip 1)) + (test-assert "jami service actions, ban/unban contacts" + (marionette-eval + '(begin + (use-modules (gnu services herd) + (ice-9 match) + (rnrs base) + (srfi srfi-1)) + + ;; Globally ban a contact. + (with-shepherd-action 'jami + ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _ + (with-shepherd-action 'jami ('list-banned-contacts) results + (every (match-lambda + ((username . banned-contacts) + (member "1dbcb0f5f37324228235564b79f2b9737e9a008f" + banned-contacts))) + (car results)))) + + ;; Ban a contact for a single account. + (with-shepherd-action 'jami + ('ban-contact "dddddddddddddddddddddddddddddddddddddddd" + #$username) _ + (with-shepherd-action 'jami ('list-banned-contacts) results + (every (match-lambda + ((username . banned-contacts) + (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd" + banned-contacts))) + (if (string=? #$username username) + found? + (not found?))))) + (car results))))) + marionette)) + + (unless #$provisioning? (test-skip 1)) + (test-assert "jami service actions, enable/disable accounts" + (marionette-eval + '(begin + (use-modules (gnu services herd) + (rnrs base)) + + (with-shepherd-action 'jami + ('disable-account #$username) _ + (with-shepherd-action 'jami ('list-accounts) results (let ((account (assoc-ref (car results) #$username))) - (assert (string=? "false" - (assoc-ref account - "DHT.PublicInCalls"))))) - - ;; Allowed contacts match those declared in the configuration. - (with-shepherd-action 'jami ('list-contacts) results - (let ((contacts (assoc-ref (car results) #$username))) - (assert (lset= string-ci=? contacts '#$%allowed-contacts))))) - marionette)) - - (unless #$(and provisioning? (not partial?)) (test-skip 1)) - (test-assert "jami accounts provisioning, moderators" - (marionette-eval - '(begin - (use-modules (gnu services herd) - (rnrs base) - (srfi srfi-1)) - - ;; Moderators match those declared in the configuration. - (with-shepherd-action 'jami ('list-moderators) results - (let ((moderators (assoc-ref (car results) #$username))) - (assert (lset= string-ci=? moderators '#$%moderators)))) - - ;; Moderators can be added via the Shepherd action. - (with-shepherd-action 'jami - ('add-moderator "cccccccccccccccccccccccccccccccccccccccc" - #$username) results - (let ((moderators (car results))) - (assert (lset= string-ci=? moderators - (cons "cccccccccccccccccccccccccccccccccccccccc" - '#$%moderators)))))) - marionette)) - - (unless #$provisioning? (test-skip 1)) - (test-assert "jami service actions, ban/unban contacts" - (marionette-eval - '(begin - (use-modules (gnu services herd) - (ice-9 match) - (rnrs base) - (srfi srfi-1)) - - ;; Globally ban a contact. - (with-shepherd-action 'jami - ('ban-contact "1dbcb0f5f37324228235564b79f2b9737e9a008f") _ - (with-shepherd-action 'jami ('list-banned-contacts) results - (every (match-lambda - ((username . banned-contacts) - (member "1dbcb0f5f37324228235564b79f2b9737e9a008f" - banned-contacts))) - (car results)))) - - ;; Ban a contact for a single account. - (with-shepherd-action 'jami - ('ban-contact "dddddddddddddddddddddddddddddddddddddddd" - #$username) _ - (with-shepherd-action 'jami ('list-banned-contacts) results - (every (match-lambda - ((username . banned-contacts) - (let ((found? (member "dddddddddddddddddddddddddddddddddddddddd" - banned-contacts))) - (if (string=? #$username username) - found? - (not found?))))) - (car results))))) - marionette)) - - (unless #$provisioning? (test-skip 1)) - (test-assert "jami service actions, enable/disable accounts" - (marionette-eval - '(begin - (use-modules (gnu services herd) - (rnrs base)) - - (with-shepherd-action 'jami - ('disable-account #$username) _ - (with-shepherd-action 'jami ('list-accounts) results - (let ((account (assoc-ref (car results) #$username))) - (assert (string= "false" - (assoc-ref account "Account.enable")))))) - - (with-shepherd-action 'jami - ('enable-account #$username) _ - (with-shepherd-action 'jami ('list-accounts) results - (let ((account (assoc-ref (car results) #$username))) - (assert (string= "true" - (assoc-ref account "Account.enable"))))))) - marionette)) - - (unless #$provisioning? (test-skip 1)) - (test-assert "jami account parameters" - (marionette-eval - '(begin - (use-modules (gnu services herd) - (rnrs base) - (srfi srfi-1)) - - (with-shepherd-action 'jami ('list-account-details) results - (let ((account-details (assoc-ref (car results) - #$username))) - (assert (lset<= - equal? - '(("Account.hostname" . - "bootstrap.me;fallback.another.host") - ("Account.peerDiscovery" . "false") - ("Account.rendezVous" . "true") - ("RingNS.uri" . "https://my.name.server")) - account-details))))) - marionette)) - - (test-end))))) + (assert (string= "false" + (assoc-ref account "Account.enable")))))) + + (with-shepherd-action 'jami + ('enable-account #$username) _ + (with-shepherd-action 'jami ('list-accounts) results + (let ((account (assoc-ref (car results) #$username))) + (assert (string= "true" + (assoc-ref account "Account.enable"))))))) + marionette)) + + (unless #$provisioning? (test-skip 1)) + (test-assert "jami account parameters" + (marionette-eval + '(begin + (use-modules (gnu services herd) + (rnrs base) + (srfi srfi-1)) + + (with-shepherd-action 'jami ('list-account-details) results + (let ((account-details (assoc-ref (car results) + #$username))) + (assert (lset<= + equal? + '(("Account.hostname" . + "bootstrap.me;fallback.another.host") + ("Account.peerDiscovery" . "false") + ("Account.rendezVous" . "true") + ("RingNS.uri" . "https://my.name.server")) + account-details))))) + marionette)) + + (test-end)))) (gexp->derivation (if provisioning? (if partial? "jami-provisioning-partial-test" "jami-provisioning-test") "jami-test") - test)) + test)) (define %test-jami (system-test |