From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?UTF-8?q?Cl=C3=A9ment=20Lassieur?= Subject: [PATCH] tests: Add 'prosody-service-type' test. Date: Fri, 10 Feb 2017 19:17:22 +0100 Message-ID: <20170210181722.24699-1-clement@lassieur.org> References: <87d1espwno.fsf@gnu.org> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:51974) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ccFlb-0002nU-BH for guix-devel@gnu.org; Fri, 10 Feb 2017 13:17:57 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ccFlX-00085i-OC for guix-devel@gnu.org; Fri, 10 Feb 2017 13:17:55 -0500 Received: from mail.lassieur.org ([83.152.10.219]:56638) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1ccFlX-00080z-85 for guix-devel@gnu.org; Fri, 10 Feb 2017 13:17:51 -0500 Received: from localhost.localdomain (unknown [185.13.106.219]) by mail.lassieur.org (Postfix) with ESMTPSA id 334D8640107 for ; Fri, 10 Feb 2017 19:17:46 +0100 (CET) In-Reply-To: <87d1espwno.fsf@gnu.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * gnu/tests/messaging.scm: New file. * gnu/services/messaging.scm: New exported procedure. ()[provision]: Add 'xmpp-daemon'. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- gnu/local.mk | 1 + gnu/services/messaging.scm | 5 +- gnu/tests/messaging.scm | 194 +++++++++++++++++++++++++++++++++++++++= ++++++ 3 files changed, 198 insertions(+), 2 deletions(-) create mode 100644 gnu/tests/messaging.scm diff --git a/gnu/local.mk b/gnu/local.mk index 4d6e4b05d..25fb3b44f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -459,6 +459,7 @@ GNU_SYSTEM_MODULES =3D \ %D%/tests/nfs.scm \ %D%/tests/install.scm \ %D%/tests/mail.scm \ + %D%/tests/messaging.scm \ %D%/tests/ssh.scm \ %D%/tests/web.scm =20 diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index aa398970b..9f59d6eac 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -40,7 +40,8 @@ mod-muc-configuration ssl-configuration =20 - %default-modules-enabled)) + %default-modules-enabled + prosody-configuration-pidfile)) =20 ;;; Commentary: ;;; @@ -592,7 +593,7 @@ See also @url{http://prosody.im/doc/modules/mod_muc}.= " (zero? (system* #$prosodyctl-bin #$@ar= gs)))))) (list (shepherd-service (documentation "Run the Prosody XMPP server") - (provision '(prosody)) + (provision '(prosody xmpp-daemon)) (requirement '(networking syslogd user-processes)) (start (prosodyctl-action "start")) (stop (prosodyctl-action "stop")))))) diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm new file mode 100644 index 000000000..b0c8254ce --- /dev/null +++ b/gnu/tests/messaging.scm @@ -0,0 +1,194 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2017 Cl=C3=A9ment Lassieur +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (a= t +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests messaging) + #:use-module (gnu tests) + #:use-module (gnu system) + #:use-module (gnu system grub) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services messaging) + #:use-module (gnu services networking) + #:use-module (gnu packages messaging) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix monads) + #:export (%test-prosody)) + +(define %base-os + (operating-system + (host-name "komputilo") + (timezone "Europe/Berlin") + (locale "en_US.UTF-8") + + (bootloader (grub-configuration (device "/dev/sdX"))) + (file-systems %base-file-systems) + (firmware '()) + (users %base-user-accounts) + (services (cons (dhcp-client-service) + %base-services)))) + +(define (os-with-service service) + "Return a test operating system that runs SERVICE." + (operating-system + (inherit %base-os) + (services (cons service + (operating-system-user-services %base-os))))) + +(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." + (mlet* %store-monad ((os -> (marionette-operating-system + (os-with-service xmpp-service) + #:imported-modules '((gnu services herd))= )) + (command (system-qemu-image/shared-store-script + os #:graphic? #f)) + (username -> "alice") + (server -> "localhost") + (jid -> (string-append username "@" server)) + (password -> "correct horse battery staple") + (port -> 15222) + (message -> "hello world") + (witness -> "/tmp/freetalk-witness")) + + (define script.ft + (scheme-file + "script.ft" + #~(begin + (define (handle-received-message time from nickname message) + (define (touch file-name) + (call-with-output-file file-name (const #t))) + (when (equal? message #$message) + (touch #$witness))) + (add-hook! ft-message-receive-hook handle-received-message) + + (ft-set-jid! #$jid) + (ft-set-password! #$password) + (ft-set-server! #$server) + (ft-set-port! #$port) + (ft-set-sslconn! #f) + (ft-connect-blocking) + (ft-send-message #$jid #$message) + + (ft-set-daemon) + (ft-main-loop)))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + ;; Enable TCP forwarding of the guest's port 5222. + (make-marionette (list #$command "-net" + (string-append "user,hostfwd=3Dtcp:= :" + (number->string #$po= rt) + "-:5222")))) + + (define (guest-wait-for-file file) + ;; Wait until FILE exists in the guest; 'read' its content= and + ;; return it. + (marionette-eval + `(let loop ((i 10)) + (cond ((file-exists? ,file) + (call-with-input-file ,file read)) + ((> i 0) + (begin + (sleep 1)) + (loop (- i 1))) + (else + (error "file didn't show up" ,file)))) + marionette)) + + (define (host-wait-for-file file) + ;; Wait until FILE exists in the host. + (let loop ((i 60)) + (cond ((file-exists? file) + #t) + ((> i 0) + (begin + (sleep 1)) + (loop (- i 1))) + (else + (error "file didn't show up" file))))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "xmpp") + + ;; Wait for XMPP service to be up and running. + (test-eq "service running" + 'running! + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'xmpp-daemon) + 'running!) + marionette)) + + ;; Check XMPP service's PID. + (test-assert "service process id" + (let ((pid (number->string (guest-wait-for-file #$pid-file= )))) + (marionette-eval `(file-exists? (string-append "/proc/" = ,pid)) + marionette))) + + ;; Alice sends an XMPP message to herself, with Freetalk. + (test-assert "client-to-server communication" + (let ((freetalk-bin (string-append #$freetalk "/bin/freeta= lk"))) + (marionette-eval '(system* #$create-account #$jid #$pass= word) + marionette) + ;; Freetalk requires write access to $HOME. + (setenv "HOME" "/tmp") + (system* freetalk-bin "-s" #$script.ft) + (host-wait-for-file #$witness))) + + (test-end) + (exit (=3D (test-runner-fail-count (test-runner-current)) 0)= )))) + + (gexp->derivation name test))) + +(define %create-prosody-account + (program-file + "create-account" + #~(begin + (use-modules (ice-9 match)) + (match (command-line) + ((command jid password) + (let ((password-input (format #f "\"~a~%~a\"" password passwor= d)) + (prosodyctl #$(file-append prosody "/bin/prosodyctl"))) + (system (string-join + `("echo" ,password-input "|" ,prosodyctl "adduser" = ,jid) + " ")))))))) + +(define %test-prosody + (let* ((config (prosody-configuration + (virtualhosts + (list + (virtualhost-configuration + (domain "localhost"))))))) + (system-test + (name "prosody") + (description "Connect to a running Prosody daemon.") + (value (run-xmpp-test name + (service prosody-service-type config) + (prosody-configuration-pidfile config) + %create-prosody-account))))) --=20 2.11.1