aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/packages/ruby.scm25
1 files changed, 2 insertions, 23 deletions
diff --git a/gnu/packages/ruby.scm b/gnu/packages/ruby.scm
index 2c5777fdf8..7e8c8be290 100644
--- a/gnu/packages/ruby.scm
+++ b/gnu/packages/ruby.scm
@@ -3766,7 +3766,7 @@ A modified copy of yajl is used, and included in the package.")
(define-public ruby-yard
(package
(name "ruby-yard")
- (version "0.9.6")
+ (version "0.9.16")
(source
(origin
(method url-fetch)
@@ -3776,7 +3776,7 @@ A modified copy of yajl is used, and included in the package.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
- "0rsz4bghgx7fryzyhlz8wlnd2m9xgyvf1xhrq58mnzfrrfm41bdg"))))
+ "0sqpbayy9sb406jh0zqg6qha1xds863qz9531dh6vp58hc00clfq"))))
(build-system ruby-build-system)
(arguments
`(#:phases
@@ -5673,27 +5673,6 @@ support the tests found in Prawn, a pure Ruby PDF generation library.")
functionality from Prawn.")
(license license:gpl3+)))
-(define-public ruby-yard
- (package
- (name "ruby-yard")
- (version "0.9.16")
- (source (origin
- (method url-fetch)
- (uri (rubygems-uri "yard" version))
- (sha256
- (base32
- "0lmmr1839qgbb3zxfa7jf5mzy17yjl1yirwlgzdhws4452gqhn67"))))
- (build-system ruby-build-system)
- (arguments `(#:test-target "spec"))
- (home-page "https://yardoc.org/")
- (synopsis "Ruby documentation tool")
- (description "YARD is a documentation generation tool for the Ruby
-programming language. It enables the user to generate consistent, usable
-documentation that can be exported to a number of formats very easily, and
-also supports extending for custom Ruby constructs such as custom class level
-definitions.")
- (license license:expat)))
-
(define-public ruby-prawn
(package
(name "ruby-prawn")
n155' href='#n155'>155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Simon South <simon@simonsouth.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services file-sharing)
  #:use-module (gcrypt base16)
  #:use-module (gcrypt hash)
  #:use-module (gcrypt random)
  #:use-module (gnu services)
  #:use-module (gnu services admin)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages bittorrent)
  #:use-module (gnu packages gnupg)
  #:use-module (gnu packages guile)
  #:use-module (gnu system shadow)
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix i18n)
  #:use-module (guix modules)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:export (transmission-daemon-configuration
            transmission-daemon-service-type
            transmission-password-hash
            transmission-random-salt))

;;;
;;; Transmission Daemon.
;;;

(define %transmission-daemon-user "transmission")
(define %transmission-daemon-group "transmission")

(define %transmission-daemon-configuration-directory
  "/var/lib/transmission-daemon")
(define %transmission-daemon-log-file
  "/var/log/transmission.log")

(define %transmission-salt-length 8)

(define (transmission-password-hash password salt)
  "Returns a string containing the result of hashing @var{password} together
with @var{salt}, in the format recognized by Transmission clients for their
@code{rpc-password} configuration setting.

@var{salt} must be an eight-character string.  The
@code{transmission-random-salt} procedure can be used to generate a suitable
salt value at random."
  (if (not (and (string? salt)
                (eq? (string-length salt) %transmission-salt-length)))
      (raise (formatted-message
              (G_ "salt value must be a string of ~d characters")
              %transmission-salt-length))
      (string-append "{"
                     (bytevector->base16-string
                      (sha1 (string->utf8 (string-append password salt))))
                     salt)))

(define (transmission-random-salt)
  "Returns a string containing a random, eight-character salt value of the
type generated and used by Transmission clients, suitable for passing to the
@code{transmission-password-hash} procedure."
  ;; This implementation matches a portion of Transmission's tr_ssha1
  ;; function.  See libtransmission/crypto-utils.c in the Transmission source
  ;; distribution.
  (let ((salter (string-append "0123456789"
                               "abcdefghijklmnopqrstuvwxyz"
                               "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                               "./")))
    (list->string
     (map (lambda (u8)
            (string-ref salter (modulo u8 (string-length salter))))
          (bytevector->u8-list
           (gen-random-bv %transmission-salt-length %gcry-strong-random))))))

(define (uglify-field-name field-name)
  (string-delete #\? (symbol->string field-name)))

(define (serialize-field field-name val)
  ;; "Serialize" each configuration field as a G-expression containing a
  ;; name-value pair, the collection of which will subsequently be serialized
  ;; to disk as a JSON object.
  #~(#$(uglify-field-name field-name) . #$val))

(define serialize-boolean serialize-field)
(define serialize-integer serialize-field)
(define serialize-rational serialize-field)

(define serialize-string serialize-field)
(define-maybe string)
;; Override the definition of "serialize-maybe-string", as we need to output a
;; name-value pair for the JSON builder.
(set! serialize-maybe-string
  (lambda (field-name val)
    (serialize-string field-name (maybe-value val ""))))

(define (string-list? val)
  (and (list? val)
       (and-map (lambda (x)
                  (and (string? x)
                       (not (string-index x #\,))))
                val)))
(define (serialize-string-list field-name val)
  (serialize-field field-name (string-join val ",")))

(define days
  '((sunday    . #b0000001)
    (monday    . #b0000010)
    (tuesday   . #b0000100)
    (wednesday . #b0001000)
    (thursday  . #b0010000)
    (friday    . #b0100000)
    (saturday  . #b1000000)))
(define day-lists
  (list (cons 'weekdays '(monday tuesday wednesday thursday friday))
        (cons 'weekends '(saturday sunday))
        (cons 'all (map car days))))
(define (day-list? val)
  (or (and (symbol? val)
           (assq val day-lists))
      (and (list? val)
           (and-map (lambda (x)
                      (and (symbol? x)
                           (assq x days)))
                    val))))
(define (serialize-day-list field-name val)
  (serialize-integer field-name
                     (reduce logior
                             #b0000000
                             (map (lambda (day)
                                    (assq-ref days day))
                                  (if (symbol? val)
                                      (assq-ref day-lists val)
                                      val)))))

(define encryption-modes
  '((prefer-unencrypted-connections . 0)
    (prefer-encrypted-connections   . 1)
    (require-encrypted-connections  . 2)))
(define (encryption-mode? val)
  (and (symbol? val)
       (assq val encryption-modes)))
(define (serialize-encryption-mode field-name val)
  (serialize-integer field-name (assq-ref encryption-modes val)))

(define serialize-file-like serialize-field)

(define (file-object? val)
  (or (string? val)
      (file-like? val)))
(define (serialize-file-object field-name val)
  (if (file-like? val)
      (serialize-file-like field-name val)
      (serialize-string field-name val)))
(define-maybe file-object)
(set! serialize-maybe-file-object
  (lambda (field-name val)
    (if (maybe-value-set? val)
        (serialize-file-object field-name val)
        (serialize-string field-name ""))))

(define (file-object-list? val)
  (and (list? val)
       (and-map file-object? val)))
(define serialize-file-object-list serialize-field)

(define message-levels
  '((none  . 0)
    (error . 1)
    (info  . 2)
    (debug . 3)))
(define (message-level? val)
  (and (symbol? val)
       (assq val message-levels)))
(define (serialize-message-level field-name val)
  (serialize-integer field-name (assq-ref message-levels val)))

(define (non-negative-integer? val)
  (and (integer? val)
       (not (negative? val))))
(define serialize-non-negative-integer serialize-integer)

(define (non-negative-rational? val)
  (and (rational? val)
       (not (negative? val))))
(define serialize-non-negative-rational serialize-rational)

(define (port-number? val)
  (and (integer? val)
       (>= val 1)
       (<= val 65535)))
(define serialize-port-number serialize-integer)

(define preallocation-modes
  '((none   . 0)
    (fast   . 1)
    (sparse . 1)
    (full   . 2)))
(define (preallocation-mode? val)
  (and (symbol? val)
       (assq val preallocation-modes)))
(define (serialize-preallocation-mode field-name val)
  (serialize-integer field-name (assq-ref preallocation-modes val)))

(define tcp-types-of-service
  '((default     . "default")
    (low-cost    . "lowcost")
    (throughput  . "throughput")
    (low-delay   . "lowdelay")
    (reliability . "reliability")))
(define (tcp-type-of-service? val)
  (and (symbol? val)
       (assq val tcp-types-of-service)))
(define (serialize-tcp-type-of-service field-name val)
  (serialize-string field-name (assq-ref tcp-types-of-service val)))

(define (transmission-password-hash? val)
  (and (string? val)
       (= (string-length val) 49)
       (eqv? (string-ref val 0) #\{)
       (string-every char-set:hex-digit val 1 41)))
(define serialize-transmission-password-hash serialize-string)
(define-maybe transmission-password-hash)
(set! serialize-maybe-transmission-password-hash serialize-maybe-string)

(define (umask? val)
  (and (integer? val)
       (>= val #o000)
       (<= val #o777)))
(define serialize-umask serialize-integer) ; must use decimal representation

(define-configuration transmission-daemon-configuration
  ;; Settings internal to this service definition.
  (transmission
   (file-like transmission)
   "The Transmission package to use.")
  (stop-wait-period
   (non-negative-integer 10)
   "The period, in seconds, to wait when stopping the service for
@command{transmission-daemon} to exit before killing its process.  This allows
the daemon time to complete its housekeeping and send a final update to
trackers as it shuts down.  On slow hosts, or hosts with a slow network
connection, this value may need to be increased.")

  ;; Files and directories.
  (download-dir
   (string (string-append %transmission-daemon-configuration-directory
                          "/downloads"))
   "The directory to which torrent files are downloaded.")
  (incomplete-dir-enabled?
   (boolean #f)
   "If @code{#t}, files will be held in @code{incomplete-dir} while their
torrent is being downloaded, then moved to @code{download-dir} once the
torrent is complete.  Otherwise, files for all torrents (including those still
being downloaded) will be placed in @code{download-dir}.")
  (incomplete-dir
   maybe-string
   "The directory in which files from incompletely downloaded torrents will be
held when @code{incomplete-dir-enabled?} is @code{#t}.")
  (umask
   (umask #o022)
   "The file mode creation mask used for downloaded files.  (See the
@command{umask} man page for more information.)")
  (rename-partial-files?
   (boolean #t)
   "When @code{#t}, ``.part'' is appended to the name of partially downloaded
files.")
  (preallocation
   (preallocation-mode 'fast)
   "The mode by which space should be preallocated for downloaded files, one
of @code{none}, @code{fast} (or @code{sparse}) and @code{full}.  Specifying
@code{full} will minimize disk fragmentation at a cost to file-creation
speed.")
  (watch-dir-enabled?
   (boolean #f)
   "If @code{#t}, the directory specified by @code{watch-dir} will be watched
for new @file{.torrent} files and the torrents they describe added
automatically (and the original files removed, if
@code{trash-original-torrent-files?} is @code{#t}).")
  (watch-dir
   maybe-string
   "The directory to be watched for @file{.torrent} files indicating new
torrents to be added, when @code{watch-dir-enabled} is @code{#t}.")
  (trash-original-torrent-files?
   (boolean #f)
   "When @code{#t}, @file{.torrent} files will be deleted from the watch
directory once their torrent has been added (see
@code{watch-directory-enabled?}).")

  ;; Bandwidth limits.
  (speed-limit-down-enabled?
   (boolean #f)
   "When @code{#t}, the daemon's download speed will be limited to the rate
specified by @code{speed-limit-down}.")
  (speed-limit-down
   (non-negative-integer 100)
   "The default global-maximum download speed, in kilobytes per second.")
  (speed-limit-up-enabled?
   (boolean #f)
   "When @code{#t}, the daemon's upload speed will be limited to the rate
specified by @code{speed-limit-up}.")
  (speed-limit-up
   (non-negative-integer 100)
   "The default global-maximum upload speed, in kilobytes per second.")
  (alt-speed-enabled?
   (boolean #f)
   "When @code{#t}, the alternate speed limits @code{alt-speed-down} and
@code{alt-speed-up} are used (in place of @code{speed-limit-down} and
@code{speed-limit-up}, if they are enabled) to constrain the daemon's
bandwidth usage.  This can be scheduled to occur automatically at certain
times during the week; see @code{alt-speed-time-enabled?}.")
  (alt-speed-down
   (non-negative-integer 50)
   "The alternate global-maximum download speed, in kilobytes per second.")
  (alt-speed-up
   (non-negative-integer 50)
   "The alternate global-maximum upload speed, in kilobytes per second.")

  ;; Bandwidth-limit scheduling.
  (alt-speed-time-enabled?
   (boolean #f)
   "When @code{#t}, the alternate speed limits @code{alt-speed-down} and
@code{alt-speed-up} will be enabled automatically during the periods specified
by @code{alt-speed-time-day}, @code{alt-speed-time-begin} and
@code{alt-time-speed-end}.")
  (alt-speed-time-day
   (day-list 'all)
   "The days of the week on which the alternate-speed schedule should be used,
specified either as a list of days (@code{sunday}, @code{monday}, and so on)
or using one of the symbols @code{weekdays}, @code{weekends} or @code{all}.")
  (alt-speed-time-begin
   (non-negative-integer 540)
   "The time of day at which to enable the alternate speed limits,
expressed as a number of minutes since midnight.")
  (alt-speed-time-end
   (non-negative-integer 1020)
   "The time of day at which to disable the alternate speed limits,
expressed as a number of minutes since midnight.")

  ;; Peer networking.
  (bind-address-ipv4
   (string "0.0.0.0")
   "The IP address at which to listen for peer connections, or ``0.0.0.0'' to
listen at all available IP addresses.")
  (bind-address-ipv6
   (string "::")
   "The IPv6 address at which to listen for peer connections, or ``::'' to
listen at all available IPv6 addresses.")
  (peer-port-random-on-start?
   (boolean #f)
   "If @code{#t}, when the daemon starts it will select a port at random on
which to listen for peer connections, from the range specified (inclusively)
by @code{peer-port-random-low} and @code{peer-port-random-high}.  Otherwise,
it listens on the port specified by @code{peer-port}.")
  (peer-port-random-low
   (port-number 49152)
   "The lowest selectable port number when @code{peer-port-random-on-start?}
is @code{#t}.")
  (peer-port-random-high
   (port-number 65535)
   "The highest selectable port number when @code{peer-port-random-on-start}
is @code{#t}.")
  (peer-port
   (port-number 51413)
   "The port on which to listen for peer connections when
@code{peer-port-random-on-start?} is @code{#f}.")
  (port-forwarding-enabled?
   (boolean #t)
   "If @code{#t}, the daemon will attempt to configure port-forwarding on an
upstream gateway automatically using @acronym{UPnP} and @acronym{NAT-PMP}.")
  (encryption
   (encryption-mode 'prefer-encrypted-connections)
   "The encryption preference for peer connections, one of
@code{prefer-unencrypted-connections}, @code{prefer-encrypted-connections} or
@code{require-encrypted-connections}.")
  (peer-congestion-algorithm
   maybe-string
   "The TCP congestion-control algorithm to use for peer connections,
specified using a string recognized by the operating system in calls to
@code{setsockopt} (or leave it unset, in which case the operating-system
default is used).

Note that on GNU/Linux systems, the kernel must be configured to allow
processes to use a congestion-control algorithm not in the default set;
otherwise, it will deny these requests with ``Operation not permitted''.  To
see which algorithms are available on your system and which are currently
permitted for use, look at the contents of the files
@file{tcp_available_congestion_control} and
@file{tcp_allowed_congestion_control} in the @file{/proc/sys/net/ipv4}
directory.

As an example, to have Transmission Daemon use
@uref{http://www-ece.rice.edu/networks/TCP-LP/, the TCP Low Priority
congestion-control algorithm}, you'll need to modify your kernel configuration
to build in support for the algorithm, then update your operating-system
configuration to allow its use by adding a @code{sysctl-service-type}
service (or updating the existing one's configuration) with lines like the
following:

@lisp
(service sysctl-service-type
         (sysctl-configuration
          (settings
           (\"net.ipv4.tcp_allowed_congestion_control\" .
            \"reno cubic lp\"))))
@end lisp

The Transmission Daemon configuration can then be updated with

@lisp
(peer-congestion-algorithm \"lp\")
@end lisp

and the system reconfigured to have the changes take effect.")
  (peer-socket-tos
   (tcp-type-of-service 'default)
   "The type of service to request in outgoing @acronym{TCP} packets,
one of @code{default}, @code{low-cost}, @code{throughput}, @code{low-delay}
and @code{reliability}.")
  (peer-limit-global
   (non-negative-integer 200)
   "The global limit on the number of connected peers.")
  (peer-limit-per-torrent
   (non-negative-integer 50)
   "The per-torrent limit on the number of connected peers.")
  (upload-slots-per-torrent
   (non-negative-integer 14)
   "The maximum number of peers to which the daemon will upload data
simultaneously for each torrent.")
  (peer-id-ttl-hours
   (non-negative-integer 6)
   "The maximum lifespan, in hours, of the peer ID associated with each public
torrent before it is regenerated.")

  ;; Peer blocklists.
  (blocklist-enabled?
   (boolean #f)
   "When @code{#t}, the daemon will ignore peers mentioned in the blocklist it
has most recently downloaded from @code{blocklist-url}.")
  (blocklist-url
   maybe-string
   "The URL of a peer blocklist (in @acronym{P2P}-plaintext or eMule
@file{.dat} format) to be periodically downloaded and applied when
@code{blocklist-enabled?} is @code{#t}.")

  ;; Queueing.
  (download-queue-enabled?
   (boolean #t)
   "If @code{#t}, the daemon will be limited to downloading at most
@code{download-queue-size} non-stalled torrents simultaneously.")
  (download-queue-size
   (non-negative-integer 5)
   "The size of the daemon's download queue, which limits the number of
non-stalled torrents it will download at any one time when
@code{download-queue-enabled?} is @code{#t}.")
  (seed-queue-enabled?
   (boolean #f)
   "If @code{#t}, the daemon will be limited to seeding at most
@code{seed-queue-size} non-stalled torrents simultaneously.")
  (seed-queue-size
   (non-negative-integer 10)
   "The size of the daemon's seed queue, which limits the number of
non-stalled torrents it will seed at any one time when
@code{seed-queue-enabled?} is @code{#t}.")
  (queue-stalled-enabled?
   (boolean #t)
   "When @code{#t}, the daemon will consider torrents for which it has not
shared data in the past @code{queue-stalled-minutes} minutes to be stalled and
not count them against its @code{download-queue-size} and
@code{seed-queue-size} limits.")
  (queue-stalled-minutes
   (non-negative-integer 30)
   "The maximum period, in minutes, a torrent may be idle before it is
considered to be stalled, when @code{queue-stalled-enabled?} is @code{#t}.")

  ;; Seeding limits.
  (ratio-limit-enabled?
   (boolean #f)
   "When @code{#t}, a torrent being seeded will automatically be paused once
it reaches the ratio specified by @code{ratio-limit}.")
  (ratio-limit
   (non-negative-rational 2.0)
   "The ratio at which a torrent being seeded will be paused, when
@code{ratio-limit-enabled?} is @code{#t}.")
  (idle-seeding-limit-enabled?
   (boolean #f)
   "When @code{#t}, a torrent being seeded will automatically be paused once
it has been idle for @code{idle-seeding-limit} minutes.")
  (idle-seeding-limit
   (non-negative-integer 30)
   "The maximum period, in minutes, a torrent being seeded may be idle before
it is paused, when @code{idle-seeding-limit-enabled?} is @code{#t}.")

  ;; BitTorrent extensions.
  (dht-enabled?
   (boolean #t)
   "Enable @uref{http://bittorrent.org/beps/bep_0005.html, the distributed
hash table (@acronym{DHT}) protocol}, which supports the use of trackerless
torrents.")
  (lpd-enabled?
   (boolean #f)
   "Enable @url{https://en.wikipedia.org/wiki/Local_Peer_Discovery, local peer
discovery} (@acronym{LPD}), which allows the discovery of peers on the local
network and may reduce the amount of data sent over the public Internet.")
  (pex-enabled?
   (boolean #t)
   "Enable @url{https://en.wikipedia.org/wiki/Peer_exchange, peer
exchange} (@acronym{PEX}), which reduces the daemon's reliance on external
trackers and may improve its performance.")
  (utp-enabled?
   (boolean #t)
   "Enable @url{http://bittorrent.org/beps/bep_0029.html, the micro transport
protocol} (@acronym{uTP}), which aims to reduce the impact of BitTorrent
traffic on other users of the local network while maintaining full utilization
of the available bandwidth.")

  ;; Remote procedure call (RPC) interface.
  (rpc-enabled?
   (boolean #t)
   "If @code{#t}, enable the remote procedure call (@acronym{RPC}) interface,
which allows remote control of the daemon via its Web interface, the
@command{transmission-remote} command-line client, and similar tools.")
  (rpc-bind-address
   (string "0.0.0.0")
   "The IP address at which to listen for @acronym{RPC} connections, or
``0.0.0.0'' to listen at all available IP addresses.")
  (rpc-port
   (port-number 9091)
   "The port on which to listen for @acronym{RPC} connections.")
  (rpc-url
   (string "/transmission/")
   "The path prefix to use in the @acronym{RPC}-endpoint @acronym{URL}.")
  (rpc-authentication-required?
   (boolean #f)
   "When @code{#t}, clients must authenticate (see @code{rpc-username} and
@code{rpc-password}) when using the @acronym{RPC} interface.  Note this has
the side effect of disabling host-name whitelisting (see
@code{rpc-host-whitelist-enabled?}.")
  (rpc-username
   maybe-string
   "The username required by clients to access the @acronym{RPC} interface
when @code{rpc-authentication-required?} is @code{#t}.")
  (rpc-password
   maybe-transmission-password-hash
   "The password required by clients to access the @acronym{RPC} interface
when @code{rpc-authentication-required?} is @code{#t}.  This must be specified
using a password hash in the format recognized by Transmission clients, either
copied from an existing @file{settings.json} file or generated using the
@code{transmission-password-hash} procedure.")
  (rpc-whitelist-enabled?
   (boolean #t)
   "When @code{#t}, @acronym{RPC} requests will be accepted only when they
originate from an address specified in @code{rpc-whitelist}.")
  (rpc-whitelist
   (string-list '("127.0.0.1" "::1"))
   "The list of IP and IPv6 addresses from which @acronym{RPC} requests will
be accepted when @code{rpc-whitelist-enabled?} is @code{#t}.  Wildcards may be
specified using @samp{*}.")
  (rpc-host-whitelist-enabled?
   (boolean #t)
   "When @code{#t}, @acronym{RPC} requests will be accepted only when they are
addressed to a host named in @code{rpc-host-whitelist}.  Note that requests to
``localhost'' or ``localhost.'', or to a numeric address, are always accepted
regardless of these settings.

Note also this functionality is disabled when
@code{rpc-authentication-required?} is @code{#t}.")
  (rpc-host-whitelist
   (string-list '())
   "The list of host names recognized by the @acronym{RPC} server when
@code{rpc-host-whitelist-enabled?} is @code{#t}.")

  ;; Miscellaneous.
  (message-level
   (message-level 'info)
   "The minimum severity level of messages to be logged (to
@file{/var/log/transmission.log}) by the daemon, one of @code{none} (no
logging), @code{error}, @code{info} and @code{debug}.")
  (start-added-torrents?
   (boolean #t)
   "When @code{#t}, torrents are started as soon as they are added; otherwise,
they are added in ``paused'' state.")
  (script-torrent-done-enabled?
   (boolean #f)
   "When @code{#t}, the script specified by
@code{script-torrent-done-filename} will be invoked each time a torrent
completes.")
  (script-torrent-done-filename
   maybe-file-object
   "A file name or file-like object specifying a script to run each time a
torrent completes, when @code{script-torrent-done-enabled?} is @code{#t}.")
  (scrape-paused-torrents-enabled?
   (boolean #t)
   "When @code{#t}, the daemon will scrape trackers for a torrent even when
the torrent is paused.")
  (cache-size-mb
   (non-negative-integer 4)
   "The amount of memory, in megabytes, to allocate for the daemon's in-memory
cache.  A larger value may increase performance by reducing the frequency of
disk I/O.")
  (prefetch-enabled?
   (boolean #t)
   "When @code{#t}, the daemon will try to improve I/O performance by hinting
to the operating system which data is likely to be read next from disk to
satisfy requests from peers."))

(define (transmission-daemon-shepherd-service config)
  "Return a <shepherd-service> for Transmission Daemon with CONFIG."
  (let ((transmission
         (transmission-daemon-configuration-transmission config))
        (stop-wait-period
         (transmission-daemon-configuration-stop-wait-period config)))
    (list
     (shepherd-service
      (provision '(transmission-daemon transmission bittorrent))
      (requirement '(networking))
      (documentation "Share files using the BitTorrent protocol.")
      (start #~(make-forkexec-constructor
                '(#$(file-append transmission "/bin/transmission-daemon")
                  "--config-dir"
                  #$%transmission-daemon-configuration-directory
                  "--foreground")
                #:user #$%transmission-daemon-user
                #:group #$%transmission-daemon-group
                #:directory #$%transmission-daemon-configuration-directory
                #:log-file #$%transmission-daemon-log-file
                #:environment-variables
                '("CURL_CA_BUNDLE=/etc/ssl/certs/ca-certificates.crt")))
      (stop #~(lambda (pid)
                (kill pid SIGTERM)

                ;; Transmission Daemon normally needs some time to shut down,
                ;; as it will complete some housekeeping and send a final
                ;; update to trackers before it exits.
                ;;
                ;; Wait a reasonable period for it to stop before continuing.
                ;; If we don't do this, restarting the service can fail as the
                ;; new daemon process finds the old one still running and
                ;; attached to the port used for peer connections.
                (let wait-before-killing ((period #$stop-wait-period))
                  (if (zero? (car (waitpid pid WNOHANG)))
                      (if (positive? period)
                          (begin
                            (sleep 1)
                            (wait-before-killing (- period 1)))
                          (begin
                            (format #t
                                    #$(G_ "Wait period expired; killing \
transmission-daemon (pid ~a).~%")
                                    pid)
                            (display #$(G_ "(If you see this message \
regularly, you may need to increase the value
of 'stop-wait-period' in the service configuration.)\n"))
                            (kill pid SIGKILL)))))
                #f))
      (actions
       (list
        (shepherd-action
         (name 'reload)
         (documentation "Reload the settings file from disk.")
         (procedure #~(lambda (pid)
                        (if pid
                            (begin
                              (kill pid SIGHUP)
                              (display #$(G_ "Service transmission-daemon has \
been asked to reload its settings file.")))
                            (display #$(G_ "Service transmission-daemon is not \
running."))))))))))))

(define %transmission-daemon-accounts
  (list (user-group
         (name %transmission-daemon-group)
         (system? #t))
        (user-account
         (name %transmission-daemon-user)
         (group %transmission-daemon-group)
         (comment "Transmission Daemon service account")
         (home-directory %transmission-daemon-configuration-directory)
         (shell (file-append shadow "/sbin/nologin"))
         (system? #t))))

(define %transmission-daemon-log-rotations
  (list (log-rotation
         (files (list %transmission-daemon-log-file)))))

(define (transmission-daemon-computed-settings-file config)
  "Return a @code{computed-file} object that, when unquoted in a G-expression,
produces a Transmission settings file (@file{settings.json}) matching CONFIG."
  (let ((settings
         ;; "Serialize" the configuration settings as a list of G-expressions
         ;; containing a name-value pair, which will ultimately be sorted and
         ;; serialized to the settings file as a JSON object.
         (map
          (lambda (field)
            ((configuration-field-serializer field)
             (configuration-field-name field)
             ((configuration-field-getter field) config)))
          (filter
           (lambda (field)
             ;; Omit configuration fields that are used only internally by
             ;; this service definition.
             (not (memq (configuration-field-name field)
                        '(transmission stop-wait-period))))
           transmission-daemon-configuration-fields))))
    (computed-file
     "settings.json"
     (with-extensions (list guile-gcrypt guile-json-4)
       (with-imported-modules (source-module-closure '((json builder)))
         #~(begin
             (use-modules (json builder))

             (with-output-to-file #$output
               (lambda ()
                 (scm->json (sort-list '(#$@settings)
                                       (lambda (x y)
                                         (string<=? (car x) (car y))))
                            #:pretty #t)))))))))

(define (transmission-daemon-activation config)
  "Return the Transmission Daemon activation GEXP for CONFIG."
  (let ((config-dir %transmission-daemon-configuration-directory)
        (incomplete-dir-enabled
         (transmission-daemon-configuration-incomplete-dir-enabled? config))
        (incomplete-dir
         (transmission-daemon-configuration-incomplete-dir config))
        (watch-dir-enabled
         (transmission-daemon-configuration-watch-dir-enabled? config))
        (watch-dir
         (transmission-daemon-configuration-watch-dir config)))
    (with-imported-modules (source-module-closure '((guix build utils)))
      #~(begin
          (use-modules (guix build utils))

          (let ((owner (getpwnam #$%transmission-daemon-user)))
            (define (mkdir-p/perms directory perms)
              (mkdir-p directory)
              (chown directory (passwd:uid owner) (passwd:gid owner))
              (chmod directory perms))

            ;; Create the directories Transmission Daemon is configured to use
            ;; and assign them suitable permissions.
            (for-each (lambda (directory-specification)
                        (apply mkdir-p/perms directory-specification))
                      '(#$@(append
                            `((,config-dir #o750))
                            (if incomplete-dir-enabled
                                `((,incomplete-dir #o750))
                                '())
                            (if watch-dir-enabled
                                `((,watch-dir #o770))
                                '())))))

          ;; Generate and activate the daemon's settings file, settings.json.
          (activate-special-files
           '((#$(string-append config-dir "/settings.json")
              #$(transmission-daemon-computed-settings-file config))))))))

(define transmission-daemon-service-type
  (service-type
   (name 'transmission)
   (extensions
    (list (service-extension shepherd-root-service-type
                             transmission-daemon-shepherd-service)
          (service-extension account-service-type
                             (const %transmission-daemon-accounts))
          (service-extension rottlog-service-type
                             (const %transmission-daemon-log-rotations))
          (service-extension activation-service-type
                             transmission-daemon-activation)))
   (default-value (transmission-daemon-configuration))
   (description "Share files using the BitTorrent protocol.")))

(define (generate-transmission-daemon-documentation)
  (generate-documentation
   `((transmission-daemon-configuration
      ,transmission-daemon-configuration-fields))
   'transmission-daemon-configuration))