aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/messaging.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-07-18 10:41:51 +0200
committerLudovic Courtès <ludo@gnu.org>2017-07-20 11:57:13 +0200
commit8b113790fa3bfd2300c737901ba161f079fedbdf (patch)
tree72b7aa4fa9be2a6c129b97b04a11cfbe0d298a79 /gnu/tests/messaging.scm
parented419fa0c56e6ff3aa8bd8e8f100a81442c51e6d (diff)
downloadguix-8b113790fa3bfd2300c737901ba161f079fedbdf.tar
guix-8b113790fa3bfd2300c737901ba161f079fedbdf.tar.gz
tests: Use 'virtual-machine' records instead of monadic procedures.
* gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and 'virtual-machine' instead of 'system-qemu-image/shared-store-script'. (run-mcron-test): Likewise. (run-nss-mdns-test): Likewise. * gnu/tests/dict.scm (run-dicod-test): Likewise. * gnu/tests/mail.scm (run-opensmtpd-test): Likewise. (run-exim-test): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. * gnu/tests/networking.scm (run-inetd-test): Likewise. * gnu/tests/nfs.scm (run-nfs-test): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/web.scm (run-nginx-test): Likewise.
Diffstat (limited to 'gnu/tests/messaging.scm')
-rw-r--r--gnu/tests/messaging.scm198
1 files changed, 100 insertions, 98 deletions
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index b76b8e8434..0ba0c839de 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -1,5 +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>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,108 +27,109 @@
#:use-module (gnu packages messaging)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:export (%test-prosody))
(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
- (simple-operating-system (dhcp-client-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 (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 (wait-for-file #$pid-file
- marionette))))
- (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 os
+ (marionette-operating-system
+ (simple-operating-system (dhcp-client-service)
+ xmpp-service)
+ #:imported-modules '((gnu services herd))))
+
+ (define port 15222)
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((,port . 5222)))))
+
+ (define username "alice")
+ (define server "localhost")
+ (define jid (string-append username "@" server))
+ (define password "correct horse battery staple")
+ (define message "hello world")
+ (define 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
+ (make-marionette (list #$vm)))
+
+ (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 (wait-for-file #$pid-file
+ marionette))))
+ (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