file-sharing.scm 32 KB

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