Commit | Line | Data |
---|---|---|
db6b9d2f SS |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2020 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 | (define-module (gnu services file-sharing) | |
20 | #:use-module (gcrypt base16) | |
21 | #:use-module (gcrypt hash) | |
22 | #:use-module (gcrypt random) | |
23 | #:use-module (gnu services) | |
24 | #:use-module (gnu services admin) | |
25 | #:use-module (gnu services configuration) | |
26 | #:use-module (gnu services shepherd) | |
27 | #:use-module (gnu packages admin) | |
28 | #:use-module (gnu packages bittorrent) | |
29 | #:use-module (gnu packages gnupg) | |
30 | #:use-module (gnu packages guile) | |
31 | #:use-module (gnu system shadow) | |
32 | #:use-module (guix diagnostics) | |
33 | #:use-module (guix gexp) | |
34 | #:use-module (guix i18n) | |
35 | #:use-module (guix modules) | |
36 | #:use-module (guix packages) | |
37 | #:use-module (guix records) | |
38 | #:use-module (ice-9 format) | |
39 | #:use-module (ice-9 match) | |
40 | #:use-module (rnrs bytevectors) | |
41 | #:use-module (srfi srfi-1) | |
42 | #:use-module (srfi srfi-34) | |
43 | #:use-module (srfi srfi-35) | |
44 | #:export (transmission-daemon-configuration | |
45 | transmission-daemon-service-type | |
46 | transmission-password-hash | |
47 | transmission-random-salt)) | |
48 | ||
49 | ;;; | |
50 | ;;; Transmission Daemon. | |
51 | ;;; | |
52 | ||
53 | (define %transmission-daemon-user "transmission") | |
54 | (define %transmission-daemon-group "transmission") | |
55 | ||
56 | (define %transmission-daemon-configuration-directory | |
57 | "/var/lib/transmission-daemon") | |
58 | (define %transmission-daemon-log-file | |
59 | "/var/log/transmission.log") | |
60 | ||
61 | (define %transmission-salt-length 8) | |
62 | ||
63 | (define (transmission-password-hash password salt) | |
64 | "Returns a string containing the result of hashing @var{password} together | |
65 | with @var{salt}, in the format recognized by Transmission clients for their | |
66 | @code{rpc-password} configuration setting. | |
67 | ||
68 | @var{salt} must be an eight-character string. The | |
69 | @code{transmission-random-salt} procedure can be used to generate a suitable | |
70 | salt value at random." | |
71 | (if (not (and (string? salt) | |
72 | (eq? (string-length salt) %transmission-salt-length))) | |
73 | (raise (formatted-message | |
74 | (G_ "salt value must be a string of ~d characters") | |
75 | %transmission-salt-length)) | |
76 | (string-append "{" | |
77 | (bytevector->base16-string | |
78 | (sha1 (string->utf8 (string-append password salt)))) | |
79 | salt))) | |
80 | ||
81 | (define (transmission-random-salt) | |
82 | "Returns a string containing a random, eight-character salt value of the | |
83 | type generated and used by Transmission clients, suitable for passing to the | |
84 | @code{transmission-password-hash} procedure." | |
85 | ;; This implementation matches a portion of Transmission's tr_ssha1 | |
86 | ;; function. See libtransmission/crypto-utils.c in the Transmission source | |
87 | ;; distribution. | |
88 | (let ((salter (string-append "0123456789" | |
89 | "abcdefghijklmnopqrstuvwxyz" | |
90 | "ABCDEFGHIJKLMNOPQRSTUVWXYZ" | |
91 | "./"))) | |
92 | (list->string | |
93 | (map (lambda (u8) | |
94 | (string-ref salter (modulo u8 (string-length salter)))) | |
95 | (bytevector->u8-list | |
96 | (gen-random-bv %transmission-salt-length %gcry-strong-random)))))) | |
97 | ||
98 | (define (uglify-field-name field-name) | |
99 | (string-delete #\? (symbol->string field-name))) | |
100 | ||
101 | (define (serialize-field field-name val) | |
102 | ;; "Serialize" each configuration field as a G-expression containing a | |
103 | ;; name-value pair, the collection of which will subsequently be serialized | |
104 | ;; to disk as a JSON object. | |
105 | #~(#$(uglify-field-name field-name) . #$val)) | |
106 | ||
107 | (define serialize-boolean serialize-field) | |
108 | (define serialize-integer serialize-field) | |
109 | (define serialize-rational serialize-field) | |
110 | ||
111 | (define serialize-string serialize-field) | |
112 | (define-maybe string) | |
113 | ;; Override the definition of "serialize-maybe-string", as we need to output a | |
114 | ;; name-value pair for the JSON builder. | |
115 | (set! serialize-maybe-string | |
116 | (lambda (field-name val) | |
117 | (serialize-string field-name | |
118 | (if (and (symbol? val) | |
119 | (eq? val 'disabled)) | |
120 | "" | |
121 | val)))) | |
122 | ||
123 | (define (string-list? val) | |
124 | (and (list? val) | |
125 | (and-map (lambda (x) | |
126 | (and (string? x) | |
127 | (not (string-index x #\,)))) | |
128 | val))) | |
129 | (define (serialize-string-list field-name val) | |
130 | (serialize-field field-name (string-join val ","))) | |
131 | ||
132 | (define days | |
133 | '((sunday . #b0000001) | |
134 | (monday . #b0000010) | |
135 | (tuesday . #b0000100) | |
136 | (wednesday . #b0001000) | |
137 | (thursday . #b0010000) | |
138 | (friday . #b0100000) | |
139 | (saturday . #b1000000))) | |
140 | (define day-lists | |
141 | (list (cons 'weekdays '(monday tuesday wednesday thursday friday)) | |
142 | (cons 'weekends '(saturday sunday)) | |
143 | (cons 'all (map car days)))) | |
144 | (define (day-list? val) | |
145 | (or (and (symbol? val) | |
146 | (assq val day-lists)) | |
147 | (and (list? val) | |
148 | (and-map (lambda (x) | |
149 | (and (symbol? x) | |
150 | (assq x days))) | |
151 | val)))) | |
152 | (define (serialize-day-list field-name val) | |
153 | (serialize-integer field-name | |
154 | (reduce logior | |
155 | #b0000000 | |
156 | (map (lambda (day) | |
157 | (assq-ref days day)) | |
158 | (if (symbol? val) | |
159 | (assq-ref day-lists val) | |
160 | val))))) | |
161 | ||
162 | (define encryption-modes | |
163 | '((prefer-unencrypted-connections . 0) | |
164 | (prefer-encrypted-connections . 1) | |
165 | (require-encrypted-connections . 2))) | |
166 | (define (encryption-mode? val) | |
167 | (and (symbol? val) | |
168 | (assq val encryption-modes))) | |
169 | (define (serialize-encryption-mode field-name val) | |
170 | (serialize-integer field-name (assq-ref encryption-modes val))) | |
171 | ||
172 | (define serialize-file-like serialize-field) | |
173 | ||
174 | (define (file-object? val) | |
175 | (or (string? val) | |
176 | (file-like? val))) | |
177 | (define (serialize-file-object field-name val) | |
178 | (if (file-like? val) | |
179 | (serialize-file-like field-name val) | |
180 | (serialize-string field-name val))) | |
181 | (define-maybe file-object) | |
182 | (set! serialize-maybe-file-object | |
183 | (lambda (field-name val) | |
184 | (if (and (symbol? val) | |
185 | (eq? val 'disabled)) | |
186 | (serialize-string field-name "") | |
187 | (serialize-file-object field-name val)))) | |
188 | ||
189 | (define (file-object-list? val) | |
190 | (and (list? val) | |
191 | (and-map file-object? val))) | |
192 | (define serialize-file-object-list serialize-field) | |
193 | ||
194 | (define message-levels | |
195 | '((none . 0) | |
196 | (error . 1) | |
197 | (info . 2) | |
198 | (debug . 3))) | |
199 | (define (message-level? val) | |
200 | (and (symbol? val) | |
201 | (assq val message-levels))) | |
202 | (define (serialize-message-level field-name val) | |
203 | (serialize-integer field-name (assq-ref message-levels val))) | |
204 | ||
205 | (define (non-negative-integer? val) | |
206 | (and (integer? val) | |
207 | (not (negative? val)))) | |
208 | (define serialize-non-negative-integer serialize-integer) | |
209 | ||
210 | (define (non-negative-rational? val) | |
211 | (and (rational? val) | |
212 | (not (negative? val)))) | |
213 | (define serialize-non-negative-rational serialize-rational) | |
214 | ||
215 | (define (port-number? val) | |
216 | (and (integer? val) | |
217 | (>= val 1) | |
218 | (<= val 65535))) | |
219 | (define serialize-port-number serialize-integer) | |
220 | ||
221 | (define preallocation-modes | |
222 | '((none . 0) | |
223 | (fast . 1) | |
224 | (sparse . 1) | |
225 | (full . 2))) | |
226 | (define (preallocation-mode? val) | |
227 | (and (symbol? val) | |
228 | (assq val preallocation-modes))) | |
229 | (define (serialize-preallocation-mode field-name val) | |
230 | (serialize-integer field-name (assq-ref preallocation-modes val))) | |
231 | ||
232 | (define tcp-types-of-service | |
233 | '((default . "default") | |
234 | (low-cost . "lowcost") | |
235 | (throughput . "throughput") | |
236 | (low-delay . "lowdelay") | |
237 | (reliability . "reliability"))) | |
238 | (define (tcp-type-of-service? val) | |
239 | (and (symbol? val) | |
240 | (assq val tcp-types-of-service))) | |
241 | (define (serialize-tcp-type-of-service field-name val) | |
242 | (serialize-string field-name (assq-ref tcp-types-of-service val))) | |
243 | ||
244 | (define (transmission-password-hash? val) | |
245 | (and (string? val) | |
246 | (= (string-length val) 49) | |
247 | (eqv? (string-ref val 0) #\{) | |
248 | (string-every char-set:hex-digit val 1 41))) | |
249 | (define serialize-transmission-password-hash serialize-string) | |
250 | (define-maybe transmission-password-hash) | |
251 | (set! serialize-maybe-transmission-password-hash serialize-maybe-string) | |
252 | ||
253 | (define (umask? val) | |
254 | (and (integer? val) | |
255 | (>= val #o000) | |
256 | (<= val #o777))) | |
257 | (define serialize-umask serialize-integer) ; must use decimal representation | |
258 | ||
259 | (define-configuration transmission-daemon-configuration | |
260 | ;; Settings internal to this service definition. | |
261 | (transmission | |
262 | (package transmission) | |
263 | "The Transmission package to use.") | |
264 | (stop-wait-period | |
265 | (non-negative-integer 10) | |
266 | "The period, in seconds, to wait when stopping the service for | |
267 | @command{transmission-daemon} to exit before killing its process. This allows | |
268 | the daemon time to complete its housekeeping and send a final update to | |
269 | trackers as it shuts down. On slow hosts, or hosts with a slow network | |
270 | connection, this value may need to be increased.") | |
271 | ||
272 | ;; Files and directories. | |
273 | (download-dir | |
274 | (string (string-append %transmission-daemon-configuration-directory | |
275 | "/downloads")) | |
276 | "The directory to which torrent files are downloaded.") | |
277 | (incomplete-dir-enabled? | |
278 | (boolean #f) | |
279 | "If @code{#t}, files will be held in @code{incomplete-dir} while their | |
280 | torrent is being downloaded, then moved to @code{download-dir} once the | |
281 | torrent is complete. Otherwise, files for all torrents (including those still | |
282 | being downloaded) will be placed in @code{download-dir}.") | |
283 | (incomplete-dir | |
284 | (maybe-string 'disabled) | |
285 | "The directory in which files from incompletely downloaded torrents will be | |
286 | held when @code{incomplete-dir-enabled?} is @code{#t}.") | |
287 | (umask | |
288 | (umask #o022) | |
289 | "The file mode creation mask used for downloaded files. (See the | |
290 | @command{umask} man page for more information.)") | |
291 | (rename-partial-files? | |
292 | (boolean #t) | |
293 | "When @code{#t}, ``.part'' is appended to the name of partially downloaded | |
294 | files.") | |
295 | (preallocation | |
296 | (preallocation-mode 'fast) | |
297 | "The mode by which space should be preallocated for downloaded files, one | |
298 | of @code{none}, @code{fast} (or @code{sparse}) and @code{full}. Specifying | |
299 | @code{full} will minimize disk fragmentation at a cost to file-creation | |
300 | speed.") | |
301 | (watch-dir-enabled? | |
302 | (boolean #f) | |
303 | "If @code{#t}, the directory specified by @code{watch-dir} will be watched | |
304 | for new @file{.torrent} files and the torrents they describe added | |
305 | automatically (and the original files removed, if | |
306 | @code{trash-original-torrent-files?} is @code{#t}).") | |
307 | (watch-dir | |
308 | (maybe-string 'disabled) | |
309 | "The directory to be watched for @file{.torrent} files indicating new | |
310 | torrents to be added, when @code{watch-dir-enabled} is @code{#t}.") | |
311 | (trash-original-torrent-files? | |
312 | (boolean #f) | |
313 | "When @code{#t}, @file{.torrent} files will be deleted from the watch | |
314 | directory once their torrent has been added (see | |
315 | @code{watch-directory-enabled?}).") | |
316 | ||
317 | ;; Bandwidth limits. | |
318 | (speed-limit-down-enabled? | |
319 | (boolean #f) | |
320 | "When @code{#t}, the daemon's download speed will be limited to the rate | |
321 | specified by @code{speed-limit-down}.") | |
322 | (speed-limit-down | |
323 | (non-negative-integer 100) | |
324 | "The default global-maximum download speed, in kilobytes per second.") | |
325 | (speed-limit-up-enabled? | |
326 | (boolean #f) | |
327 | "When @code{#t}, the daemon's upload speed will be limited to the rate | |
328 | specified by @code{speed-limit-up}.") | |
329 | (speed-limit-up | |
330 | (non-negative-integer 100) | |
331 | "The default global-maximum upload speed, in kilobytes per second.") | |
332 | (alt-speed-enabled? | |
333 | (boolean #f) | |
334 | "When @code{#t}, the alternate speed limits @code{alt-speed-down} and | |
335 | @code{alt-speed-up} are used (in place of @code{speed-limit-down} and | |
336 | @code{speed-limit-up}, if they are enabled) to constrain the daemon's | |
337 | bandwidth usage. This can be scheduled to occur automatically at certain | |
338 | times during the week; see @code{alt-speed-time-enabled?}.") | |
339 | (alt-speed-down | |
340 | (non-negative-integer 50) | |
341 | "The alternate global-maximum download speed, in kilobytes per second.") | |
342 | (alt-speed-up | |
343 | (non-negative-integer 50) | |
344 | "The alternate global-maximum upload speed, in kilobytes per second.") | |
345 | ||
346 | ;; Bandwidth-limit scheduling. | |
347 | (alt-speed-time-enabled? | |
348 | (boolean #f) | |
349 | "When @code{#t}, the alternate speed limits @code{alt-speed-down} and | |
350 | @code{alt-speed-up} will be enabled automatically during the periods specified | |
351 | by @code{alt-speed-time-day}, @code{alt-speed-time-begin} and | |
352 | @code{alt-time-speed-end}.") | |
353 | (alt-speed-time-day | |
354 | (day-list 'all) | |
355 | "The days of the week on which the alternate-speed schedule should be used, | |
356 | specified either as a list of days (@code{sunday}, @code{monday}, and so on) | |
357 | or using one of the symbols @code{weekdays}, @code{weekends} or @code{all}.") | |
358 | (alt-speed-time-begin | |
359 | (non-negative-integer 540) | |
360 | "The time of day at which to enable the alternate speed limits, | |
361 | expressed as a number of minutes since midnight.") | |
362 | (alt-speed-time-end | |
363 | (non-negative-integer 1020) | |
364 | "The time of day at which to disable the alternate speed limits, | |
365 | expressed as a number of minutes since midnight.") | |
366 | ||
367 | ;; Peer networking. | |
368 | (bind-address-ipv4 | |
369 | (string "0.0.0.0") | |
370 | "The IP address at which to listen for peer connections, or ``0.0.0.0'' to | |
371 | listen at all available IP addresses.") | |
372 | (bind-address-ipv6 | |
373 | (string "::") | |
374 | "The IPv6 address at which to listen for peer connections, or ``::'' to | |
375 | listen at all available IPv6 addresses.") | |
376 | (peer-port-random-on-start? | |
377 | (boolean #f) | |
378 | "If @code{#t}, when the daemon starts it will select a port at random on | |
379 | which to listen for peer connections, from the range specified (inclusively) | |
380 | by @code{peer-port-random-low} and @code{peer-port-random-high}. Otherwise, | |
381 | it listens on the port specified by @code{peer-port}.") | |
382 | (peer-port-random-low | |
383 | (port-number 49152) | |
384 | "The lowest selectable port number when @code{peer-port-random-on-start?} | |
385 | is @code{#t}.") | |
386 | (peer-port-random-high | |
387 | (port-number 65535) | |
388 | "The highest selectable port number when @code{peer-port-random-on-start} | |
389 | is @code{#t}.") | |
390 | (peer-port | |
391 | (port-number 51413) | |
392 | "The port on which to listen for peer connections when | |
393 | @code{peer-port-random-on-start?} is @code{#f}.") | |
394 | (port-forwarding-enabled? | |
395 | (boolean #t) | |
396 | "If @code{#t}, the daemon will attempt to configure port-forwarding on an | |
397 | upstream gateway automatically using @acronym{UPnP} and @acronym{NAT-PMP}.") | |
398 | (encryption | |
399 | (encryption-mode 'prefer-encrypted-connections) | |
400 | "The encryption preference for peer connections, one of | |
401 | @code{prefer-unencrypted-connections}, @code{prefer-encrypted-connections} or | |
402 | @code{require-encrypted-connections}.") | |
403 | (peer-congestion-algorithm | |
404 | (maybe-string 'disabled) | |
405 | "The TCP congestion-control algorithm to use for peer connections, | |
406 | specified using a string recognized by the operating system in calls to | |
407 | @code{setsockopt} (or set to @code{disabled}, in which case the | |
408 | operating-system default is used). | |
409 | ||
410 | Note that on GNU/Linux systems, the kernel must be configured to allow | |
411 | processes to use a congestion-control algorithm not in the default set; | |
412 | otherwise, it will deny these requests with ``Operation not permitted''. To | |
413 | see which algorithms are available on your system and which are currently | |
414 | permitted for use, look at the contents of the files | |
415 | @file{tcp_available_congestion_control} and | |
416 | @file{tcp_allowed_congestion_control} in the @file{/proc/sys/net/ipv4} | |
417 | directory. | |
418 | ||
419 | As an example, to have Transmission Daemon use | |
420 | @uref{http://www-ece.rice.edu/networks/TCP-LP/, the TCP Low Priority | |
421 | congestion-control algorithm}, you'll need to modify your kernel configuration | |
422 | to build in support for the algorithm, then update your operating-system | |
423 | configuration to allow its use by adding a @code{sysctl-service-type} | |
424 | service (or updating the existing one's configuration) with lines like the | |
425 | following: | |
426 | ||
427 | @lisp | |
428 | (service sysctl-service-type | |
429 | (sysctl-configuration | |
430 | (settings | |
431 | (\"net.ipv4.tcp_allowed_congestion_control\" . | |
432 | \"reno cubic lp\")))) | |
433 | @end lisp | |
434 | ||
435 | The Transmission Daemon configuration can then be updated with | |
436 | ||
437 | @lisp | |
438 | (peer-congestion-algorithm \"lp\") | |
439 | @end lisp | |
440 | ||
441 | and the system reconfigured to have the changes take effect.") | |
442 | (peer-socket-tos | |
443 | (tcp-type-of-service 'default) | |
444 | "The type of service to request in outgoing @acronym{TCP} packets, | |
445 | one of @code{default}, @code{low-cost}, @code{throughput}, @code{low-delay} | |
446 | and @code{reliability}.") | |
447 | (peer-limit-global | |
448 | (non-negative-integer 200) | |
449 | "The global limit on the number of connected peers.") | |
450 | (peer-limit-per-torrent | |
451 | (non-negative-integer 50) | |
452 | "The per-torrent limit on the number of connected peers.") | |
453 | (upload-slots-per-torrent | |
454 | (non-negative-integer 14) | |
455 | "The maximum number of peers to which the daemon will upload data | |
456 | simultaneously for each torrent.") | |
457 | (peer-id-ttl-hours | |
458 | (non-negative-integer 6) | |
459 | "The maximum lifespan, in hours, of the peer ID associated with each public | |
460 | torrent before it is regenerated.") | |
461 | ||
462 | ;; Peer blocklists. | |
463 | (blocklist-enabled? | |
464 | (boolean #f) | |
465 | "When @code{#t}, the daemon will ignore peers mentioned in the blocklist it | |
466 | has most recently downloaded from @code{blocklist-url}.") | |
467 | (blocklist-url | |
468 | (maybe-string 'disabled) | |
469 | "The URL of a peer blocklist (in @acronym{P2P}-plaintext or eMule | |
470 | @file{.dat} format) to be periodically downloaded and applied when | |
471 | @code{blocklist-enabled?} is @code{#t}.") | |
472 | ||
473 | ;; Queueing. | |
474 | (download-queue-enabled? | |
475 | (boolean #t) | |
476 | "If @code{#t}, the daemon will be limited to downloading at most | |
477 | @code{download-queue-size} non-stalled torrents simultaneously.") | |
478 | (download-queue-size | |
479 | (non-negative-integer 5) | |
480 | "The size of the daemon's download queue, which limits the number of | |
481 | non-stalled torrents it will download at any one time when | |
482 | @code{download-queue-enabled?} is @code{#t}.") | |
483 | (seed-queue-enabled? | |
484 | (boolean #f) | |
485 | "If @code{#t}, the daemon will be limited to seeding at most | |
486 | @code{seed-queue-size} non-stalled torrents simultaneously.") | |
487 | (seed-queue-size | |
488 | (non-negative-integer 10) | |
489 | "The size of the daemon's seed queue, which limits the number of | |
490 | non-stalled torrents it will seed at any one time when | |
491 | @code{seed-queue-enabled?} is @code{#t}.") | |
492 | (queue-stalled-enabled? | |
493 | (boolean #t) | |
494 | "When @code{#t}, the daemon will consider torrents for which it has not | |
495 | shared data in the past @code{queue-stalled-minutes} minutes to be stalled and | |
496 | not count them against its @code{download-queue-size} and | |
497 | @code{seed-queue-size} limits.") | |
498 | (queue-stalled-minutes | |
499 | (non-negative-integer 30) | |
500 | "The maximum period, in minutes, a torrent may be idle before it is | |
501 | considered to be stalled, when @code{queue-stalled-enabled?} is @code{#t}.") | |
502 | ||
503 | ;; Seeding limits. | |
504 | (ratio-limit-enabled? | |
505 | (boolean #f) | |
506 | "When @code{#t}, a torrent being seeded will automatically be paused once | |
507 | it reaches the ratio specified by @code{ratio-limit}.") | |
508 | (ratio-limit | |
509 | (non-negative-rational 2.0) | |
510 | "The ratio at which a torrent being seeded will be paused, when | |
511 | @code{ratio-limit-enabled?} is @code{#t}.") | |
512 | (idle-seeding-limit-enabled? | |
513 | (boolean #f) | |
514 | "When @code{#t}, a torrent being seeded will automatically be paused once | |
515 | it has been idle for @code{idle-seeding-limit} minutes.") | |
516 | (idle-seeding-limit | |
517 | (non-negative-integer 30) | |
518 | "The maximum period, in minutes, a torrent being seeded may be idle before | |
519 | it is paused, when @code{idle-seeding-limit-enabled?} is @code{#t}.") | |
520 | ||
521 | ;; BitTorrent extensions. | |
522 | (dht-enabled? | |
523 | (boolean #t) | |
524 | "Enable @uref{http://bittorrent.org/beps/bep_0005.html, the distributed | |
525 | hash table (@acronym{DHT}) protocol}, which supports the use of trackerless | |
526 | torrents.") | |
527 | (lpd-enabled? | |
528 | (boolean #f) | |
529 | "Enable @url{https://en.wikipedia.org/wiki/Local_Peer_Discovery, local peer | |
530 | discovery} (@acronym{LPD}), which allows the discovery of peers on the local | |
531 | network and may reduce the amount of data sent over the public Internet.") | |
532 | (pex-enabled? | |
533 | (boolean #t) | |
534 | "Enable @url{https://en.wikipedia.org/wiki/Peer_exchange, peer | |
535 | exchange} (@acronym{PEX}), which reduces the daemon's reliance on external | |
536 | trackers and may improve its performance.") | |
537 | (utp-enabled? | |
538 | (boolean #t) | |
539 | "Enable @url{http://bittorrent.org/beps/bep_0029.html, the micro transport | |
540 | protocol} (@acronym{uTP}), which aims to reduce the impact of BitTorrent | |
541 | traffic on other users of the local network while maintaining full utilization | |
542 | of the available bandwidth.") | |
543 | ||
544 | ;; Remote procedure call (RPC) interface. | |
545 | (rpc-enabled? | |
546 | (boolean #t) | |
547 | "If @code{#t}, enable the remote procedure call (@acronym{RPC}) interface, | |
548 | which allows remote control of the daemon via its Web interface, the | |
549 | @command{transmission-remote} command-line client, and similar tools.") | |
550 | (rpc-bind-address | |
551 | (string "0.0.0.0") | |
552 | "The IP address at which to listen for @acronym{RPC} connections, or | |
553 | ``0.0.0.0'' to listen at all available IP addresses.") | |
554 | (rpc-port | |
555 | (port-number 9091) | |
556 | "The port on which to listen for @acronym{RPC} connections.") | |
557 | (rpc-url | |
558 | (string "/transmission/") | |
559 | "The path prefix to use in the @acronym{RPC}-endpoint @acronym{URL}.") | |
560 | (rpc-authentication-required? | |
561 | (boolean #f) | |
562 | "When @code{#t}, clients must authenticate (see @code{rpc-username} and | |
563 | @code{rpc-password}) when using the @acronym{RPC} interface. Note this has | |
564 | the side effect of disabling host-name whitelisting (see | |
565 | @code{rpc-host-whitelist-enabled?}.") | |
566 | (rpc-username | |
567 | (maybe-string 'disabled) | |
568 | "The username required by clients to access the @acronym{RPC} interface | |
569 | when @code{rpc-authentication-required?} is @code{#t}.") | |
570 | (rpc-password | |
571 | (maybe-transmission-password-hash 'disabled) | |
572 | "The password required by clients to access the @acronym{RPC} interface | |
573 | when @code{rpc-authentication-required?} is @code{#t}. This must be specified | |
574 | using a password hash in the format recognized by Transmission clients, either | |
575 | copied from an existing @file{settings.json} file or generated using the | |
576 | @code{transmission-password-hash} procedure.") | |
577 | (rpc-whitelist-enabled? | |
578 | (boolean #t) | |
579 | "When @code{#t}, @acronym{RPC} requests will be accepted only when they | |
580 | originate from an address specified in @code{rpc-whitelist}.") | |
581 | (rpc-whitelist | |
582 | (string-list '("127.0.0.1" "::1")) | |
583 | "The list of IP and IPv6 addresses from which @acronym{RPC} requests will | |
584 | be accepted when @code{rpc-whitelist-enabled?} is @code{#t}. Wildcards may be | |
585 | specified using @samp{*}.") | |
586 | (rpc-host-whitelist-enabled? | |
587 | (boolean #t) | |
588 | "When @code{#t}, @acronym{RPC} requests will be accepted only when they are | |
589 | addressed to a host named in @code{rpc-host-whitelist}. Note that requests to | |
590 | ``localhost'' or ``localhost.'', or to a numeric address, are always accepted | |
591 | regardless of these settings. | |
592 | ||
593 | Note also this functionality is disabled when | |
594 | @code{rpc-authentication-required?} is @code{#t}.") | |
595 | (rpc-host-whitelist | |
596 | (string-list '()) | |
597 | "The list of host names recognized by the @acronym{RPC} server when | |
598 | @code{rpc-host-whitelist-enabled?} is @code{#t}.") | |
599 | ||
600 | ;; Miscellaneous. | |
601 | (message-level | |
602 | (message-level 'info) | |
603 | "The minimum severity level of messages to be logged (to | |
604 | @file{/var/log/transmission.log}) by the daemon, one of @code{none} (no | |
605 | logging), @code{error}, @code{info} and @code{debug}.") | |
606 | (start-added-torrents? | |
607 | (boolean #t) | |
608 | "When @code{#t}, torrents are started as soon as they are added; otherwise, | |
609 | they are added in ``paused'' state.") | |
610 | (script-torrent-done-enabled? | |
611 | (boolean #f) | |
612 | "When @code{#t}, the script specified by | |
613 | @code{script-torrent-done-filename} will be invoked each time a torrent | |
614 | completes.") | |
615 | (script-torrent-done-filename | |
616 | (maybe-file-object 'disabled) | |
617 | "A file name or file-like object specifying a script to run each time a | |
618 | torrent completes, when @code{script-torrent-done-enabled?} is @code{#t}.") | |
619 | (scrape-paused-torrents-enabled? | |
620 | (boolean #t) | |
621 | "When @code{#t}, the daemon will scrape trackers for a torrent even when | |
622 | the torrent is paused.") | |
623 | (cache-size-mb | |
624 | (non-negative-integer 4) | |
625 | "The amount of memory, in megabytes, to allocate for the daemon's in-memory | |
626 | cache. A larger value may increase performance by reducing the frequency of | |
627 | disk I/O.") | |
628 | (prefetch-enabled? | |
629 | (boolean #t) | |
630 | "When @code{#t}, the daemon will try to improve I/O performance by hinting | |
631 | to the operating system which data is likely to be read next from disk to | |
632 | satisfy requests from peers.")) | |
633 | ||
634 | (define (transmission-daemon-shepherd-service config) | |
635 | "Return a <shepherd-service> for Transmission Daemon with CONFIG." | |
636 | (let ((transmission | |
637 | (transmission-daemon-configuration-transmission config)) | |
638 | (stop-wait-period | |
639 | (transmission-daemon-configuration-stop-wait-period config))) | |
640 | (list | |
641 | (shepherd-service | |
642 | (provision '(transmission-daemon transmission bittorrent)) | |
643 | (requirement '(networking)) | |
644 | (documentation "Share files using the BitTorrent protocol.") | |
645 | (start #~(make-forkexec-constructor | |
646 | '(#$(file-append transmission "/bin/transmission-daemon") | |
647 | "--config-dir" | |
648 | #$%transmission-daemon-configuration-directory | |
649 | "--foreground") | |
650 | #:user #$%transmission-daemon-user | |
651 | #:group #$%transmission-daemon-group | |
652 | #:directory #$%transmission-daemon-configuration-directory | |
653 | #:log-file #$%transmission-daemon-log-file | |
654 | #:environment-variables | |
655 | '("CURL_CA_BUNDLE=/etc/ssl/certs/ca-certificates.crt"))) | |
656 | (stop #~(lambda (pid) | |
657 | (kill pid SIGTERM) | |
658 | ||
659 | ;; Transmission Daemon normally needs some time to shut down, | |
660 | ;; as it will complete some housekeeping and send a final | |
661 | ;; update to trackers before it exits. | |
662 | ;; | |
663 | ;; Wait a reasonable period for it to stop before continuing. | |
664 | ;; If we don't do this, restarting the service can fail as the | |
665 | ;; new daemon process finds the old one still running and | |
666 | ;; attached to the port used for peer connections. | |
667 | (let wait-before-killing ((period #$stop-wait-period)) | |
668 | (if (zero? (car (waitpid pid WNOHANG))) | |
669 | (if (positive? period) | |
670 | (begin | |
671 | (sleep 1) | |
672 | (wait-before-killing (- period 1))) | |
673 | (begin | |
674 | (format #t | |
675 | #$(G_ "Wait period expired; killing \ | |
676 | transmission-daemon (pid ~a).~%") | |
677 | pid) | |
678 | (display #$(G_ "(If you see this message \ | |
679 | regularly, you may need to increase the value | |
680 | of 'stop-wait-period' in the service configuration.)\n")) | |
681 | (kill pid SIGKILL))))) | |
682 | #f)) | |
683 | (actions | |
684 | (list | |
685 | (shepherd-action | |
686 | (name 'reload) | |
687 | (documentation "Reload the settings file from disk.") | |
688 | (procedure #~(lambda (pid) | |
689 | (if pid | |
690 | (begin | |
691 | (kill pid SIGHUP) | |
692 | (display #$(G_ "Service transmission-daemon has \ | |
693 | been asked to reload its settings file."))) | |
694 | (display #$(G_ "Service transmission-daemon is not \ | |
695 | running.")))))))))))) | |
696 | ||
697 | (define %transmission-daemon-accounts | |
698 | (list (user-group | |
699 | (name %transmission-daemon-group) | |
700 | (system? #t)) | |
701 | (user-account | |
702 | (name %transmission-daemon-user) | |
703 | (group %transmission-daemon-group) | |
704 | (comment "Transmission Daemon service account") | |
705 | (home-directory %transmission-daemon-configuration-directory) | |
706 | (shell (file-append shadow "/sbin/nologin")) | |
707 | (system? #t)))) | |
708 | ||
709 | (define %transmission-daemon-log-rotations | |
710 | (list (log-rotation | |
711 | (files (list %transmission-daemon-log-file))))) | |
712 | ||
713 | (define (transmission-daemon-computed-settings-file config) | |
714 | "Return a @code{computed-file} object that, when unquoted in a G-expression, | |
715 | produces a Transmission settings file (@file{settings.json}) matching CONFIG." | |
716 | (let ((settings | |
717 | ;; "Serialize" the configuration settings as a list of G-expressions | |
718 | ;; containing a name-value pair, which will ultimately be sorted and | |
719 | ;; serialized to the settings file as a JSON object. | |
720 | (map | |
721 | (lambda (field) | |
722 | ((configuration-field-serializer field) | |
723 | (configuration-field-name field) | |
724 | ((configuration-field-getter field) config))) | |
725 | (filter | |
726 | (lambda (field) | |
727 | ;; Omit configuration fields that are used only internally by | |
728 | ;; this service definition. | |
729 | (not (memq (configuration-field-name field) | |
730 | '(transmission stop-wait-period)))) | |
731 | transmission-daemon-configuration-fields)))) | |
732 | (computed-file | |
733 | "settings.json" | |
734 | (with-extensions (list guile-gcrypt guile-json-4) | |
735 | (with-imported-modules (source-module-closure '((json builder))) | |
736 | #~(begin | |
737 | (use-modules (json builder)) | |
738 | ||
739 | (with-output-to-file #$output | |
740 | (lambda () | |
741 | (scm->json (sort-list '(#$@settings) | |
742 | (lambda (x y) | |
743 | (string<=? (car x) (car y)))) | |
744 | #:pretty #t))))))))) | |
745 | ||
746 | (define (transmission-daemon-activation config) | |
747 | "Return the Transmission Daemon activation GEXP for CONFIG." | |
748 | (let ((config-dir %transmission-daemon-configuration-directory) | |
749 | (incomplete-dir-enabled | |
750 | (transmission-daemon-configuration-incomplete-dir-enabled? config)) | |
751 | (incomplete-dir | |
752 | (transmission-daemon-configuration-incomplete-dir config)) | |
753 | (watch-dir-enabled | |
754 | (transmission-daemon-configuration-watch-dir-enabled? config)) | |
755 | (watch-dir | |
756 | (transmission-daemon-configuration-watch-dir config))) | |
757 | (with-imported-modules (source-module-closure '((guix build utils))) | |
758 | #~(begin | |
759 | (use-modules (guix build utils)) | |
760 | ||
761 | (let ((owner (getpwnam #$%transmission-daemon-user))) | |
762 | (define (mkdir-p/perms directory perms) | |
763 | (mkdir-p directory) | |
764 | (chown directory (passwd:uid owner) (passwd:gid owner)) | |
765 | (chmod directory perms)) | |
766 | ||
767 | ;; Create the directories Transmission Daemon is configured to use | |
768 | ;; and assign them suitable permissions. | |
769 | (for-each (lambda (directory-specification) | |
770 | (apply mkdir-p/perms directory-specification)) | |
771 | '(#$@(append | |
772 | `((,config-dir #o750)) | |
773 | (if incomplete-dir-enabled | |
774 | `((,incomplete-dir #o750)) | |
775 | '()) | |
776 | (if watch-dir-enabled | |
777 | `((,watch-dir #o770)) | |
778 | '()))))) | |
779 | ||
780 | ;; Generate and activate the daemon's settings file, settings.json. | |
781 | (activate-special-files | |
782 | '((#$(string-append config-dir "/settings.json") | |
783 | #$(transmission-daemon-computed-settings-file config)))))))) | |
784 | ||
785 | (define transmission-daemon-service-type | |
786 | (service-type | |
787 | (name 'transmission) | |
788 | (extensions | |
789 | (list (service-extension shepherd-root-service-type | |
790 | transmission-daemon-shepherd-service) | |
791 | (service-extension account-service-type | |
792 | (const %transmission-daemon-accounts)) | |
793 | (service-extension rottlog-service-type | |
794 | (const %transmission-daemon-log-rotations)) | |
795 | (service-extension activation-service-type | |
796 | transmission-daemon-activation))) | |
797 | (default-value (transmission-daemon-configuration)) | |
798 | (description "Share files using the BitTorrent protocol."))) | |
799 | ||
800 | (define (generate-transmission-daemon-documentation) | |
801 | (generate-documentation | |
802 | `((transmission-daemon-configuration | |
803 | ,transmission-daemon-configuration-fields)) | |
804 | 'transmission-daemon-configuration)) |