gnu/services/file-sharing.scm

   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))