gnu/tests/messaging.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   3 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu tests messaging)
  21   #:use-module (gnu tests)
  22   #:use-module (gnu system)
  23   #:use-module (gnu system vm)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services messaging)
  26   #:use-module (gnu services networking)
  27   #:use-module (gnu packages messaging)
  28   #:use-module (guix gexp)
  29   #:use-module (guix store)
  30   #:export (%test-prosody))
  31
  32 (define (run-xmpp-test name xmpp-service pid-file create-account)
  33   "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
  34   (define os
  35     (marionette-operating-system
  36      (simple-operating-system (dhcp-client-service)
  37                               xmpp-service)
  38      #:imported-modules '((gnu services herd))))
  39
  40   (define port 15222)
  41
  42   (define vm
  43     (virtual-machine
  44      (operating-system os)
  45      (port-forwardings `((,port . 5222)))))
  46
  47   (define username "alice")
  48   (define server "localhost")
  49   (define jid (string-append username "@" server))
  50   (define password "correct horse battery staple")
  51   (define message "hello world")
  52   (define witness "/tmp/freetalk-witness")
  53
  54   (define script.ft
  55     (scheme-file
  56      "script.ft"
  57      #~(begin
  58          (define (handle-received-message time from nickname message)
  59            (define (touch file-name)
  60              (call-with-output-file file-name (const #t)))
  61            (when (equal? message #$message)
  62              (touch #$witness)))
  63          (add-hook! ft-message-receive-hook handle-received-message)
  64
  65          (ft-set-jid! #$jid)
  66          (ft-set-password! #$password)
  67          (ft-set-server! #$server)
  68          (ft-set-port! #$port)
  69          (ft-set-sslconn! #f)
  70          (ft-connect-blocking)
  71          (ft-send-message #$jid #$message)
  72
  73          (ft-set-daemon)
  74          (ft-main-loop))))
  75
  76   (define test
  77     (with-imported-modules '((gnu build marionette))
  78       #~(begin
  79           (use-modules (gnu build marionette)
  80                        (srfi srfi-64))
  81
  82           (define marionette
  83             (make-marionette (list #$vm)))
  84
  85           (define (host-wait-for-file file)
  86             ;; Wait until FILE exists in the host.
  87             (let loop ((i 60))
  88               (cond ((file-exists? file)
  89                      #t)
  90                     ((> i 0)
  91                      (begin
  92                        (sleep 1))
  93                      (loop (- i 1)))
  94                     (else
  95                      (error "file didn't show up" file)))))
  96
  97           (mkdir #$output)
  98           (chdir #$output)
  99
 100           (test-begin "xmpp")
 101
 102           ;; Wait for XMPP service to be up and running.
 103           (test-eq "service running"
 104             'running!
 105             (marionette-eval
 106              '(begin
 107                 (use-modules (gnu services herd))
 108                 (start-service 'xmpp-daemon)
 109                 'running!)
 110              marionette))
 111
 112           ;; Check XMPP service's PID.
 113           (test-assert "service process id"
 114             (let ((pid (number->string (wait-for-file #$pid-file
 115                                                       marionette))))
 116               (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
 117                                marionette)))
 118
 119           ;; Alice sends an XMPP message to herself, with Freetalk.
 120           (test-assert "client-to-server communication"
 121             (let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
 122               (marionette-eval '(system* #$create-account #$jid #$password)
 123                                marionette)
 124               ;; Freetalk requires write access to $HOME.
 125               (setenv "HOME" "/tmp")
 126               (system* freetalk-bin "-s" #$script.ft)
 127               (host-wait-for-file #$witness)))
 128
 129           (test-end)
 130           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 131
 132   (gexp->derivation name test))
 133
 134 (define %create-prosody-account
 135   (program-file
 136    "create-account"
 137    #~(begin
 138        (use-modules (ice-9 match))
 139        (match (command-line)
 140          ((command jid password)
 141           (let ((password-input (format #f "\"~a~%~a\"" password password))
 142                 (prosodyctl #$(file-append prosody "/bin/prosodyctl")))
 143             (system (string-join
 144                      `("echo" ,password-input "|" ,prosodyctl "adduser" ,jid)
 145                      " "))))))))
 146
 147 (define %test-prosody
 148   (let* ((config (prosody-configuration
 149                   (virtualhosts
 150                    (list
 151                     (virtualhost-configuration
 152                      (domain "localhost")))))))
 153     (system-test
 154      (name "prosody")
 155      (description "Connect to a running Prosody daemon.")
 156      (value (run-xmpp-test name
 157                            (service prosody-service-type config)
 158                            (prosody-configuration-pidfile config)
 159                            %create-prosody-account)))))