summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/services/messaging.scm5
-rw-r--r--gnu/tests/messaging.scm194
3 files changed, 198 insertions, 2 deletions
diff --git a/gnu/local.mk b/gnu/local.mk
index 4d6e4b05d4..25fb3b44fc 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -459,6 +459,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/nfs.scm \
%D%/tests/install.scm \
%D%/tests/mail.scm \
+ %D%/tests/messaging.scm \
%D%/tests/ssh.scm \
%D%/tests/web.scm
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index aa398970b6..9f59d6eac6 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -40,7 +40,8 @@
mod-muc-configuration
ssl-configuration
- %default-modules-enabled))
+ %default-modules-enabled
+ prosody-configuration-pidfile))
;;; Commentary:
;;;
@@ -592,7 +593,7 @@ See also @url{http://prosody.im/doc/modules/mod_muc}."
(zero? (system* #$prosodyctl-bin #$@args))))))
(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 0000000000..b0c8254ce0
--- /dev/null
+++ b/gnu/tests/messaging.scm
@@ -0,0 +1,194 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; 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 (at
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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=tcp::"
+ (number->string #$port)
+ "-: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/freetalk")))
+ (marionette-eval '(system* #$create-account #$jid #$password)
+ marionette)
+ ;; Freetalk requires write access to $HOME.
+ (setenv "HOME" "/tmp")
+ (system* freetalk-bin "-s" #$script.ft)
+ (host-wait-for-file #$witness)))
+
+ (test-end)
+ (exit (= (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 password))
+ (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)))))
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-11 22:10:52 +0000