Commit | Line | Data |
---|---|---|
533bc514 | 1 | ;;; GNU Guix --- Functional package management for GNU |
c24b1547 | 2 | ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> |
211fe3f6 | 3 | ;;; Copyright © 2017-2018, 2021-2022 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 | ||
89b05442 | 101 | (test-runner-current (system-test-runner #$output)) |
8b113790 LC |
102 | (test-begin "xmpp") |
103 | ||
104 | ;; Wait for XMPP service to be up and running. | |
c24b1547 | 105 | (test-assert "service running" |
8b113790 LC |
106 | (marionette-eval |
107 | '(begin | |
108 | (use-modules (gnu services herd)) | |
c24b1547 | 109 | (start-service 'xmpp-daemon)) |
8b113790 LC |
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 | ||
1fb75128 | 129 | (test-end)))) |
8b113790 LC |
130 | |
131 | (gexp->derivation name test)) | |
533bc514 CL |
132 | |
133 | (define %create-prosody-account | |
134 | (program-file | |
135 | "create-account" | |
136 | #~(begin | |
137 | (use-modules (ice-9 match)) | |
138 | (match (command-line) | |
139 | ((command jid password) | |
140 | (let ((password-input (format #f "\"~a~%~a\"" password password)) | |
141 | (prosodyctl #$(file-append prosody "/bin/prosodyctl"))) | |
142 | (system (string-join | |
143 | `("echo" ,password-input "|" ,prosodyctl "adduser" ,jid) | |
144 | " ")))))))) | |
145 | ||
146 | (define %test-prosody | |
147 | (let* ((config (prosody-configuration | |
5c22f372 | 148 | (disable-sasl-mechanisms '()) |
533bc514 CL |
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))))) | |
c1816361 LC |
160 | |
161 | \f | |
162 | ;;; | |
163 | ;;; BitlBee. | |
164 | ;;; | |
165 | ||
166 | (define (run-bitlbee-test) | |
167 | (define os | |
168 | (marionette-operating-system | |
39d7fdce | 169 | (simple-operating-system (service dhcp-client-service-type) |
c1816361 LC |
170 | (service bitlbee-service-type |
171 | (bitlbee-configuration | |
172 | (interface "0.0.0.0")))) | |
173 | #:imported-modules (source-module-closure | |
174 | '((gnu services herd))))) | |
175 | ||
176 | (define vm | |
177 | (virtual-machine | |
178 | (operating-system os) | |
179 | (port-forwardings `((6667 . 6667))))) | |
180 | ||
181 | (define test | |
182 | (with-imported-modules '((gnu build marionette)) | |
183 | #~(begin | |
184 | (use-modules (ice-9 rdelim) | |
185 | (srfi srfi-64) | |
186 | (gnu build marionette)) | |
187 | ||
188 | (define marionette | |
189 | (make-marionette (list #$vm))) | |
190 | ||
89b05442 | 191 | (test-runner-current (system-test-runner #$output)) |
c1816361 LC |
192 | (test-begin "bitlbee") |
193 | ||
c24b1547 | 194 | (test-assert "service started" |
c1816361 LC |
195 | (marionette-eval |
196 | '(begin | |
197 | (use-modules (gnu services herd)) | |
c24b1547 | 198 | (start-service 'bitlbee)) |
c1816361 LC |
199 | marionette)) |
200 | ||
c1816361 LC |
201 | (test-assert "connect" |
202 | (let* ((address (make-socket-address AF_INET INADDR_LOOPBACK | |
203 | 6667)) | |
204 | (sock (socket AF_INET SOCK_STREAM 0))) | |
205 | (connect sock address) | |
206 | ;; See <https://tools.ietf.org/html/rfc1459>. | |
207 | (->bool (string-contains (pk 'message (read-line sock)) | |
208 | "BitlBee")))) | |
209 | ||
1fb75128 | 210 | (test-end)))) |
c1816361 LC |
211 | |
212 | (gexp->derivation "bitlbee-test" test)) | |
213 | ||
214 | (define %test-bitlbee | |
215 | (system-test | |
216 | (name "bitlbee") | |
217 | (description "Connect to a BitlBee IRC server.") | |
218 | (value (run-bitlbee-test)))) | |
dcad57d5 EF |
219 | |
220 | (define (run-quassel-test) | |
221 | (define os | |
222 | (marionette-operating-system | |
223 | (simple-operating-system (service dhcp-client-service-type) | |
224 | (service quassel-service-type)) | |
225 | #:imported-modules (source-module-closure | |
226 | '((gnu services herd))))) | |
227 | ||
228 | (define vm | |
229 | (virtual-machine | |
230 | (operating-system os) | |
231 | (port-forwardings `((4242 . 4242))))) | |
232 | ||
233 | (define test | |
234 | (with-imported-modules '((gnu build marionette)) | |
235 | #~(begin | |
236 | (use-modules (srfi srfi-64) | |
237 | (gnu build marionette)) | |
238 | ||
239 | (define marionette | |
240 | (make-marionette (list #$vm))) | |
241 | ||
89b05442 | 242 | (test-runner-current (system-test-runner #$output)) |
dcad57d5 EF |
243 | (test-begin "quassel") |
244 | ||
245 | (test-assert "service started" | |
246 | (marionette-eval | |
247 | '(begin | |
248 | (use-modules (gnu services herd)) | |
249 | (start-service 'quassel)) | |
250 | marionette)) | |
251 | ||
252 | (test-assert "certificate file" | |
253 | (marionette-eval | |
254 | '(file-exists? "/var/lib/quassel/quasselCert.pem") | |
255 | marionette)) | |
256 | ||
1fb75128 | 257 | (test-end)))) |
dcad57d5 EF |
258 | |
259 | (gexp->derivation "quassel-test" test)) | |
260 | ||
261 | (define %test-quassel | |
262 | (system-test | |
263 | (name "quassel") | |
264 | (description "Connect to a quassel IRC server.") | |
265 | (value (run-quassel-test)))) |