gnu/tests/file-sharing.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2021 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 ;;;
  20 ;;; The Transmission Daemon service.
  21 ;;;
  22
  23 (define-module (gnu tests file-sharing)
  24   #:use-module (gnu packages bittorrent)
  25   #:use-module (gnu services)
  26   #:use-module (gnu services file-sharing)
  27   #:use-module (gnu services networking)
  28   #:use-module (gnu system vm)
  29   #:use-module (gnu tests)
  30   #:use-module (guix gexp)
  31   #:export (%test-transmission-daemon))
  32
  33 (define %transmission-daemon-user "transmission")
  34 (define %transmission-daemon-group "transmission")
  35
  36 (define %transmission-daemon-config-dir "/var/lib/transmission-daemon")
  37 (define %transmission-daemon-watch-dir
  38   (string-append %transmission-daemon-config-dir "/watch"))
  39 (define %transmission-daemon-incomplete-dir
  40   (string-append %transmission-daemon-config-dir "/incomplete"))
  41
  42 (define %transmission-daemon-settings-file
  43   (string-append %transmission-daemon-config-dir "/settings.json"))
  44
  45 (define %transmission-daemon-peer-port 51000) ; default is 51413
  46
  47 (define %transmission-daemon-rpc-port 9999)   ; default is 9091
  48 (define %transmission-daemon-rpc-username "test-username")
  49 (define %transmission-daemon-rpc-password "test-password")
  50
  51 (define %transmission-daemon-test-configuration
  52   (transmission-daemon-configuration
  53    (incomplete-dir-enabled? #t)
  54    (incomplete-dir %transmission-daemon-incomplete-dir)
  55
  56    (watch-dir-enabled? #t)
  57    (watch-dir %transmission-daemon-watch-dir)
  58
  59    (peer-port-random-on-start? #f)
  60    (peer-port %transmission-daemon-peer-port)
  61
  62    (rpc-enabled? #t)
  63    (rpc-port %transmission-daemon-rpc-port)
  64    (rpc-whitelist-enabled? #f)
  65    (rpc-authentication-required? #t)
  66    (rpc-username %transmission-daemon-rpc-username)
  67    (rpc-password (transmission-password-hash %transmission-daemon-rpc-password
  68                                              "yEK0q3.X"))))
  69
  70 (define (run-transmission-daemon-test)
  71   (define os
  72     (marionette-operating-system
  73      (simple-operating-system
  74       (service dhcp-client-service-type)
  75       (service transmission-daemon-service-type
  76                %transmission-daemon-test-configuration))
  77      #:imported-modules '((gnu services herd)
  78                           (json parser))
  79      #:requirements '(transmission-daemon)))
  80
  81   (define test
  82     (with-imported-modules '((gnu build marionette))
  83       #~(begin
  84           (use-modules (gnu build marionette)
  85                        (srfi srfi-64))
  86
  87           (define marionette
  88             (make-marionette
  89              (list #$(virtual-machine
  90                       (operating-system os)
  91                       (port-forwardings
  92                        `((9091 . ,%transmission-daemon-rpc-port)))))))
  93
  94           (test-runner-current (system-test-runner #$output))
  95           (test-begin "transmission-daemon")
  96
  97           ;; Make sure the "transmission" user and group have been created.
  98           (test-assert "\"transmission\" user exists"
  99             (marionette-eval
 100              '(begin
 101                 (getpwnam #$%transmission-daemon-user)
 102                 #t)
 103              marionette))
 104           (test-assert "\"transmission\" group exists"
 105             (marionette-eval
 106              '(begin
 107                 (getgrnam #$%transmission-daemon-group)
 108                 #t)
 109              marionette))
 110
 111           ;; Make sure Transmission Daemon's configuration directory has been
 112           ;; created with the correct ownership and permissions.
 113           (test-assert "configuration directory exists"
 114             (marionette-eval
 115              '(eq? (stat:type (stat #$%transmission-daemon-config-dir))
 116                    'directory)
 117              marionette))
 118           (test-assert "configuration directory has correct ownership"
 119             (marionette-eval
 120              '(let ((config-dir (stat #$%transmission-daemon-config-dir))
 121                     (transmission-user (getpwnam #$%transmission-daemon-user)))
 122                 (and (eqv? (stat:uid config-dir)
 123                            (passwd:uid transmission-user))
 124                      (eqv? (stat:gid config-dir)
 125                            (passwd:gid transmission-user))))
 126              marionette))
 127           (test-assert "configuration directory has expected permissions"
 128             (marionette-eval
 129              '(eqv? (stat:perms (stat #$%transmission-daemon-config-dir))
 130                     #o750)
 131              marionette))
 132
 133           ;; Make sure the incomplete-downloads and watch directories have been
 134           ;; created with the correct ownership and permissions.
 135           (test-assert "incomplete-downloads directory exists"
 136             (marionette-eval
 137              '(eq? (stat:type (stat #$%transmission-daemon-incomplete-dir))
 138                    'directory)
 139              marionette))
 140           (test-assert "incomplete-downloads directory has correct ownership"
 141             (marionette-eval
 142              '(let ((incomplete-dir
 143                      (stat #$%transmission-daemon-incomplete-dir))
 144                     (transmission-user
 145                      (getpwnam #$%transmission-daemon-user)))
 146                 (and (eqv? (stat:uid incomplete-dir)
 147                            (passwd:uid transmission-user))
 148                      (eqv? (stat:gid incomplete-dir)
 149                            (passwd:gid transmission-user))))
 150              marionette))
 151           (test-assert
 152               "incomplete-downloads directory has expected permissions"
 153             (marionette-eval
 154              '(eqv? (stat:perms (stat #$%transmission-daemon-incomplete-dir))
 155                     #o750)
 156              marionette))
 157
 158           (test-assert "watch directory exists"
 159             (marionette-eval
 160              '(eq? (stat:type (stat #$%transmission-daemon-watch-dir))
 161                    'directory)
 162              marionette))
 163           (test-assert "watch directory has correct ownership"
 164             (marionette-eval
 165              '(let ((watch-dir (stat #$%transmission-daemon-watch-dir))
 166                     (transmission-user (getpwnam #$%transmission-daemon-user)))
 167                 (and (eqv? (stat:uid watch-dir)
 168                            (passwd:uid transmission-user))
 169                      (eqv? (stat:gid watch-dir)
 170                            (passwd:gid transmission-user))))
 171              marionette))
 172           (test-assert "watch directory has expected permissions"
 173             (marionette-eval
 174              '(eqv? (stat:perms (stat #$%transmission-daemon-watch-dir))
 175                     #o770)
 176              marionette))
 177
 178           ;; Make sure the settings file has been created and appears valid.
 179           (test-assert "settings file exists"
 180             (marionette-eval
 181              '(file-exists? #$%transmission-daemon-settings-file)
 182              marionette))
 183           (test-assert "settings file is valid JSON"
 184             (marionette-eval
 185              '(begin
 186                 (use-modules (json parser))
 187                 (with-input-from-file #$%transmission-daemon-settings-file
 188                   (lambda ()
 189                     (json->scm)))
 190                 #t)
 191              marionette))
 192           (test-assert "settings file contains a non-empty JSON object"
 193             (marionette-eval
 194              '(begin
 195                 (use-modules (json parser)
 196                              (srfi srfi-1))
 197                 (let ((settings (with-input-from-file
 198                                     #$%transmission-daemon-settings-file
 199                                   (lambda ()
 200                                     (json->scm)))))
 201                   (and (list? settings)
 202                        (not (null? settings))
 203                        (every pair? settings))))
 204              marionette))
 205
 206           ;; Make sure Transmission Daemon is running.
 207           (test-assert "transmission-daemon is running"
 208             (marionette-eval
 209              '(begin
 210                 (use-modules (gnu services herd))
 211                 (live-service-running
 212                  (find (lambda (live-service)
 213                          (memq 'transmission-daemon
 214                                (live-service-provision live-service)))
 215                        (current-services))))
 216              marionette))
 217
 218           ;; Make sure the daemon is listening for peer connections.
 219           (test-assert "transmission-daemon is listening for peers"
 220             (wait-for-tcp-port #$%transmission-daemon-peer-port marionette))
 221
 222           ;; Make sure the daemon is listening for RPC-client connections.
 223           (test-assert "transmission-daemon is listening for RPC clients"
 224             (wait-for-tcp-port #$%transmission-daemon-rpc-port marionette))
 225
 226           ;; Make sure the RPC-authentication settings are honored.
 227           (test-assert "transmission-daemon requires RPC authentication"
 228             (let ((transmission-remote
 229                    (string-append #+transmission "/bin/transmission-remote")))
 230               (with-error-to-port (%make-void-port "w")
 231                 (lambda ()
 232                   (not (zero? (system* transmission-remote
 233                                        "--session-info")))))))
 234           (test-assert "transmission-daemon rejects incorrect RPC credentials"
 235             (let ((transmission-remote
 236                    (string-append #+transmission "/bin/transmission-remote"))
 237                   (wrong-auth-string
 238                    (string-append #$%transmission-daemon-rpc-username
 239                                   ":"
 240                                   "wrong-"
 241                                   #$%transmission-daemon-rpc-password)))
 242               (with-error-to-port (%make-void-port "w")
 243                 (lambda ()
 244                   (not (zero? (system* transmission-remote
 245                                        "--auth" wrong-auth-string
 246                                        "--session-info")))))))
 247           (test-assert "transmission-daemon accepts correct RPC credentials"
 248             (let ((transmission-remote
 249                    (string-append #+transmission "/bin/transmission-remote"))
 250                   (auth-string
 251                    (string-append #$%transmission-daemon-rpc-username
 252                                   ":"
 253                                   #$%transmission-daemon-rpc-password)))
 254               (with-output-to-port (%make-void-port "w")
 255                 (lambda ()
 256                   (zero? (system* transmission-remote
 257                                   "--auth" auth-string
 258                                   "--session-info"))))))
 259
 260           (test-end))))
 261
 262   (gexp->derivation "transmission-daemon-test" test))
 263
 264 (define %test-transmission-daemon
 265   (system-test
 266    (name "transmission-daemon")
 267    (description "Test a running Transmission Daemon service.")
 268    (value (run-transmission-daemon-test))))