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