diff options
| -rw-r--r-- | gnu/tests/messaging.scm | 89 |
1 files changed, 87 insertions, 2 deletions
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm index 60e2f332a3..f17dfe6265 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,9 @@ #:use-module (gnu packages messaging) #:use-module (guix gexp) #:use-module (guix store) - #:export (%test-prosody)) + #:use-module (guix modules) + #:export (%test-prosody + %test-bitlbee)) (define (run-xmpp-test name xmpp-service pid-file create-account) "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE." @@ -158,3 +160,86 @@ (service prosody-service-type config) (prosody-configuration-pidfile config) %create-prosody-account))))) + + +;;; +;;; BitlBee. +;;; + +(define (run-bitlbee-test) + (define os + (marionette-operating-system + (simple-operating-system (dhcp-client-service) + (service bitlbee-service-type + (bitlbee-configuration + (interface "0.0.0.0")))) + #:imported-modules (source-module-closure + '((gnu services herd))))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((6667 . 6667))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (ice-9 rdelim) + (srfi srfi-64) + (gnu build marionette)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "bitlbee") + + (test-eq "service started" + 'running! + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'bitlbee) + 'running!) + marionette)) + + (test-equal "valid PID" + #$(file-append bitlbee "/sbin/bitlbee") + (marionette-eval + '(begin + (use-modules (srfi srfi-1) + (gnu services herd)) + + (let ((bitlbee + (find (lambda (service) + (equal? '(bitlbee) + (live-service-provision service))) + (current-services)))) + (and (pk 'bitlbee-service bitlbee) + (let ((pid (live-service-running bitlbee))) + (readlink (string-append "/proc/" + (number->string pid) + "/exe")))))) + marionette)) + + (test-assert "connect" + (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK + 6667)) + (sock (socket AF_INET SOCK_STREAM 0))) + (connect sock address) + ;; See <https://tools.ietf.org/html/rfc1459>. + (->bool (string-contains (pk 'message (read-line sock)) + "BitlBee")))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "bitlbee-test" test)) + +(define %test-bitlbee + (system-test + (name "bitlbee") + (description "Connect to a BitlBee IRC server.") + (value (run-bitlbee-test)))) |