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 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu tests messaging)
  22   #:use-module (gnu tests)
  23   #:use-module (gnu system)
  24   #:use-module (gnu system vm)
  25   #:use-module (gnu services)
  26   #:use-module (gnu services messaging)
  27   #:use-module (gnu services networking)
  28   #:use-module (gnu packages messaging)
  29   #:use-module (guix gexp)
  30   #:use-module (guix store)
  31   #:use-module (guix modules)
  32   #:export (%test-prosody
  33             %test-bitlbee
  34             %test-quassel))
  35
  36 (define (run-xmpp-test name xmpp-service pid-file create-account)
  37   "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
  38   (define os
  39     (marionette-operating-system
  40      (simple-operating-system (service dhcp-client-service-type)
  41                               xmpp-service)
  42      #:imported-modules '((gnu services herd))))
  43
  44   (define port 15222)
  45
  46   (define vm
  47     (virtual-machine
  48      (operating-system os)
  49      (port-forwardings `((,port . 5222)))))
  50
  51   (define username "alice")
  52   (define server "localhost")
  53   (define jid (string-append username "@" server))
  54   (define password "correct horse battery staple")
  55   (define message "hello world")
  56   (define witness "/tmp/freetalk-witness")
  57
  58   (define script.ft
  59     (scheme-file
  60      "script.ft"
  61      #~(begin
  62          (define (handle-received-message time from nickname message)
  63            (define (touch file-name)
  64              (call-with-output-file file-name (const #t)))
  65            (when (equal? message #$message)
  66              (touch #$witness)))
  67          (add-hook! ft-message-receive-hook handle-received-message)
  68
  69          (ft-set-jid! #$jid)
  70          (ft-set-password! #$password)
  71          (ft-set-server! #$server)
  72          (ft-set-port! #$port)
  73          (ft-set-sslconn! #f)
  74          (ft-connect-blocking)
  75          (ft-send-message #$jid #$message)
  76
  77          (ft-set-daemon)
  78          (ft-main-loop))))
  79
  80   (define test
  81     (with-imported-modules '((gnu build marionette))
  82       #~(begin
  83           (use-modules (gnu build marionette)
  84                        (srfi srfi-64))
  85
  86           (define marionette
  87             (make-marionette (list #$vm)))
  88
  89           (define (host-wait-for-file file)
  90             ;; Wait until FILE exists in the host.
  91             (let loop ((i 60))
  92               (cond ((file-exists? file)
  93                      #t)
  94                     ((> i 0)
  95                      (begin
  96                        (sleep 1))
  97                      (loop (- i 1)))
  98                     (else
  99                      (error "file didn't show up" file)))))
 100
 101           (mkdir #$output)
 102           (chdir #$output)
 103
 104           (test-begin "xmpp")
 105
 106           ;; Wait for XMPP service to be up and running.
 107           (test-assert "service running"
 108             (marionette-eval
 109              '(begin
 110                 (use-modules (gnu services herd))
 111                 (start-service 'xmpp-daemon))
 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 (service dhcp-client-service-type)
 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-assert "service started"
 200             (marionette-eval
 201              '(begin
 202                 (use-modules (gnu services herd))
 203                 (start-service 'bitlbee))
 204              marionette))
 205
 206           (test-equal "valid PID"
 207             #$(file-append bitlbee "/sbin/bitlbee")
 208             (marionette-eval
 209              '(begin
 210                 (use-modules (srfi srfi-1)
 211                              (gnu services herd))
 212
 213                 (let ((bitlbee
 214                        (find (lambda (service)
 215                                (equal? '(bitlbee)
 216                                        (live-service-provision service)))
 217                              (current-services))))
 218                   (and (pk 'bitlbee-service bitlbee)
 219                        (let ((pid (live-service-running bitlbee)))
 220                          (readlink (string-append "/proc/"
 221                                                   (number->string pid)
 222                                                   "/exe"))))))
 223              marionette))
 224
 225           (test-assert "connect"
 226             (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK
 227                                                  6667))
 228                    (sock    (socket AF_INET SOCK_STREAM 0)))
 229               (connect sock address)
 230               ;; See <https://tools.ietf.org/html/rfc1459>.
 231               (->bool (string-contains (pk 'message (read-line sock))
 232                                        "BitlBee"))))
 233
 234           (test-end)
 235           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 236
 237   (gexp->derivation "bitlbee-test" test))
 238
 239 (define %test-bitlbee
 240   (system-test
 241    (name "bitlbee")
 242    (description "Connect to a BitlBee IRC server.")
 243    (value (run-bitlbee-test))))
 244
 245 (define (run-quassel-test)
 246   (define os
 247     (marionette-operating-system
 248       (simple-operating-system (service dhcp-client-service-type)
 249                                (service quassel-service-type))
 250      #:imported-modules (source-module-closure
 251                          '((gnu services herd)))))
 252
 253   (define vm
 254     (virtual-machine
 255       (operating-system os)
 256       (port-forwardings `((4242 . 4242)))))
 257
 258   (define test
 259     (with-imported-modules '((gnu build marionette))
 260       #~(begin
 261           (use-modules (srfi srfi-64)
 262                        (gnu build marionette))
 263
 264           (define marionette
 265             (make-marionette (list #$vm)))
 266
 267           (mkdir #$output)
 268           (chdir #$output)
 269
 270           (test-begin "quassel")
 271
 272           (test-assert "service started"
 273             (marionette-eval
 274              '(begin
 275                 (use-modules (gnu services herd))
 276                 (start-service 'quassel))
 277              marionette))
 278
 279           (test-assert "certificate file"
 280             (marionette-eval
 281               '(file-exists? "/var/lib/quassel/quasselCert.pem")
 282               marionette))
 283
 284           (test-end)
 285           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 286
 287   (gexp->derivation "quassel-test" test))
 288
 289 (define %test-quassel
 290   (system-test
 291    (name "quassel")
 292    (description "Connect to a quassel IRC server.")
 293    (value (run-quassel-test))))