services: bitlbee: Add test.
* gnu/tests/messaging.scm (run-bitlbee-test): New procedure. (%test-bitlbee): New variable.
This commit is contained in:
parent
37af37dcc9
commit
c1816361ad
|
@ -1,6 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -27,7 +27,9 @@
|
||||||
#:use-module (gnu packages messaging)
|
#:use-module (gnu packages messaging)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (guix store)
|
#: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)
|
(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."
|
"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)
|
(service prosody-service-type config)
|
||||||
(prosody-configuration-pidfile config)
|
(prosody-configuration-pidfile config)
|
||||||
%create-prosody-account)))))
|
%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))))
|
||||||
|
|
Loading…
Reference in New Issue