summaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/databases.scm15
-rw-r--r--gnu/tests/docker.scm8
-rw-r--r--gnu/tests/install.scm3
-rw-r--r--gnu/tests/mail.scm8
-rw-r--r--gnu/tests/monitoring.scm14
-rw-r--r--gnu/tests/pam.scm6
-rw-r--r--gnu/tests/reconfigure.scm13
-rw-r--r--gnu/tests/security-token.scm4
-rw-r--r--gnu/tests/telephony.scm418
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