Commit | Line | Data |
---|---|---|
5d8c2c00 SS |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2021 Simon South <simon@simonsouth.net> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | ;;; | |
20 | ;;; The Transmission Daemon service. | |
21 | ;;; | |
22 | ||
23 | (define-module (gnu tests file-sharing) | |
24 | #:use-module (gnu packages bittorrent) | |
25 | #:use-module (gnu services) | |
26 | #:use-module (gnu services file-sharing) | |
27 | #:use-module (gnu services networking) | |
28 | #:use-module (gnu system vm) | |
29 | #:use-module (gnu tests) | |
30 | #:use-module (guix gexp) | |
31 | #:export (%test-transmission-daemon)) | |
32 | ||
33 | (define %transmission-daemon-user "transmission") | |
34 | (define %transmission-daemon-group "transmission") | |
35 | ||
36 | (define %transmission-daemon-config-dir "/var/lib/transmission-daemon") | |
37 | (define %transmission-daemon-watch-dir | |
38 | (string-append %transmission-daemon-config-dir "/watch")) | |
39 | (define %transmission-daemon-incomplete-dir | |
40 | (string-append %transmission-daemon-config-dir "/incomplete")) | |
41 | ||
42 | (define %transmission-daemon-settings-file | |
43 | (string-append %transmission-daemon-config-dir "/settings.json")) | |
44 | ||
45 | (define %transmission-daemon-peer-port 51000) ; default is 51413 | |
46 | ||
47 | (define %transmission-daemon-rpc-port 9999) ; default is 9091 | |
48 | (define %transmission-daemon-rpc-username "test-username") | |
49 | (define %transmission-daemon-rpc-password "test-password") | |
50 | ||
51 | (define %transmission-daemon-test-configuration | |
52 | (transmission-daemon-configuration | |
53 | (incomplete-dir-enabled? #t) | |
54 | (incomplete-dir %transmission-daemon-incomplete-dir) | |
55 | ||
56 | (watch-dir-enabled? #t) | |
57 | (watch-dir %transmission-daemon-watch-dir) | |
58 | ||
59 | (peer-port-random-on-start? #f) | |
60 | (peer-port %transmission-daemon-peer-port) | |
61 | ||
62 | (rpc-enabled? #t) | |
63 | (rpc-port %transmission-daemon-rpc-port) | |
64 | (rpc-whitelist-enabled? #f) | |
65 | (rpc-authentication-required? #t) | |
66 | (rpc-username %transmission-daemon-rpc-username) | |
67 | (rpc-password (transmission-password-hash %transmission-daemon-rpc-password | |
68 | "yEK0q3.X")))) | |
69 | ||
70 | (define (run-transmission-daemon-test) | |
71 | (define os | |
72 | (marionette-operating-system | |
73 | (simple-operating-system | |
74 | (service dhcp-client-service-type) | |
75 | (service transmission-daemon-service-type | |
76 | %transmission-daemon-test-configuration)) | |
77 | #:imported-modules '((gnu services herd) | |
78 | (json parser)) | |
79 | #:requirements '(transmission-daemon))) | |
80 | ||
81 | (define test | |
82 | (with-imported-modules '((gnu build marionette)) | |
83 | #~(begin | |
84 | (use-modules (gnu build marionette) | |
85 | (srfi srfi-64)) | |
86 | ||
87 | (define marionette | |
88 | (make-marionette | |
89 | (list #$(virtual-machine | |
90 | (operating-system os) | |
91 | (port-forwardings | |
92 | `((9091 . ,%transmission-daemon-rpc-port))))))) | |
93 | ||
94 | (mkdir #$output) | |
95 | (chdir #$output) | |
96 | ||
97 | (test-begin "transmission-daemon") | |
98 | ||
99 | ;; Make sure the "transmission" user and group have been created. | |
100 | (test-assert "\"transmission\" user exists" | |
101 | (marionette-eval | |
102 | '(begin | |
103 | (getpwnam #$%transmission-daemon-user) | |
104 | #t) | |
105 | marionette)) | |
106 | (test-assert "\"transmission\" group exists" | |
107 | (marionette-eval | |
108 | '(begin | |
109 | (getgrnam #$%transmission-daemon-group) | |
110 | #t) | |
111 | marionette)) | |
112 | ||
113 | ;; Make sure Transmission Daemon's configuration directory has been | |
114 | ;; created with the correct ownership and permissions. | |
115 | (test-assert "configuration directory exists" | |
116 | (marionette-eval | |
117 | '(eq? (stat:type (stat #$%transmission-daemon-config-dir)) | |
118 | 'directory) | |
119 | marionette)) | |
120 | (test-assert "configuration directory has correct ownership" | |
121 | (marionette-eval | |
122 | '(let ((config-dir (stat #$%transmission-daemon-config-dir)) | |
123 | (transmission-user (getpwnam #$%transmission-daemon-user))) | |
124 | (and (eqv? (stat:uid config-dir) | |
125 | (passwd:uid transmission-user)) | |
126 | (eqv? (stat:gid config-dir) | |
127 | (passwd:gid transmission-user)))) | |
128 | marionette)) | |
129 | (test-assert "configuration directory has expected permissions" | |
130 | (marionette-eval | |
131 | '(eqv? (stat:perms (stat #$%transmission-daemon-config-dir)) | |
132 | #o750) | |
133 | marionette)) | |
134 | ||
135 | ;; Make sure the incomplete-downloads and watch directories have been | |
136 | ;; created with the correct ownership and permissions. | |
137 | (test-assert "incomplete-downloads directory exists" | |
138 | (marionette-eval | |
139 | '(eq? (stat:type (stat #$%transmission-daemon-incomplete-dir)) | |
140 | 'directory) | |
141 | marionette)) | |
142 | (test-assert "incomplete-downloads directory has correct ownership" | |
143 | (marionette-eval | |
144 | '(let ((incomplete-dir | |
145 | (stat #$%transmission-daemon-incomplete-dir)) | |
146 | (transmission-user | |
147 | (getpwnam #$%transmission-daemon-user))) | |
148 | (and (eqv? (stat:uid incomplete-dir) | |
149 | (passwd:uid transmission-user)) | |
150 | (eqv? (stat:gid incomplete-dir) | |
151 | (passwd:gid transmission-user)))) | |
152 | marionette)) | |
153 | (test-assert | |
154 | "incomplete-downloads directory has expected permissions" | |
155 | (marionette-eval | |
156 | '(eqv? (stat:perms (stat #$%transmission-daemon-incomplete-dir)) | |
157 | #o750) | |
158 | marionette)) | |
159 | ||
160 | (test-assert "watch directory exists" | |
161 | (marionette-eval | |
162 | '(eq? (stat:type (stat #$%transmission-daemon-watch-dir)) | |
163 | 'directory) | |
164 | marionette)) | |
165 | (test-assert "watch directory has correct ownership" | |
166 | (marionette-eval | |
167 | '(let ((watch-dir (stat #$%transmission-daemon-watch-dir)) | |
168 | (transmission-user (getpwnam #$%transmission-daemon-user))) | |
169 | (and (eqv? (stat:uid watch-dir) | |
170 | (passwd:uid transmission-user)) | |
171 | (eqv? (stat:gid watch-dir) | |
172 | (passwd:gid transmission-user)))) | |
173 | marionette)) | |
174 | (test-assert "watch directory has expected permissions" | |
175 | (marionette-eval | |
176 | '(eqv? (stat:perms (stat #$%transmission-daemon-watch-dir)) | |
177 | #o770) | |
178 | marionette)) | |
179 | ||
180 | ;; Make sure the settings file has been created and appears valid. | |
181 | (test-assert "settings file exists" | |
182 | (marionette-eval | |
183 | '(file-exists? #$%transmission-daemon-settings-file) | |
184 | marionette)) | |
185 | (test-assert "settings file is valid JSON" | |
186 | (marionette-eval | |
187 | '(begin | |
188 | (use-modules (json parser)) | |
189 | (with-input-from-file #$%transmission-daemon-settings-file | |
190 | (lambda () | |
191 | (json->scm))) | |
192 | #t) | |
193 | marionette)) | |
194 | (test-assert "settings file contains a non-empty JSON object" | |
195 | (marionette-eval | |
196 | '(begin | |
197 | (use-modules (json parser) | |
198 | (srfi srfi-1)) | |
199 | (let ((settings (with-input-from-file | |
200 | #$%transmission-daemon-settings-file | |
201 | (lambda () | |
202 | (json->scm))))) | |
203 | (and (list? settings) | |
204 | (not (null? settings)) | |
205 | (every pair? settings)))) | |
206 | marionette)) | |
207 | ||
208 | ;; Make sure Transmission Daemon is running. | |
209 | (test-assert "transmission-daemon is running" | |
210 | (marionette-eval | |
211 | '(begin | |
212 | (use-modules (gnu services herd)) | |
213 | (live-service-running | |
214 | (find (lambda (live-service) | |
215 | (memq 'transmission-daemon | |
216 | (live-service-provision live-service))) | |
217 | (current-services)))) | |
218 | marionette)) | |
219 | ||
220 | ;; Make sure the daemon is listening for peer connections. | |
221 | (test-assert "transmission-daemon is listening for peers" | |
222 | (wait-for-tcp-port #$%transmission-daemon-peer-port marionette)) | |
223 | ||
224 | ;; Make sure the daemon is listening for RPC-client connections. | |
225 | (test-assert "transmission-daemon is listening for RPC clients" | |
226 | (wait-for-tcp-port #$%transmission-daemon-rpc-port marionette)) | |
227 | ||
228 | ;; Make sure the RPC-authentication settings are honored. | |
229 | (test-assert "transmission-daemon requires RPC authentication" | |
230 | (let ((transmission-remote | |
231 | (string-append #+transmission "/bin/transmission-remote"))) | |
232 | (with-error-to-port (%make-void-port "w") | |
233 | (lambda () | |
234 | (not (zero? (system* transmission-remote | |
235 | "--session-info"))))))) | |
236 | (test-assert "transmission-daemon rejects incorrect RPC credentials" | |
237 | (let ((transmission-remote | |
238 | (string-append #+transmission "/bin/transmission-remote")) | |
239 | (wrong-auth-string | |
240 | (string-append #$%transmission-daemon-rpc-username | |
241 | ":" | |
242 | "wrong-" | |
243 | #$%transmission-daemon-rpc-password))) | |
244 | (with-error-to-port (%make-void-port "w") | |
245 | (lambda () | |
246 | (not (zero? (system* transmission-remote | |
247 | "--auth" wrong-auth-string | |
248 | "--session-info"))))))) | |
249 | (test-assert "transmission-daemon accepts correct RPC credentials" | |
250 | (let ((transmission-remote | |
251 | (string-append #+transmission "/bin/transmission-remote")) | |
252 | (auth-string | |
253 | (string-append #$%transmission-daemon-rpc-username | |
254 | ":" | |
255 | #$%transmission-daemon-rpc-password))) | |
256 | (with-output-to-port (%make-void-port "w") | |
257 | (lambda () | |
258 | (zero? (system* transmission-remote | |
259 | "--auth" auth-string | |
260 | "--session-info")))))) | |
261 | ||
262 | (test-end) | |
263 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
264 | ||
265 | (gexp->derivation "transmission-daemon-test" test)) | |
266 | ||
267 | (define %test-transmission-daemon | |
268 | (system-test | |
269 | (name "transmission-daemon") | |
270 | (description "Test a running Transmission Daemon service.") | |
271 | (value (run-transmission-daemon-test)))) |