Commit | Line | Data |
---|---|---|
533bc514 | 1 | ;;; GNU Guix --- Functional package management for GNU |
c24b1547 | 2 | ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> |
c1816361 | 3 | ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> |
dcad57d5 | 4 | ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> |
533bc514 CL |
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) | |
533bc514 CL |
24 | #:use-module (gnu system vm) |
25 | #:use-module (gnu services) | |
533bc514 CL |
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) | |
c1816361 LC |
31 | #:use-module (guix modules) |
32 | #:export (%test-prosody | |
dcad57d5 EF |
33 | %test-bitlbee |
34 | %test-quassel)) | |
533bc514 | 35 | |
533bc514 CL |
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." | |
8b113790 LC |
38 | (define os |
39 | (marionette-operating-system | |
39d7fdce | 40 | (simple-operating-system (service dhcp-client-service-type) |
8b113790 LC |
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. | |
c24b1547 | 107 | (test-assert "service running" |
8b113790 LC |
108 | (marionette-eval |
109 | '(begin | |
110 | (use-modules (gnu services herd)) | |
c24b1547 | 111 | (start-service 'xmpp-daemon)) |
8b113790 LC |
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)) | |
533bc514 CL |
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 | |
5c22f372 | 151 | (disable-sasl-mechanisms '()) |
533bc514 CL |
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))))) | |
c1816361 LC |
163 | |
164 | \f | |
165 | ;;; | |
166 | ;;; BitlBee. | |
167 | ;;; | |
168 | ||
169 | (define (run-bitlbee-test) | |
170 | (define os | |
171 | (marionette-operating-system | |
39d7fdce | 172 | (simple-operating-system (service dhcp-client-service-type) |
c1816361 LC |
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 | ||
c24b1547 | 199 | (test-assert "service started" |
c1816361 LC |
200 | (marionette-eval |
201 | '(begin | |
202 | (use-modules (gnu services herd)) | |
c24b1547 | 203 | (start-service 'bitlbee)) |
c1816361 LC |
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)))) | |
dcad57d5 EF |
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)))) |