services: bitlbee: Add test.

* gnu/tests/messaging.scm (run-bitlbee-test): New procedure.
(%test-bitlbee): New variable.
This commit is contained in:
Ludovic Courtès 2018-01-15 23:08:08 +01:00
parent 37af37dcc9
commit c1816361ad
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 87 additions and 2 deletions

View File

@ -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))))