me
/
guix
Archived
1
0
Fork 0
Code

tests: Add missing module imports for marionette-evaluated code. 

This missing imports became apparent with commit
a09c7da8f8, which runs the marionette
service in a fresh Guile process with fewer imports.

* gnu/tests/databases.scm (run-postgresql-test, run-timescaledb-test)
(run-mysql-test): Add missing module imports for code passed to
'marionette-eval'.
* gnu/tests/docker.scm (run-docker-test, run-docker-system-test): Likewise.
* gnu/tests/mail.scm (run-dovecot-test, run-getmail-test): Likewise.
* gnu/tests/monitoring.scm (run-zabbix-server-test): Likewise.
* gnu/tests/pam.scm (run-test-pam-limits): Likewise.
* gnu/tests/reconfigure.scm (run-switch-to-system-test)
(run-install-bootloader-test): Likewise.
* gnu/tests/security-token.scm (run-pcscd-test): Likewise.
* gnu/tests/install.scm (gui-test-program): Likewise.
* gnu/tests/telephony.scm (run-jami-test): Add modules to
the #:imported-modules argument of 'marionette-operating-system'.
[test]: Remove them from 'with-imported-modules'; remove
'with-extensions'.  Add "d-bus tooling loaded" test to set up %load-path
and %load-compiled-path so the marionette process can find
guile-ac-d-bus and guile-packrat.
master
Ludovic Courtès 2023-05-06 15:07:09 +02:00
parent 1cb0dee3a3
commit f518882725
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
9 changed files with 252 additions and 207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gnu/tests/databases.scm
View File

@ -196,7 +196,9 @@
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (ice-9 ftw) (use-modules (ice-9 ftw)
(ice-9 match)) (ice-9 match)
(rnrs io ports))
(current-output-port (current-output-port
(open-file "/dev/console" "w0")) (open-file "/dev/console" "w0"))
(let ((server-log-file (let ((server-log-file
@ -317,6 +319,8 @@
(begin (begin
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (rnrs io ports))
(let loop ((i 10)) (let loop ((i 10))
(unless (or (zero? i) (unless (or (zero? i)
(and (file-exists? #$%role-log-file) (and (file-exists? #$%role-log-file)
@ -331,8 +335,9 @@
(test-assert "database creation" (test-assert "database creation"
(marionette-eval (marionette-eval
'(begin '(begin
(current-output-port (use-modules (guix build utils))
(open-file "/dev/console" "w0"))
(current-output-port (open-file "/dev/console" "w0"))
(invoke #$(file-append postgresql "/bin/psql") (invoke #$(file-append postgresql "/bin/psql")
"-tA" "-c" "CREATE DATABASE test")) "-tA" "-c" "CREATE DATABASE test"))
marionette)) marionette))
@ -466,7 +471,9 @@ data double PRECISION NULL
"awesome\n" "awesome\n"
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (ice-9 popen)) (use-modules (ice-9 popen)
(rnrs io ports))
(let* ((port (open-pipe* (let* ((port (open-pipe*
OPEN_READ OPEN_READ
#$(file-append mariadb "/bin/mysql") "guix" #$(file-append mariadb "/bin/mysql") "guix"

8
gnu/tests/docker.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -108,6 +108,9 @@ inside %DOCKER-OS."
'("hello world" "hi!" "JSON!" #o1777) '("hello world" "hi!" "JSON!" #o1777)
(marionette-eval (marionette-eval
`(begin `(begin
(use-modules (ice-9 popen)
(ice-9 rdelim))
(define slurp (define slurp
(lambda args (lambda args
(let* ((port (apply open-pipe* OPEN_READ args)) (let* ((port (apply open-pipe* OPEN_READ args))
@ -242,6 +245,9 @@ inside %DOCKER-OS."
(test-assert "load system image and run it" (test-assert "load system image and run it"
(marionette-eval (marionette-eval
`(begin `(begin
(use-modules (ice-9 popen)
(ice-9 rdelim))
(define (slurp command . args) (define (slurp command . args)
;; Return the output from COMMAND. ;; Return the output from COMMAND.
(let* ((port (apply open-pipe* OPEN_READ command args)) (let* ((port (apply open-pipe* OPEN_READ command args))

3
gnu/tests/install.scm
View File

@ -1733,7 +1733,8 @@ build (current-guix) and then store a couple of full system images.")
(setvbuf (current-output-port) 'none) (setvbuf (current-output-port) 'none)
(setvbuf (current-error-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) #$marionette)
;; Arrange so that 'converse' prints debugging output to the console. ;; Arrange so that 'converse' prints debugging output to the console.

8
gnu/tests/mail.scm
View File

@ -382,7 +382,9 @@ Subject: Hello Nice to meet you!")
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (ice-9 ftw) (use-modules (ice-9 ftw)
(ice-9 match)) (ice-9 match)
(rnrs io ports))
(let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/"))
(match (scandir TESTBOX/new) (match (scandir TESTBOX/new)
(("." ".." message-file) (("." ".." message-file)
@ -556,7 +558,9 @@ Subject: Hello Nice to meet you!")
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (ice-9 ftw) (use-modules (ice-9 ftw)
(ice-9 match)) (ice-9 match)
(rnrs io ports))
(let ((TESTBOX/new "/home/alice/TestMaildir/new/")) (let ((TESTBOX/new "/home/alice/TestMaildir/new/"))
(match (scandir TESTBOX/new) (match (scandir TESTBOX/new)
(("." ".." message-file) (("." ".." message-file)

14
gnu/tests/monitoring.scm
View File

@ -208,11 +208,15 @@ postgres|Superuser, Create role, Create DB, Replication, Bypass RLS|{}
zabbix||{} zabbix||{}
" "
(marionette-eval (marionette-eval
'(begin (let* ((port (open-pipe #$%psql-db-zabbix-create-script '(begin
OPEN_READ)) (use-modules (ice-9 popen)
(output (read-string port)) (ice-9 rdelim))
(status (close-pipe port)))
output)) (let* ((port (open-pipe #$%psql-db-zabbix-create-script
OPEN_READ))
(output (read-string port))
(status (close-pipe port)))
output))
marionette)) marionette))
(test-eq "postgres create zabbix db" (test-eq "postgres create zabbix db"

6
gnu/tests/pam.scm
View File

@ -70,8 +70,10 @@
#$(string-join (map pam-limits-entry->string pam-limit-entries) #$(string-join (map pam-limits-entry->string pam-limit-entries)
"\n" 'suffix) "\n" 'suffix)
(marionette-eval (marionette-eval
'(call-with-input-file "/etc/security/limits.conf" '(begin
get-string-all) (use-modules (rnrs io ports))
(call-with-input-file "/etc/security/limits.conf"
get-string-all))
marionette)) marionette))
(test-end))))) (test-end)))))

13
gnu/tests/reconfigure.scm
View File

@ -104,10 +104,11 @@ generation of the system profile."
(test-assert "script activated user accounts" (test-assert "script activated user accounts"
(marionette-eval (marionette-eval
'(string-contains (call-with-input-file "/etc/passwd" '(begin
(lambda (port) (use-modules (rnrs io ports))
(get-string-all port))) (string-contains (call-with-input-file "/etc/passwd"
"jakob") get-string-all)
"jakob"))
marionette))) marionette)))
(test-end)))) (test-end))))
@ -208,9 +209,9 @@ bootloader's configuration file."
(define (generations-in-grub-cfg marionette) (define (generations-in-grub-cfg marionette)
(let ((grub-cfg (marionette-eval (let ((grub-cfg (marionette-eval
'(begin '(begin
(use-modules (rnrs io ports))
(call-with-input-file "/boot/grub/grub.cfg" (call-with-input-file "/boot/grub/grub.cfg"
(lambda (port) get-string-all))
(get-string-all port))))
marionette))) marionette)))
(map (lambda (parameter) (map (lambda (parameter)
(second (string-split (match:substring parameter) #\=))) (second (string-split (match:substring parameter) #\=)))

4
gnu/tests/security-token.scm
View File

@ -50,7 +50,9 @@
(test-assert "pcscd is alive" (test-assert "pcscd is alive"
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd)
(srfi srfi-1))
(live-service-running (live-service-running
(find (lambda (live) (find (lambda (live)
(memq 'pcscd (live-service-provision live))) (memq 'pcscd (live-service-provision live)))

388
gnu/tests/telephony.scm
View File

@ -138,7 +138,9 @@ jami account used as part of the jami configuration are left *unspecified*."
%jami-os-provisioning) %jami-os-provisioning)
%jami-os) %jami-os)
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(guix combinators)))) (guix combinators)
(gnu build jami-service)
(gnu build dbus-service))))
(define vm (virtual-machine (define vm (virtual-machine
(operating-system os) (operating-system os)
(memory-size 512))) (memory-size 512)))
@ -147,212 +149,228 @@ jami account used as part of the jami configuration are left *unspecified*."
"Account.username")) "Account.username"))
(define test (define test
(with-extensions (list guile-packrat ;used by guile-ac-d-bus (with-imported-modules (source-module-closure
guile-ac-d-bus '((gnu build marionette)))
;; Fibers is needed to provide the non-blocking #~(begin
;; variant of the 'sleep' procedure. (use-modules (rnrs base)
guile-fibers) (srfi srfi-11)
(with-imported-modules (source-module-closure (srfi srfi-64)
'((gnu build marionette) (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") (setenv "DBUS_SESSION_BUS_ADDRESS" "unix:path=/var/run/jami/bus")
(define marionette (define marionette
(make-marionette (list #$vm))) (make-marionette (list #$vm)))
(test-runner-current (system-test-runner #$output)) (test-runner-current (system-test-runner #$output))
(test-begin "jami") (test-begin "jami")
(test-assert "service is running" (test-assert "d-bus tooling loaded"
(marionette-eval ;; Add Guile-AC-D-Bus and related libraries to the marionette's
'(begin ;; search path.
(use-modules (gnu build jami-service)) (marionette-eval
(jami-service-available?)) '(let ((libraries '(#$guile-ac-d-bus
marionette)) #$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 can be stopped" (test-assert "service is running"
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu build jami-service) (use-modules (gnu build jami-service)
(gnu services herd) (gnu services herd))
(rnrs base))
(assert (jami-service-available?))
(stop-service 'jami) (wait-for-service 'jami)
(jami-service-available?))
marionette))
(with-retries 20 1 (not (jami-service-available?)))) (test-assert "service can be stopped"
marionette)) (marionette-eval
'(begin
(use-modules (gnu build jami-service)
(gnu services herd)
(rnrs base))
(assert (jami-service-available?))
(test-assert "service can be restarted" (stop-service 'jami)
(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)) (with-retries 20 1 (not (jami-service-available?))))
(test-assert "jami accounts provisioning, account present" marionette))
(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 "service can be restarted"
(test-assert "jami accounts provisioning, allowed-contacts" (marionette-eval
(marionette-eval '(begin
'(begin (use-modules (gnu build dbus-service)
(use-modules (gnu services herd) (gnu build jami-service)
(rnrs base) (gnu services herd)
(srfi srfi-1)) (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))
;; Public mode is disabled. (unless #$provisioning? (test-skip 1))
(with-shepherd-action 'jami ('list-account-details) (test-assert "jami accounts provisioning, account present"
results (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))) (let ((account (assoc-ref (car results) #$username)))
(assert (string=? "false" (assert (string= "false"
(assoc-ref account (assoc-ref account "Account.enable"))))))
"DHT.PublicInCalls")))))
;; Allowed contacts match those declared in the configuration. (with-shepherd-action 'jami
(with-shepherd-action 'jami ('list-contacts) results ('enable-account #$username) _
(let ((contacts (assoc-ref (car results) #$username))) (with-shepherd-action 'jami ('list-accounts) results
(assert (lset= string-ci=? contacts '#$%allowed-contacts))))) (let ((account (assoc-ref (car results) #$username)))
marionette)) (assert (string= "true"
(assoc-ref account "Account.enable")))))))
marionette))
(unless #$(and provisioning? (not partial?)) (test-skip 1)) (unless #$provisioning? (test-skip 1))
(test-assert "jami accounts provisioning, moderators" (test-assert "jami account parameters"
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd) (use-modules (gnu services herd)
(rnrs base) (rnrs base)
(srfi srfi-1)) (srfi srfi-1))
;; Moderators match those declared in the configuration. (with-shepherd-action 'jami ('list-account-details) results
(with-shepherd-action 'jami ('list-moderators) results (let ((account-details (assoc-ref (car results)
(let ((moderators (assoc-ref (car results) #$username))) #$username)))
(assert (lset= string-ci=? moderators '#$%moderators)))) (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))
;; Moderators can be added via the Shepherd action. (test-end))))
(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)))))
(gexp->derivation (if provisioning? (gexp->derivation (if provisioning?
(if partial? (if partial?
"jami-provisioning-partial-test" "jami-provisioning-partial-test"
"jami-provisioning-test") "jami-provisioning-test")
"jami-test") "jami-test")
test)) test))
(define %test-jami (define %test-jami
(system-test (system-test