gnu/tests/networking.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
   3 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
   4 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu tests networking)
  22   #:use-module (gnu tests)
  23   #:use-module (gnu system)
  24   #:use-module (gnu system vm)
  25   #:use-module (gnu services)
  26   #:use-module (gnu services base)
  27   #:use-module (gnu services networking)
  28   #:use-module (guix gexp)
  29   #:use-module (guix store)
  30   #:use-module (guix monads)
  31   #:use-module (gnu packages bash)
  32   #:use-module (gnu packages networking)
  33   #:use-module (gnu services shepherd)
  34   #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor))
  35
  36 (define %inetd-os
  37   ;; Operating system with 2 inetd services.
  38   (simple-operating-system
  39    (dhcp-client-service)
  40    (service inetd-service-type
  41             (inetd-configuration
  42              (entries (list
  43                        (inetd-entry
  44                         (name "echo")
  45                         (socket-type 'stream)
  46                         (protocol "tcp")
  47                         (wait? #f)
  48                         (user "root"))
  49                        (inetd-entry
  50                         (name "dict")
  51                         (socket-type 'stream)
  52                         (protocol "tcp")
  53                         (wait? #f)
  54                         (user "root")
  55                         (program (file-append bash
  56                                               "/bin/bash"))
  57                         (arguments
  58                          (list "bash" (plain-file "my-dict.sh" "\
  59 while read line
  60 do
  61     if [[ $line =~ ^DEFINE\\ (.*)$ ]]
  62     then
  63         case ${BASH_REMATCH[1]} in
  64             Guix)
  65                 echo GNU Guix is a package management tool for the GNU system.
  66                 ;;
  67             G-expression)
  68                 echo Like an S-expression but with a G.
  69                 ;;
  70             *)
  71                 echo NO DEFINITION FOUND
  72                 ;;
  73         esac
  74     else
  75         echo ERROR
  76     fi
  77 done" ))))))))))
  78
  79 (define* (run-inetd-test)
  80   "Run tests in %INETD-OS, where the inetd service provides an echo service on
  81 port 7, and a dict service on port 2628."
  82   (define os
  83     (marionette-operating-system %inetd-os))
  84
  85   (define vm
  86     (virtual-machine
  87      (operating-system os)
  88      (port-forwardings `((8007 . 7)
  89                          (8628 . 2628)))))
  90
  91   (define test
  92     (with-imported-modules '((gnu build marionette))
  93       #~(begin
  94           (use-modules (ice-9 rdelim)
  95                        (srfi srfi-64)
  96                        (gnu build marionette))
  97           (define marionette
  98             (make-marionette (list #$vm)))
  99
 100           (mkdir #$output)
 101           (chdir #$output)
 102
 103           (test-begin "inetd")
 104
 105           ;; Make sure the PID file is created.
 106           (test-assert "PID file"
 107             (marionette-eval
 108              '(file-exists? "/var/run/inetd.pid")
 109              marionette))
 110
 111           ;; Test the echo service.
 112           (test-equal "echo response"
 113             "Hello, Guix!"
 114             (let ((echo (socket PF_INET SOCK_STREAM 0))
 115                   (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
 116               (connect echo addr)
 117               (display "Hello, Guix!\n" echo)
 118               (let ((response (read-line echo)))
 119                 (close echo)
 120                 response)))
 121
 122           ;; Test the dict service
 123           (test-equal "dict response"
 124             "GNU Guix is a package management tool for the GNU system."
 125             (let ((dict (socket PF_INET SOCK_STREAM 0))
 126                   (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
 127               (connect dict addr)
 128               (display "DEFINE Guix\n" dict)
 129               (let ((response (read-line dict)))
 130                 (close dict)
 131                 response)))
 132
 133           (test-end)
 134           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 135
 136   (gexp->derivation "inetd-test" test))
 137
 138 (define %test-inetd
 139   (system-test
 140    (name "inetd")
 141    (description "Connect to a host with an INETD server.")
 142    (value (run-inetd-test))))
 143
 144 \f
 145 ;;;
 146 ;;; Open vSwitch
 147 ;;;
 148
 149 (define setup-openvswitch
 150   #~(let ((ovs-vsctl (lambda (str)
 151                        (zero? (apply system*
 152                                      #$(file-append openvswitch "/bin/ovs-vsctl")
 153                                      (string-tokenize str)))))
 154           (add-native-port (lambda (if)
 155                              (string-append "--may-exist add-port br0 " if
 156                                             " vlan_mode=native-untagged"
 157                                             " -- set Interface " if
 158                                             " type=internal"))))
 159       (and (ovs-vsctl "--may-exist add-br br0")
 160            ;; Connect eth0 as an "untagged" port (no VLANs).
 161            (ovs-vsctl "--may-exist add-port br0 eth0 vlan_mode=native-untagged")
 162            (ovs-vsctl (add-native-port "ovs0")))))
 163
 164 (define openvswitch-configuration-service
 165   (simple-service 'openvswitch-configuration shepherd-root-service-type
 166                   (list (shepherd-service
 167                          (provision '(openvswitch-configuration))
 168                          (requirement '(vswitchd))
 169                          (start #~(lambda ()
 170                                     #$setup-openvswitch))
 171                          (respawn? #f)))))
 172
 173 (define %openvswitch-os
 174   (simple-operating-system
 175    (static-networking-service "ovs0" "10.1.1.1"
 176                               #:netmask "255.255.255.252"
 177                               #:requirement '(openvswitch-configuration))
 178    (service openvswitch-service-type
 179             (openvswitch-configuration
 180              (package openvswitch)))
 181    openvswitch-configuration-service))
 182
 183 (define (run-openvswitch-test)
 184   (define os
 185     (marionette-operating-system %openvswitch-os
 186                                  #:imported-modules '((gnu services herd))))
 187
 188   (define test
 189     (with-imported-modules '((gnu build marionette))
 190       #~(begin
 191           (use-modules (gnu build marionette)
 192                        (ice-9 popen)
 193                        (ice-9 rdelim)
 194                        (srfi srfi-64))
 195
 196           (define marionette
 197             (make-marionette (list #$(virtual-machine os))))
 198
 199           (mkdir #$output)
 200           (chdir #$output)
 201
 202           (test-begin "openvswitch")
 203
 204           ;; Make sure the bridge is created.
 205           (test-assert "br0 exists"
 206             (marionette-eval
 207              '(zero? (system* "ovs-vsctl" "br-exists" "br0"))
 208              marionette))
 209
 210           ;; Make sure eth0 is connected to the bridge.
 211           (test-equal "eth0 is connected to br0"
 212             "br0"
 213             (marionette-eval
 214              '(begin
 215                 (use-modules (ice-9 popen) (ice-9 rdelim))
 216                 (let* ((port (open-pipe*
 217                               OPEN_READ
 218                               (string-append #$openvswitch "/bin/ovs-vsctl")
 219                               "port-to-br" "eth0"))
 220                        (output (read-line port)))
 221                   (close-pipe port)
 222                   output))
 223              marionette))
 224
 225           ;; Make sure the virtual interface got a static IP.
 226           (test-assert "networking has started on ovs0"
 227             (marionette-eval
 228              '(begin
 229                 (use-modules (gnu services herd)
 230                              (srfi srfi-1))
 231                 (live-service-running
 232                  (find (lambda (live)
 233                          (memq 'networking-ovs0
 234                                (live-service-provision live)))
 235                        (current-services))))
 236              marionette))
 237
 238           (test-end)
 239           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 240
 241   (gexp->derivation "openvswitch-test" test))
 242
 243 (define %test-openvswitch
 244   (system-test
 245    (name "openvswitch")
 246    (description "Test a running OpenvSwitch configuration.")
 247    (value (run-openvswitch-test))))
 248
 249 \f
 250 ;;;
 251 ;;; DHCP Daemon
 252 ;;;
 253
 254 (define minimal-dhcpd-v4-config-file
 255   (plain-file "dhcpd.conf"
 256               "\
 257 default-lease-time 600;
 258 max-lease-time 7200;
 259
 260 subnet 192.168.1.0 netmask 255.255.255.0 {
 261  range 192.168.1.100 192.168.1.200;
 262  option routers 192.168.1.1;
 263  option domain-name-servers 192.168.1.2, 192.168.1.3;
 264  option domain-name \"dummy.domain.name.abc123xyz\";
 265 }
 266 "))
 267
 268 (define dhcpd-v4-configuration
 269   (dhcpd-configuration
 270    (config-file minimal-dhcpd-v4-config-file)
 271    (version "4")
 272    (interfaces '("eth0"))))
 273
 274 (define %dhcpd-os
 275   (simple-operating-system
 276    (static-networking-service "eth0" "192.168.1.4"
 277                               #:netmask "255.255.255.0"
 278                               #:gateway "192.168.1.1"
 279                               #:name-servers '("192.168.1.2" "192.168.1.3"))
 280    (service dhcpd-service-type dhcpd-v4-configuration)))
 281
 282 (define (run-dhcpd-test)
 283   (define os
 284     (marionette-operating-system %dhcpd-os
 285                                  #:imported-modules '((gnu services herd))))
 286
 287   (define test
 288     (with-imported-modules '((gnu build marionette))
 289       #~(begin
 290           (use-modules (gnu build marionette)
 291                        (ice-9 popen)
 292                        (ice-9 rdelim)
 293                        (srfi srfi-64))
 294
 295           (define marionette
 296             (make-marionette (list #$(virtual-machine os))))
 297
 298           (mkdir #$output)
 299           (chdir #$output)
 300
 301           (test-begin "dhcpd")
 302
 303           (test-assert "pid file exists"
 304             (marionette-eval
 305              '(file-exists?
 306                #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
 307              marionette))
 308
 309           (test-assert "lease file exists"
 310             (marionette-eval
 311              '(file-exists?
 312                #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
 313              marionette))
 314
 315           (test-assert "run directory exists"
 316             (marionette-eval
 317              '(file-exists?
 318                #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
 319              marionette))
 320
 321           (test-assert "dhcpd is alive"
 322             (marionette-eval
 323              '(begin
 324                 (use-modules (gnu services herd)
 325                              (srfi srfi-1))
 326                 (live-service-running
 327                  (find (lambda (live)
 328                          (memq 'dhcpv4-daemon
 329                                (live-service-provision live)))
 330                        (current-services))))
 331              marionette))
 332
 333           (test-end)
 334           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 335
 336   (gexp->derivation "dhcpd-test" test))
 337
 338 (define %test-dhcpd
 339   (system-test
 340    (name "dhcpd")
 341    (description "Test a running DHCP daemon configuration.")
 342    (value (run-dhcpd-test))))
 343
 344 \f
 345 ;;;
 346 ;;; Services related to Tor
 347 ;;;
 348
 349 (define %tor-os
 350   (simple-operating-system
 351    (tor-service)))
 352
 353 (define %tor-os/unix-socks-socket
 354   (simple-operating-system
 355    (service tor-service-type
 356             (tor-configuration
 357              (config-file
 358               (plain-file "test-torrc"
 359                           "\
 360 SocksPort unix:/var/run/tor/socks-sock
 361 UnixSocksGroupWritable 1
 362 ")
 363               )))))
 364
 365 (define (run-tor-test)
 366   (define os
 367     (marionette-operating-system %tor-os
 368                                  #:imported-modules '((gnu services herd))
 369                                  #:requirements '(tor)))
 370
 371   (define os/unix-socks-socket
 372     (marionette-operating-system %tor-os/unix-socks-socket
 373                                  #:imported-modules '((gnu services herd))
 374                                  #:requirements '(tor)))
 375
 376   (define test
 377     (with-imported-modules '((gnu build marionette))
 378       #~(begin
 379           (use-modules (gnu build marionette)
 380                        (ice-9 popen)
 381                        (ice-9 rdelim)
 382                        (srfi srfi-64))
 383
 384           (define marionette
 385             (make-marionette (list #$(virtual-machine os))))
 386
 387           (define (tor-is-alive? marionette)
 388             (marionette-eval
 389              '(begin
 390                 (use-modules (gnu services herd)
 391                              (srfi srfi-1))
 392                 (live-service-running
 393                  (find (lambda (live)
 394                          (memq 'tor
 395                                (live-service-provision live)))
 396                        (current-services))))
 397              marionette))
 398
 399           (mkdir #$output)
 400           (chdir #$output)
 401
 402           (test-begin "tor")
 403
 404           ;; Test the usual Tor service.
 405
 406           (test-assert "tor is alive"
 407             (tor-is-alive? marionette))
 408
 409           (test-assert "tor is listening"
 410             (let ((default-port 9050))
 411               (wait-for-tcp-port default-port marionette)))
 412
 413           ;; Don't run two VMs at once.
 414           (marionette-control "quit" marionette)
 415
 416           ;; Test the Tor service using a SOCKS socket.
 417
 418           (let* ((socket-directory "/tmp/more-sockets")
 419                  (_ (mkdir socket-directory))
 420                  (marionette/unix-socks-socket
 421                   (make-marionette
 422                    (list #$(virtual-machine os/unix-socks-socket))
 423                    ;; We can't use the same socket directory as the first
 424                    ;; marionette.
 425                    #:socket-directory socket-directory)))
 426             (test-assert "tor is alive, even when using a SOCKS socket"
 427               (tor-is-alive? marionette/unix-socks-socket))
 428
 429             (test-assert "tor is listening, even when using a SOCKS socket"
 430               (wait-for-unix-socket "/var/run/tor/socks-sock"
 431                                     marionette/unix-socks-socket)))
 432
 433           (test-end)
 434           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 435
 436   (gexp->derivation "tor-test" test))
 437
 438 (define %test-tor
 439   (system-test
 440    (name "tor")
 441    (description "Test a running Tor daemon configuration.")
 442    (value (run-tor-test))))