123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394 |
- (define-module (gnu tests telephony)
- #:use-module (gnu)
- #:use-module (gnu packages)
- #:use-module (gnu packages guile)
- #:use-module (gnu packages guile-xyz)
- #:use-module (gnu tests)
- #:use-module (gnu system vm)
- #:use-module (gnu services)
- #:use-module (gnu services dbus)
- #:use-module (gnu services networking)
- #:use-module (gnu services ssh)
- #:use-module (gnu services telephony)
- #:use-module (guix gexp)
- #:use-module (guix modules)
- #:export (%test-jami
- %test-jami-provisioning
- %test-jami-provisioning-partial))
- (include "data/jami-dummy-account.dat")
- (define %dummy-jami-account-archive
-
- (computed-file
- "dummy-jami-account.gz"
- (with-extensions (list guile-json-4 guile-zlib)
- #~(begin
- (use-modules (json) (zlib))
- (let ((port (open-output-file #$output)))
- (call-with-gzip-output-port port
- (lambda (port)
- (scm->json '#$%jami-account-content-sexp port))))))))
- (define %allowed-contacts '("1dbcb0f5f37324228235564b79f2b9737e9a008f"
- "2dbcb0f5f37324228235564b79f2b9737e9a008f"))
- (define %moderators '("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
- "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"))
- (define %dummy-jami-account (jami-account
- (archive %dummy-jami-account-archive)
- (allowed-contacts %allowed-contacts)
- (moderators %moderators)
- (rendezvous-point? #t)
- (peer-discovery? #f)
- (bootstrap-hostnames '("bootstrap.me"
- "fallback.another.host"))
- (name-server-uri "https://my.name.server")))
- (define %dummy-jami-account-partial
- (jami-account
- (archive %dummy-jami-account-archive)
- (rendezvous-point? #t)
- (peer-discovery? #f)
- (bootstrap-hostnames '("bootstrap.me"
- "fallback.another.host"))
- (name-server-uri "https://my.name.server")))
- (define* (make-jami-os #:key provisioning? partial?)
- (operating-system
- (host-name "jami")
- (timezone "America/Montreal")
- (locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
- (file-systems (cons (file-system
- (device (file-system-label "my-root"))
- (mount-point "/")
- (type "ext4"))
- %base-file-systems))
- (firmware '())
- (services (cons* (service jami-service-type
- (if provisioning?
- (jami-configuration
- (debug? #t)
- (accounts
- (list (if partial?
- %dummy-jami-account-partial
- %dummy-jami-account))))
- (jami-configuration
- (debug? #t))))
- (service dbus-root-service-type)
-
-
- (service dhcp-client-service-type)
- (service openssh-service-type
- (openssh-configuration
- (permit-root-login #t)
- (allow-empty-passwords? #t)))
- %base-services))
- (packages (cons* (specification->package "recutils")
- (specification->package "strace")
- %base-packages))))
- (define %jami-os
- (make-jami-os))
- (define %jami-os-provisioning
- (make-jami-os #:provisioning? #t))
- (define %jami-os-provisioning-partial
- (make-jami-os #:provisioning? #t #:partial? #t))
- (define* (run-jami-test #:key provisioning? partial?)
- "Run tests in %JAMI-OS. When PROVISIONING? is true, test the accounts
- provisioning feature of the service. When PARTIAL? is #t, some fields of the
- jami account used as part of the jami configuration are left *unspecified*."
- (define os (marionette-operating-system
- (if provisioning?
- (if partial?
- %jami-os-provisioning-partial
- %jami-os-provisioning)
- %jami-os)
- #:imported-modules '((gnu services herd)
- (guix combinators)
- (gnu build jami-service)
- (gnu build dbus-service))))
- (define vm (virtual-machine
- (operating-system os)
- (memory-size 512)))
- (define username (assoc-ref %jami-account-content-sexp
- "Account.username"))
- (define test
- (with-imported-modules (source-module-closure
- '((gnu build marionette)))
- #~(begin
- (use-modules (srfi srfi-64)
- (gnu build marionette))
- (define marionette
- (make-marionette (list #$vm)))
- (test-runner-current (system-test-runner #$output))
- (test-begin "jami")
- (test-assert "d-bus tooling loaded"
-
-
- (marionette-eval
- '(let ((libraries '(#$guile-ac-d-bus
- #$guile-packrat)))
- (setenv "DBUS_SESSION_BUS_ADDRESS" "unix:path=/var/run/jami/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 dbus-service)
- (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-service 'jami)
- (with-retries 20 1 (jami-service-available?))
-
- (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))
-
- (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))
-
- (with-shepherd-action 'jami ('list-account-details)
- results
- (let ((account (assoc-ref (car results) #$username)))
- (assert (string=? "false"
- (assoc-ref account
- "DHT.PublicInCalls")))))
-
- (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))
-
- (with-shepherd-action 'jami ('list-moderators) results
- (let ((moderators (assoc-ref (car results) #$username)))
- (assert (lset= string-ci=? moderators '#$%moderators))))
-
- (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))
-
- (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))))
-
- (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?
- (if partial?
- "jami-provisioning-partial-test"
- "jami-provisioning-test")
- "jami-test")
- test))
- (define %test-jami
- (system-test
- (name "jami")
- (description "Basic tests for the jami service.")
- (value (run-jami-test))))
- (define %test-jami-provisioning
- (system-test
- (name "jami-provisioning")
- (description "Provisioning test for the jami service.")
- (value (run-jami-test #:provisioning? #t))))
- (define %test-jami-provisioning-partial
- (system-test
- (name "jami-provisioning-partial")
- (description "Provisioning test for the jami service, when some of the
- 'maybe' fields aren't provided (such that their value end up being
- *unspecified*.")
- (value (run-jami-test #:provisioning? #t #:partial? #t))))
|