gnu/tests/messaging.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017, 2018 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 (service dhcp-client-service-type)
  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-assert "service running"
 106             (marionette-eval
 107              '(begin
 108                 (use-modules (gnu services herd))
 109                 (start-service 'xmpp-daemon))
 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                   (disable-sasl-mechanisms '())
 150                   (virtualhosts
 151                    (list
 152                     (virtualhost-configuration
 153                      (domain "localhost")))))))
 154     (system-test
 155      (name "prosody")
 156      (description "Connect to a running Prosody daemon.")
 157      (value (run-xmpp-test name
 158                            (service prosody-service-type config)
 159                            (prosody-configuration-pidfile config)
 160                            %create-prosody-account)))))
 161
 162 \f
 163 ;;;
 164 ;;; BitlBee.
 165 ;;;
 166
 167 (define (run-bitlbee-test)
 168   (define os
 169     (marionette-operating-system
 170      (simple-operating-system (service dhcp-client-service-type)
 171                               (service bitlbee-service-type
 172                                        (bitlbee-configuration
 173                                         (interface "0.0.0.0"))))
 174      #:imported-modules (source-module-closure
 175                          '((gnu services herd)))))
 176
 177   (define vm
 178     (virtual-machine
 179      (operating-system os)
 180      (port-forwardings `((6667 . 6667)))))
 181
 182   (define test
 183     (with-imported-modules '((gnu build marionette))
 184       #~(begin
 185           (use-modules (ice-9 rdelim)
 186                        (srfi srfi-64)
 187                        (gnu build marionette))
 188
 189           (define marionette
 190             (make-marionette (list #$vm)))
 191
 192           (mkdir #$output)
 193           (chdir #$output)
 194
 195           (test-begin "bitlbee")
 196
 197           (test-assert "service started"
 198             (marionette-eval
 199              '(begin
 200                 (use-modules (gnu services herd))
 201                 (start-service 'bitlbee))
 202              marionette))
 203
 204           (test-equal "valid PID"
 205             #$(file-append bitlbee "/sbin/bitlbee")
 206             (marionette-eval
 207              '(begin
 208                 (use-modules (srfi srfi-1)
 209                              (gnu services herd))
 210
 211                 (let ((bitlbee
 212                        (find (lambda (service)
 213                                (equal? '(bitlbee)
 214                                        (live-service-provision service)))
 215                              (current-services))))
 216                   (and (pk 'bitlbee-service bitlbee)
 217                        (let ((pid (live-service-running bitlbee)))
 218                          (readlink (string-append "/proc/"
 219                                                   (number->string pid)
 220                                                   "/exe"))))))
 221              marionette))
 222
 223           (test-assert "connect"
 224             (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK
 225                                                  6667))
 226                    (sock    (socket AF_INET SOCK_STREAM 0)))
 227               (connect sock address)
 228               ;; See <https://tools.ietf.org/html/rfc1459>.
 229               (->bool (string-contains (pk 'message (read-line sock))
 230                                        "BitlBee"))))
 231
 232           (test-end)
 233           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 234
 235   (gexp->derivation "bitlbee-test" test))
 236
 237 (define %test-bitlbee
 238   (system-test
 239    (name "bitlbee")
 240    (description "Connect to a BitlBee IRC server.")
 241    (value (run-bitlbee-test))))