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 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu tests networking)
  23   #:use-module (gnu tests)
  24   #:use-module (gnu system)
  25   #:use-module (gnu system vm)
  26   #:use-module (gnu services)
  27   #:use-module (gnu services base)
  28   #:use-module (gnu services networking)
  29   #:use-module (guix gexp)
  30   #:use-module (guix store)
  31   #:use-module (guix monads)
  32   #:use-module (gnu packages bash)
  33   #:use-module (gnu packages linux)
  34   #:use-module (gnu packages networking)
  35   #:use-module (gnu services shepherd)
  36   #:use-module (ice-9 match)
  37   #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables))
  38
  39 (define %inetd-os
  40   ;; Operating system with 2 inetd services.
  41   (simple-operating-system
  42    (service dhcp-client-service-type)
  43    (service inetd-service-type
  44             (inetd-configuration
  45              (entries (list
  46                        (inetd-entry
  47                         (name "echo")
  48                         (socket-type 'stream)
  49                         (protocol "tcp")
  50                         (wait? #f)
  51                         (user "root"))
  52                        (inetd-entry
  53                         (name "dict")
  54                         (socket-type 'stream)
  55                         (protocol "tcp")
  56                         (wait? #f)
  57                         (user "root")
  58                         (program (file-append bash
  59                                               "/bin/bash"))
  60                         (arguments
  61                          (list "bash" (plain-file "my-dict.sh" "\
  62 while read line
  63 do
  64     if [[ $line =~ ^DEFINE\\ (.*)$ ]]
  65     then
  66         case ${BASH_REMATCH[1]} in
  67             Guix)
  68                 echo GNU Guix is a package management tool for the GNU system.
  69                 ;;
  70             G-expression)
  71                 echo Like an S-expression but with a G.
  72                 ;;
  73             *)
  74                 echo NO DEFINITION FOUND
  75                 ;;
  76         esac
  77     else
  78         echo ERROR
  79     fi
  80 done" ))))))))))
  81
  82 (define* (run-inetd-test)
  83   "Run tests in %INETD-OS, where the inetd service provides an echo service on
  84 port 7, and a dict service on port 2628."
  85   (define os
  86     (marionette-operating-system %inetd-os))
  87
  88   (define vm
  89     (virtual-machine
  90      (operating-system os)
  91      (port-forwardings `((8007 . 7)
  92                          (8628 . 2628)))))
  93
  94   (define test
  95     (with-imported-modules '((gnu build marionette))
  96       #~(begin
  97           (use-modules (ice-9 rdelim)
  98                        (srfi srfi-64)
  99                        (gnu build marionette))
 100           (define marionette
 101             (make-marionette (list #$vm)))
 102
 103           (mkdir #$output)
 104           (chdir #$output)
 105
 106           (test-begin "inetd")
 107
 108           ;; Make sure the PID file is created.
 109           (test-assert "PID file"
 110             (marionette-eval
 111              '(file-exists? "/var/run/inetd.pid")
 112              marionette))
 113
 114           ;; Test the echo service.
 115           (test-equal "echo response"
 116             "Hello, Guix!"
 117             (let ((echo (socket PF_INET SOCK_STREAM 0))
 118                   (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
 119               (connect echo addr)
 120               (display "Hello, Guix!\n" echo)
 121               (let ((response (read-line echo)))
 122                 (close echo)
 123                 response)))
 124
 125           ;; Test the dict service
 126           (test-equal "dict response"
 127             "GNU Guix is a package management tool for the GNU system."
 128             (let ((dict (socket PF_INET SOCK_STREAM 0))
 129                   (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
 130               (connect dict addr)
 131               (display "DEFINE Guix\n" dict)
 132               (let ((response (read-line dict)))
 133                 (close dict)
 134                 response)))
 135
 136           (test-end)
 137           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 138
 139   (gexp->derivation "inetd-test" test))
 140
 141 (define %test-inetd
 142   (system-test
 143    (name "inetd")
 144    (description "Connect to a host with an INETD server.")
 145    (value (run-inetd-test))))
 146
 147 \f
 148 ;;;
 149 ;;; Open vSwitch
 150 ;;;
 151
 152 (define setup-openvswitch
 153   #~(let ((ovs-vsctl (lambda (str)
 154                        (zero? (apply system*
 155                                      #$(file-append openvswitch "/bin/ovs-vsctl")
 156                                      (string-tokenize str)))))
 157           (add-native-port (lambda (if)
 158                              (string-append "--may-exist add-port br0 " if
 159                                             " vlan_mode=native-untagged"
 160                                             " -- set Interface " if
 161                                             " type=internal"))))
 162       (and (ovs-vsctl "--may-exist add-br br0")
 163            ;; Connect eth0 as an "untagged" port (no VLANs).
 164            (ovs-vsctl "--may-exist add-port br0 eth0 vlan_mode=native-untagged")
 165            (ovs-vsctl (add-native-port "ovs0")))))
 166
 167 (define openvswitch-configuration-service
 168   (simple-service 'openvswitch-configuration shepherd-root-service-type
 169                   (list (shepherd-service
 170                          (provision '(openvswitch-configuration))
 171                          (requirement '(vswitchd))
 172                          (start #~(lambda ()
 173                                     #$setup-openvswitch))
 174                          (respawn? #f)))))
 175
 176 (define %openvswitch-os
 177   (simple-operating-system
 178    (static-networking-service "ovs0" "10.1.1.1"
 179                               #:netmask "255.255.255.252"
 180                               #:requirement '(openvswitch-configuration))
 181    (service openvswitch-service-type)
 182    openvswitch-configuration-service))
 183
 184 (define (run-openvswitch-test)
 185   (define os
 186     (marionette-operating-system %openvswitch-os
 187                                  #:imported-modules '((gnu services herd))))
 188
 189   (define test
 190     (with-imported-modules '((gnu build marionette))
 191       #~(begin
 192           (use-modules (gnu build marionette)
 193                        (ice-9 popen)
 194                        (ice-9 rdelim)
 195                        (srfi srfi-64))
 196
 197           (define marionette
 198             (make-marionette (list #$(virtual-machine os))))
 199
 200           (mkdir #$output)
 201           (chdir #$output)
 202
 203           (test-begin "openvswitch")
 204
 205           ;; Make sure the bridge is created.
 206           (test-assert "br0 exists"
 207             (marionette-eval
 208              '(zero? (system* "ovs-vsctl" "br-exists" "br0"))
 209              marionette))
 210
 211           ;; Make sure eth0 is connected to the bridge.
 212           (test-equal "eth0 is connected to br0"
 213             "br0"
 214             (marionette-eval
 215              '(begin
 216                 (use-modules (ice-9 popen) (ice-9 rdelim))
 217                 (let* ((port (open-pipe*
 218                               OPEN_READ
 219                               (string-append #$openvswitch "/bin/ovs-vsctl")
 220                               "port-to-br" "eth0"))
 221                        (output (read-line port)))
 222                   (close-pipe port)
 223                   output))
 224              marionette))
 225
 226           ;; Make sure the virtual interface got a static IP.
 227           (test-assert "networking has started on ovs0"
 228             (marionette-eval
 229              '(begin
 230                 (use-modules (gnu services herd)
 231                              (srfi srfi-1))
 232                 (live-service-running
 233                  (find (lambda (live)
 234                          (memq 'networking-ovs0
 235                                (live-service-provision live)))
 236                        (current-services))))
 237              marionette))
 238
 239           (test-end)
 240           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 241
 242   (gexp->derivation "openvswitch-test" test))
 243
 244 (define %test-openvswitch
 245   (system-test
 246    (name "openvswitch")
 247    (description "Test a running OpenvSwitch configuration.")
 248    (value (run-openvswitch-test))))
 249
 250 \f
 251 ;;;
 252 ;;; DHCP Daemon
 253 ;;;
 254
 255 (define minimal-dhcpd-v4-config-file
 256   (plain-file "dhcpd.conf"
 257               "\
 258 default-lease-time 600;
 259 max-lease-time 7200;
 260
 261 subnet 192.168.1.0 netmask 255.255.255.0 {
 262  range 192.168.1.100 192.168.1.200;
 263  option routers 192.168.1.1;
 264  option domain-name-servers 192.168.1.2, 192.168.1.3;
 265  option domain-name \"dummy.domain.name.abc123xyz\";
 266 }
 267 "))
 268
 269 (define dhcpd-v4-configuration
 270   (dhcpd-configuration
 271    (config-file minimal-dhcpd-v4-config-file)
 272    (version "4")
 273    (interfaces '("eth0"))))
 274
 275 (define %dhcpd-os
 276   (simple-operating-system
 277    (static-networking-service "eth0" "192.168.1.4"
 278                               #:netmask "255.255.255.0"
 279                               #:gateway "192.168.1.1"
 280                               #:name-servers '("192.168.1.2" "192.168.1.3"))
 281    (service dhcpd-service-type dhcpd-v4-configuration)))
 282
 283 (define (run-dhcpd-test)
 284   (define os
 285     (marionette-operating-system %dhcpd-os
 286                                  #:imported-modules '((gnu services herd))))
 287
 288   (define test
 289     (with-imported-modules '((gnu build marionette))
 290       #~(begin
 291           (use-modules (gnu build marionette)
 292                        (ice-9 popen)
 293                        (ice-9 rdelim)
 294                        (srfi srfi-64))
 295
 296           (define marionette
 297             (make-marionette (list #$(virtual-machine os))))
 298
 299           (mkdir #$output)
 300           (chdir #$output)
 301
 302           (test-begin "dhcpd")
 303
 304           (test-assert "pid file exists"
 305             (marionette-eval
 306              '(file-exists?
 307                #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
 308              marionette))
 309
 310           (test-assert "lease file exists"
 311             (marionette-eval
 312              '(file-exists?
 313                #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
 314              marionette))
 315
 316           (test-assert "run directory exists"
 317             (marionette-eval
 318              '(file-exists?
 319                #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
 320              marionette))
 321
 322           (test-assert "dhcpd is alive"
 323             (marionette-eval
 324              '(begin
 325                 (use-modules (gnu services herd)
 326                              (srfi srfi-1))
 327                 (live-service-running
 328                  (find (lambda (live)
 329                          (memq 'dhcpv4-daemon
 330                                (live-service-provision live)))
 331                        (current-services))))
 332              marionette))
 333
 334           (test-end)
 335           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 336
 337   (gexp->derivation "dhcpd-test" test))
 338
 339 (define %test-dhcpd
 340   (system-test
 341    (name "dhcpd")
 342    (description "Test a running DHCP daemon configuration.")
 343    (value (run-dhcpd-test))))
 344
 345 \f
 346 ;;;
 347 ;;; Services related to Tor
 348 ;;;
 349
 350 (define %tor-os
 351   (simple-operating-system
 352    (service tor-service-type)))
 353
 354 (define %tor-os/unix-socks-socket
 355   (simple-operating-system
 356    (service tor-service-type
 357             (tor-configuration
 358              (socks-socket-type 'unix)))))
 359
 360 (define (run-tor-test)
 361   (define os
 362     (marionette-operating-system %tor-os
 363                                  #:imported-modules '((gnu services herd))
 364                                  #:requirements '(tor)))
 365
 366   (define os/unix-socks-socket
 367     (marionette-operating-system %tor-os/unix-socks-socket
 368                                  #:imported-modules '((gnu services herd))
 369                                  #:requirements '(tor)))
 370
 371   (define test
 372     (with-imported-modules '((gnu build marionette))
 373       #~(begin
 374           (use-modules (gnu build marionette)
 375                        (ice-9 popen)
 376                        (ice-9 rdelim)
 377                        (srfi srfi-64))
 378
 379           (define marionette
 380             (make-marionette (list #$(virtual-machine os))))
 381
 382           (define (tor-is-alive? marionette)
 383             (marionette-eval
 384              '(begin
 385                 (use-modules (gnu services herd)
 386                              (srfi srfi-1))
 387                 (live-service-running
 388                  (find (lambda (live)
 389                          (memq 'tor
 390                                (live-service-provision live)))
 391                        (current-services))))
 392              marionette))
 393
 394           (mkdir #$output)
 395           (chdir #$output)
 396
 397           (test-begin "tor")
 398
 399           ;; Test the usual Tor service.
 400
 401           (test-assert "tor is alive"
 402             (tor-is-alive? marionette))
 403
 404           (test-assert "tor is listening"
 405             (let ((default-port 9050))
 406               (wait-for-tcp-port default-port marionette)))
 407
 408           ;; Don't run two VMs at once.
 409           (marionette-control "quit" marionette)
 410
 411           ;; Test the Tor service using a SOCKS socket.
 412
 413           (let* ((socket-directory "/tmp/more-sockets")
 414                  (_ (mkdir socket-directory))
 415                  (marionette/unix-socks-socket
 416                   (make-marionette
 417                    (list #$(virtual-machine os/unix-socks-socket))
 418                    ;; We can't use the same socket directory as the first
 419                    ;; marionette.
 420                    #:socket-directory socket-directory)))
 421             (test-assert "tor is alive, even when using a SOCKS socket"
 422               (tor-is-alive? marionette/unix-socks-socket))
 423
 424             (test-assert "tor is listening, even when using a SOCKS socket"
 425               (wait-for-unix-socket "/var/run/tor/socks-sock"
 426                                     marionette/unix-socks-socket)))
 427
 428           (test-end)
 429           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 430
 431   (gexp->derivation "tor-test" test))
 432
 433 (define %test-tor
 434   (system-test
 435    (name "tor")
 436    (description "Test a running Tor daemon configuration.")
 437    (value (run-tor-test))))
 438
 439 (define* (run-iptables-test)
 440   "Run tests of 'iptables-service-type'."
 441   (define iptables-rules
 442     "*filter
 443 :INPUT ACCEPT
 444 :FORWARD ACCEPT
 445 :OUTPUT ACCEPT
 446 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp-port-unreachable
 447 COMMIT
 448 ")
 449
 450   (define ip6tables-rules
 451     "*filter
 452 :INPUT ACCEPT
 453 :FORWARD ACCEPT
 454 :OUTPUT ACCEPT
 455 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp6-port-unreachable
 456 COMMIT
 457 ")
 458
 459   (define inetd-echo-port 7)
 460
 461   (define os
 462     (marionette-operating-system
 463      (simple-operating-system
 464       (service dhcp-client-service-type)
 465       (service inetd-service-type
 466                (inetd-configuration
 467                 (entries (list
 468                           (inetd-entry
 469                            (name "echo")
 470                            (socket-type 'stream)
 471                            (protocol "tcp")
 472                            (wait? #f)
 473                            (user "root"))))))
 474       (service iptables-service-type
 475                (iptables-configuration
 476                 (ipv4-rules (plain-file "iptables.rules" iptables-rules))
 477                 (ipv6-rules (plain-file "ip6tables.rules" ip6tables-rules)))))
 478      #:imported-modules '((gnu services herd))
 479      #:requirements '(inetd iptables)))
 480
 481   (define test
 482     (with-imported-modules '((gnu build marionette))
 483       #~(begin
 484           (use-modules (srfi srfi-64)
 485                        (gnu build marionette))
 486           (define marionette
 487             (make-marionette (list #$(virtual-machine os))))
 488
 489           (define (dump-iptables iptables-save marionette)
 490             (marionette-eval
 491              `(begin
 492                 (use-modules (ice-9 popen)
 493                              (ice-9 rdelim)
 494                              (ice-9 regex))
 495                 (call-with-output-string
 496                   (lambda (out)
 497                     (call-with-port
 498                      (open-pipe* OPEN_READ ,iptables-save)
 499                      (lambda (in)
 500                        (let loop ((line (read-line in)))
 501                          ;; iptables-save does not output rules in the exact
 502                          ;; same format we loaded using iptables-restore. It
 503                          ;; adds comments, packet counters, etc. We remove
 504                          ;; these additions.
 505                          (unless (eof-object? line)
 506                            (cond
 507                             ;; Remove comments
 508                             ((string-match "^#" line) #t)
 509                             ;; Remove packet counters
 510                             ((string-match "^:([A-Z]*) ([A-Z]*) .*" line)
 511                              => (lambda (match-record)
 512                                   (format out ":~a ~a~%"
 513                                           (match:substring match-record 1)
 514                                           (match:substring match-record 2))))
 515                             ;; Pass other lines without modification
 516                             (else (display line out)
 517                                   (newline out)))
 518                            (loop (read-line in)))))))))
 519              marionette))
 520
 521           (mkdir #$output)
 522           (chdir #$output)
 523
 524           (test-begin "iptables")
 525
 526           (test-equal "iptables-save dumps the same rules that were loaded"
 527             (dump-iptables #$(file-append iptables "/sbin/iptables-save")
 528                            marionette)
 529             #$iptables-rules)
 530
 531           (test-equal "ip6tables-save dumps the same rules that were loaded"
 532             (dump-iptables #$(file-append iptables "/sbin/ip6tables-save")
 533                            marionette)
 534             #$ip6tables-rules)
 535
 536           (test-error "iptables firewall blocks access to inetd echo service"
 537                       'misc-error
 538                       (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))
 539
 540           ;; TODO: This test freezes up at the login prompt without any
 541           ;; relevant messages on the console. Perhaps it is waiting for some
 542           ;; timeout. Find and fix this issue.
 543           ;; (test-assert "inetd echo service is accessible after iptables firewall is stopped"
 544           ;;   (begin
 545           ;;     (marionette-eval
 546           ;;      '(begin
 547           ;;         (use-modules (gnu services herd))
 548           ;;         (stop-service 'iptables))
 549           ;;      marionette)
 550           ;;     (wait-for-tcp-port inetd-echo-port marionette #:timeout 5)))
 551
 552           (test-end)
 553           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 554
 555   (gexp->derivation "iptables" test))
 556
 557 (define %test-iptables
 558   (system-test
 559    (name "iptables")
 560    (description "Test a running iptables daemon.")
 561    (value (run-iptables-test))))