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
|
||||
;;; 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))))
|
||||
|
|
Loading…
Reference in New Issue