gnu/tests/messaging.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   3 ;;; Copyright © 2017, 2018 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   #:use-module (guix modules)
  31   #:export (%test-prosody
  32             %test-bitlbee))
  33
  34 (define (run-xmpp-test name xmpp-service pid-file create-account)
  35   "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
  36   (define os
  37     (marionette-operating-system
  38      (simple-operating-system (dhcp-client-service)
  39                               xmpp-service)
  40      #:imported-modules '((gnu services herd))))
  41
  42   (define port 15222)
  43
  44   (define vm
  45     (virtual-machine
  46      (operating-system os)
  47      (port-forwardings `((,port . 5222)))))
  48
  49   (define username "alice")
  50   (define server "localhost")
  51   (define jid (string-append username "@" server))
  52   (define password "correct horse battery staple")
  53   (define message "hello world")
  54   (define witness "/tmp/freetalk-witness")
  55
  56   (define script.ft
  57     (scheme-file
  58      "script.ft"
  59      #~(begin
  60          (define (handle-received-message time from nickname message)
  61            (define (touch file-name)
  62              (call-with-output-file file-name (const #t)))
  63            (when (equal? message #$message)
  64              (touch #$witness)))
  65          (add-hook! ft-message-receive-hook handle-received-message)
  66
  67          (ft-set-jid! #$jid)
  68          (ft-set-password! #$password)
  69          (ft-set-server! #$server)
  70          (ft-set-port! #$port)
  71          (ft-set-sslconn! #f)
  72          (ft-connect-blocking)
  73          (ft-send-message #$jid #$message)
  74
  75          (ft-set-daemon)
  76          (ft-main-loop))))
  77
  78   (define test
  79     (with-imported-modules '((gnu build marionette))
  80       #~(begin
  81           (use-modules (gnu build marionette)
  82                        (srfi srfi-64))
  83
  84           (define marionette
  85             (make-marionette (list #$vm)))
  86
  87           (define (host-wait-for-file file)
  88             ;; Wait until FILE exists in the host.
  89             (let loop ((i 60))
  90               (cond ((file-exists? file)
  91                      #t)
  92                     ((> i 0)
  93                      (begin
  94                        (sleep 1))
  95                      (loop (- i 1)))
  96                     (else
  97                      (error "file didn't show up" file)))))
  98
  99           (mkdir #$output)
 100           (chdir #$output)
 101
 102           (test-begin "xmpp")
 103
 104           ;; Wait for XMPP service to be up and running.
 105           (test-eq "service running"
 106             'running!
 107             (marionette-eval
 108              '(begin
 109                 (use-modules (gnu services herd))
 110                 (start-service 'xmpp-daemon)
 111                 'running!)
 112              marionette))
 113
 114           ;; Check XMPP service's PID.
 115           (test-assert "service process id"
 116             (let ((pid (number->string (wait-for-file #$pid-file
 117                                                       marionette))))
 118               (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
 119                                marionette)))
 120
 121           ;; Alice sends an XMPP message to herself, with Freetalk.
 122           (test-assert "client-to-server communication"
 123             (let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
 124               (marionette-eval '(system* #$create-account #$jid #$password)
 125                                marionette)
 126               ;; Freetalk requires write access to $HOME.
 127               (setenv "HOME" "/tmp")
 128               (system* freetalk-bin "-s" #$script.ft)
 129               (host-wait-for-file #$witness)))
 130
 131           (test-end)
 132           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 133
 134   (gexp->derivation name test))
 135
 136 (define %create-prosody-account
 137   (program-file
 138    "create-account"
 139    #~(begin
 140        (use-modules (ice-9 match))
 141        (match (command-line)
 142          ((command jid password)
 143           (let ((password-input (format #f "\"~a~%~a\"" password password))
 144                 (prosodyctl #$(file-append prosody "/bin/prosodyctl")))
 145             (system (string-join
 146                      `("echo" ,password-input "|" ,prosodyctl "adduser" ,jid)
 147                      " "))))))))
 148
 149 (define %test-prosody
 150   (let* ((config (prosody-configuration
 151                   (disable-sasl-mechanisms '())
 152                   (virtualhosts
 153                    (list
 154                     (virtualhost-configuration
 155                      (domain "localhost")))))))
 156     (system-test
 157      (name "prosody")
 158      (description "Connect to a running Prosody daemon.")
 159      (value (run-xmpp-test name
 160                            (service prosody-service-type config)
 161                            (prosody-configuration-pidfile config)
 162                            %create-prosody-account)))))
 163
 164 \f
 165 ;;;
 166 ;;; BitlBee.
 167 ;;;
 168
 169 (define (run-bitlbee-test)
 170   (define os
 171     (marionette-operating-system
 172      (simple-operating-system (dhcp-client-service)
 173                               (service bitlbee-service-type
 174                                        (bitlbee-configuration
 175                                         (interface "0.0.0.0"))))
 176      #:imported-modules (source-module-closure
 177                          '((gnu services herd)))))
 178
 179   (define vm
 180     (virtual-machine
 181      (operating-system os)
 182      (port-forwardings `((6667 . 6667)))))
 183
 184   (define test
 185     (with-imported-modules '((gnu build marionette))
 186       #~(begin
 187           (use-modules (ice-9 rdelim)
 188                        (srfi srfi-64)
 189                        (gnu build marionette))
 190
 191           (define marionette
 192             (make-marionette (list #$vm)))
 193
 194           (mkdir #$output)
 195           (chdir #$output)
 196
 197           (test-begin "bitlbee")
 198
 199           (test-eq "service started"
 200             'running!
 201             (marionette-eval
 202              '(begin
 203                 (use-modules (gnu services herd))
 204                 (start-service 'bitlbee)
 205                 'running!)
 206              marionette))
 207
 208           (test-equal "valid PID"
 209             #$(file-append bitlbee "/sbin/bitlbee")
 210             (marionette-eval
 211              '(begin
 212                 (use-modules (srfi srfi-1)
 213                              (gnu services herd))
 214
 215                 (let ((bitlbee
 216                        (find (lambda (service)
 217                                (equal? '(bitlbee)
 218                                        (live-service-provision service)))
 219                              (current-services))))
 220                   (and (pk 'bitlbee-service bitlbee)
 221                        (let ((pid (live-service-running bitlbee)))
 222                          (readlink (string-append "/proc/"
 223                                                   (number->string pid)
 224                                                   "/exe"))))))
 225              marionette))
 226
 227           (test-assert "connect"
 228             (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK
 229                                                  6667))
 230                    (sock    (socket AF_INET SOCK_STREAM 0)))
 231               (connect sock address)
 232               ;; See <https://tools.ietf.org/html/rfc1459>.
 233               (->bool (string-contains (pk 'message (read-line sock))
 234                                        "BitlBee"))))
 235
 236           (test-end)
 237           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 238
 239   (gexp->derivation "bitlbee-test" test))
 240
 241 (define %test-bitlbee
 242   (system-test
 243    (name "bitlbee")
 244    (description "Connect to a BitlBee IRC server.")
 245    (value (run-bitlbee-test))))