projects/guix·blob python-team · refs

268 lines · 11.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Simon South <[email protected]>
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 dhcpcd-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 (test-runner-current (system-test-runner #$output))
95 (test-begin "transmission-daemon")
96
97 ;; Make sure the "transmission" user and group have been created.
98 (test-assert "\"transmission\" user exists"
99 (marionette-eval
100 '(begin
101 (getpwnam #$%transmission-daemon-user)
102 #t)
103 marionette))
104 (test-assert "\"transmission\" group exists"
105 (marionette-eval
106 '(begin
107 (getgrnam #$%transmission-daemon-group)
108 #t)
109 marionette))
110
111 ;; Make sure Transmission Daemon's configuration directory has been
112 ;; created with the correct ownership and permissions.
113 (test-assert "configuration directory exists"
114 (marionette-eval
115 '(eq? (stat:type (stat #$%transmission-daemon-config-dir))
116 'directory)
117 marionette))
118 (test-assert "configuration directory has correct ownership"
119 (marionette-eval
120 '(let ((config-dir (stat #$%transmission-daemon-config-dir))
121 (transmission-user (getpwnam #$%transmission-daemon-user)))
122 (and (eqv? (stat:uid config-dir)
123 (passwd:uid transmission-user))
124 (eqv? (stat:gid config-dir)
125 (passwd:gid transmission-user))))
126 marionette))
127 (test-assert "configuration directory has expected permissions"
128 (marionette-eval
129 '(eqv? (stat:perms (stat #$%transmission-daemon-config-dir))
130 #o750)
131 marionette))
132
133 ;; Make sure the incomplete-downloads and watch directories have been
134 ;; created with the correct ownership and permissions.
135 (test-assert "incomplete-downloads directory exists"
136 (marionette-eval
137 '(eq? (stat:type (stat #$%transmission-daemon-incomplete-dir))
138 'directory)
139 marionette))
140 (test-assert "incomplete-downloads directory has correct ownership"
141 (marionette-eval
142 '(let ((incomplete-dir
143 (stat #$%transmission-daemon-incomplete-dir))
144 (transmission-user
145 (getpwnam #$%transmission-daemon-user)))
146 (and (eqv? (stat:uid incomplete-dir)
147 (passwd:uid transmission-user))
148 (eqv? (stat:gid incomplete-dir)
149 (passwd:gid transmission-user))))
150 marionette))
151 (test-assert
152 "incomplete-downloads directory has expected permissions"
153 (marionette-eval
154 '(eqv? (stat:perms (stat #$%transmission-daemon-incomplete-dir))
155 #o750)
156 marionette))
157
158 (test-assert "watch directory exists"
159 (marionette-eval
160 '(eq? (stat:type (stat #$%transmission-daemon-watch-dir))
161 'directory)
162 marionette))
163 (test-assert "watch directory has correct ownership"
164 (marionette-eval
165 '(let ((watch-dir (stat #$%transmission-daemon-watch-dir))
166 (transmission-user (getpwnam #$%transmission-daemon-user)))
167 (and (eqv? (stat:uid watch-dir)
168 (passwd:uid transmission-user))
169 (eqv? (stat:gid watch-dir)
170 (passwd:gid transmission-user))))
171 marionette))
172 (test-assert "watch directory has expected permissions"
173 (marionette-eval
174 '(eqv? (stat:perms (stat #$%transmission-daemon-watch-dir))
175 #o770)
176 marionette))
177
178 ;; Make sure the settings file has been created and appears valid.
179 (test-assert "settings file exists"
180 (marionette-eval
181 '(file-exists? #$%transmission-daemon-settings-file)
182 marionette))
183 (test-assert "settings file is valid JSON"
184 (marionette-eval
185 '(begin
186 (use-modules (json parser))
187 (with-input-from-file #$%transmission-daemon-settings-file
188 (lambda ()
189 (json->scm)))
190 #t)
191 marionette))
192 (test-assert "settings file contains a non-empty JSON object"
193 (marionette-eval
194 '(begin
195 (use-modules (json parser)
196 (srfi srfi-1))
197 (let ((settings (with-input-from-file
198 #$%transmission-daemon-settings-file
199 (lambda ()
200 (json->scm)))))
201 (and (list? settings)
202 (not (null? settings))
203 (every pair? settings))))
204 marionette))
205
206 ;; Make sure Transmission Daemon is running.
207 (test-assert "transmission-daemon is running"
208 (marionette-eval
209 '(begin
210 (use-modules (gnu services herd))
211 (live-service-running
212 (find (lambda (live-service)
213 (memq 'transmission-daemon
214 (live-service-provision live-service)))
215 (current-services))))
216 marionette))
217
218 ;; Make sure the daemon is listening for peer connections.
219 (test-assert "transmission-daemon is listening for peers"
220 (wait-for-tcp-port #$%transmission-daemon-peer-port marionette))
221
222 ;; Make sure the daemon is listening for RPC-client connections.
223 (test-assert "transmission-daemon is listening for RPC clients"
224 (wait-for-tcp-port #$%transmission-daemon-rpc-port marionette))
225
226 ;; Make sure the RPC-authentication settings are honored.
227 (test-assert "transmission-daemon requires RPC authentication"
228 (let ((transmission-remote
229 (string-append #+transmission "/bin/transmission-remote")))
230 (with-error-to-port (%make-void-port "w")
231 (lambda ()
232 (not (zero? (system* transmission-remote
233 "--session-info")))))))
234 (test-assert "transmission-daemon rejects incorrect RPC credentials"
235 (let ((transmission-remote
236 (string-append #+transmission "/bin/transmission-remote"))
237 (wrong-auth-string
238 (string-append #$%transmission-daemon-rpc-username
239 ":"
240 "wrong-"
241 #$%transmission-daemon-rpc-password)))
242 (with-error-to-port (%make-void-port "w")
243 (lambda ()
244 (not (zero? (system* transmission-remote
245 "--auth" wrong-auth-string
246 "--session-info")))))))
247 (test-assert "transmission-daemon accepts correct RPC credentials"
248 (let ((transmission-remote
249 (string-append #+transmission "/bin/transmission-remote"))
250 (auth-string
251 (string-append #$%transmission-daemon-rpc-username
252 ":"
253 #$%transmission-daemon-rpc-password)))
254 (with-output-to-port (%make-void-port "w")
255 (lambda ()
256 (zero? (system* transmission-remote
257 "--auth" auth-string
258 "--session-info"))))))
259
260 (test-end))))
261
262 (gexp->derivation "transmission-daemon-test" test))
263
264(define %test-transmission-daemon
265 (system-test
266 (name "transmission-daemon")
267 (description "Test a running Transmission Daemon service.")
268 (value (run-transmission-daemon-test))))