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
 183              (package openvswitch)))
 184    openvswitch-configuration-service))
 185
 186 (define (run-openvswitch-test)
 187   (define os
 188     (marionette-operating-system %openvswitch-os
 189                                  #:imported-modules '((gnu services herd))))
 190
 191   (define test
 192     (with-imported-modules '((gnu build marionette))
 193       #~(begin
 194           (use-modules (gnu build marionette)
 195                        (ice-9 popen)
 196                        (ice-9 rdelim)
 197                        (srfi srfi-64))
 198
 199           (define marionette
 200             (make-marionette (list #$(virtual-machine os))))
 201
 202           (mkdir #$output)
 203           (chdir #$output)
 204
 205           (test-begin "openvswitch")
 206
 207           ;; Make sure the bridge is created.
 208           (test-assert "br0 exists"
 209             (marionette-eval
 210              '(zero? (system* "ovs-vsctl" "br-exists" "br0"))
 211              marionette))
 212
 213           ;; Make sure eth0 is connected to the bridge.
 214           (test-equal "eth0 is connected to br0"
 215             "br0"
 216             (marionette-eval
 217              '(begin
 218                 (use-modules (ice-9 popen) (ice-9 rdelim))
 219                 (let* ((port (open-pipe*
 220                               OPEN_READ
 221                               (string-append #$openvswitch "/bin/ovs-vsctl")
 222                               "port-to-br" "eth0"))
 223                        (output (read-line port)))
 224                   (close-pipe port)
 225                   output))
 226              marionette))
 227
 228           ;; Make sure the virtual interface got a static IP.
 229           (test-assert "networking has started on ovs0"
 230             (marionette-eval
 231              '(begin
 232                 (use-modules (gnu services herd)
 233                              (srfi srfi-1))
 234                 (live-service-running
 235                  (find (lambda (live)
 236                          (memq 'networking-ovs0
 237                                (live-service-provision live)))
 238                        (current-services))))
 239              marionette))
 240
 241           (test-end)
 242           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 243
 244   (gexp->derivation "openvswitch-test" test))
 245
 246 (define %test-openvswitch
 247   (system-test
 248    (name "openvswitch")
 249    (description "Test a running OpenvSwitch configuration.")
 250    (value (run-openvswitch-test))))
 251
 252 \f
 253 ;;;
 254 ;;; DHCP Daemon
 255 ;;;
 256
 257 (define minimal-dhcpd-v4-config-file
 258   (plain-file "dhcpd.conf"
 259               "\
 260 default-lease-time 600;
 261 max-lease-time 7200;
 262
 263 subnet 192.168.1.0 netmask 255.255.255.0 {
 264  range 192.168.1.100 192.168.1.200;
 265  option routers 192.168.1.1;
 266  option domain-name-servers 192.168.1.2, 192.168.1.3;
 267  option domain-name \"dummy.domain.name.abc123xyz\";
 268 }
 269 "))
 270
 271 (define dhcpd-v4-configuration
 272   (dhcpd-configuration
 273    (config-file minimal-dhcpd-v4-config-file)
 274    (version "4")
 275    (interfaces '("eth0"))))
 276
 277 (define %dhcpd-os
 278   (simple-operating-system
 279    (static-networking-service "eth0" "192.168.1.4"
 280                               #:netmask "255.255.255.0"
 281                               #:gateway "192.168.1.1"
 282                               #:name-servers '("192.168.1.2" "192.168.1.3"))
 283    (service dhcpd-service-type dhcpd-v4-configuration)))
 284
 285 (define (run-dhcpd-test)
 286   (define os
 287     (marionette-operating-system %dhcpd-os
 288                                  #:imported-modules '((gnu services herd))))
 289
 290   (define test
 291     (with-imported-modules '((gnu build marionette))
 292       #~(begin
 293           (use-modules (gnu build marionette)
 294                        (ice-9 popen)
 295                        (ice-9 rdelim)
 296                        (srfi srfi-64))
 297
 298           (define marionette
 299             (make-marionette (list #$(virtual-machine os))))
 300
 301           (mkdir #$output)
 302           (chdir #$output)
 303
 304           (test-begin "dhcpd")
 305
 306           (test-assert "pid file exists"
 307             (marionette-eval
 308              '(file-exists?
 309                #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
 310              marionette))
 311
 312           (test-assert "lease file exists"
 313             (marionette-eval
 314              '(file-exists?
 315                #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
 316              marionette))
 317
 318           (test-assert "run directory exists"
 319             (marionette-eval
 320              '(file-exists?
 321                #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
 322              marionette))
 323
 324           (test-assert "dhcpd is alive"
 325             (marionette-eval
 326              '(begin
 327                 (use-modules (gnu services herd)
 328                              (srfi srfi-1))
 329                 (live-service-running
 330                  (find (lambda (live)
 331                          (memq 'dhcpv4-daemon
 332                                (live-service-provision live)))
 333                        (current-services))))
 334              marionette))
 335
 336           (test-end)
 337           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 338
 339   (gexp->derivation "dhcpd-test" test))
 340
 341 (define %test-dhcpd
 342   (system-test
 343    (name "dhcpd")
 344    (description "Test a running DHCP daemon configuration.")
 345    (value (run-dhcpd-test))))
 346
 347 \f
 348 ;;;
 349 ;;; Services related to Tor
 350 ;;;
 351
 352 (define %tor-os
 353   (simple-operating-system
 354    (tor-service)))
 355
 356 (define %tor-os/unix-socks-socket
 357   (simple-operating-system
 358    (service tor-service-type
 359             (tor-configuration
 360              (socks-socket-type 'unix)))))
 361
 362 (define (run-tor-test)
 363   (define os
 364     (marionette-operating-system %tor-os
 365                                  #:imported-modules '((gnu services herd))
 366                                  #:requirements '(tor)))
 367
 368   (define os/unix-socks-socket
 369     (marionette-operating-system %tor-os/unix-socks-socket
 370                                  #:imported-modules '((gnu services herd))
 371                                  #:requirements '(tor)))
 372
 373   (define test
 374     (with-imported-modules '((gnu build marionette))
 375       #~(begin
 376           (use-modules (gnu build marionette)
 377                        (ice-9 popen)
 378                        (ice-9 rdelim)
 379                        (srfi srfi-64))
 380
 381           (define marionette
 382             (make-marionette (list #$(virtual-machine os))))
 383
 384           (define (tor-is-alive? marionette)
 385             (marionette-eval
 386              '(begin
 387                 (use-modules (gnu services herd)
 388                              (srfi srfi-1))
 389                 (live-service-running
 390                  (find (lambda (live)
 391                          (memq 'tor
 392                                (live-service-provision live)))
 393                        (current-services))))
 394              marionette))
 395
 396           (mkdir #$output)
 397           (chdir #$output)
 398
 399           (test-begin "tor")
 400
 401           ;; Test the usual Tor service.
 402
 403           (test-assert "tor is alive"
 404             (tor-is-alive? marionette))
 405
 406           (test-assert "tor is listening"
 407             (let ((default-port 9050))
 408               (wait-for-tcp-port default-port marionette)))
 409
 410           ;; Don't run two VMs at once.
 411           (marionette-control "quit" marionette)
 412
 413           ;; Test the Tor service using a SOCKS socket.
 414
 415           (let* ((socket-directory "/tmp/more-sockets")
 416                  (_ (mkdir socket-directory))
 417                  (marionette/unix-socks-socket
 418                   (make-marionette
 419                    (list #$(virtual-machine os/unix-socks-socket))
 420                    ;; We can't use the same socket directory as the first
 421                    ;; marionette.
 422                    #:socket-directory socket-directory)))
 423             (test-assert "tor is alive, even when using a SOCKS socket"
 424               (tor-is-alive? marionette/unix-socks-socket))
 425
 426             (test-assert "tor is listening, even when using a SOCKS socket"
 427               (wait-for-unix-socket "/var/run/tor/socks-sock"
 428                                     marionette/unix-socks-socket)))
 429
 430           (test-end)
 431           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 432
 433   (gexp->derivation "tor-test" test))
 434
 435 (define %test-tor
 436   (system-test
 437    (name "tor")
 438    (description "Test a running Tor daemon configuration.")
 439    (value (run-tor-test))))
 440
 441 (define* (run-iptables-test)
 442   "Run tests of 'iptables-service-type'."
 443   (define iptables-rules
 444     "*filter
 445 :INPUT ACCEPT
 446 :FORWARD ACCEPT
 447 :OUTPUT ACCEPT
 448 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp-port-unreachable
 449 COMMIT
 450 ")
 451
 452   (define ip6tables-rules
 453     "*filter
 454 :INPUT ACCEPT
 455 :FORWARD ACCEPT
 456 :OUTPUT ACCEPT
 457 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp6-port-unreachable
 458 COMMIT
 459 ")
 460
 461   (define inetd-echo-port 7)
 462
 463   (define os
 464     (marionette-operating-system
 465      (simple-operating-system
 466       (service dhcp-client-service-type)
 467       (service inetd-service-type
 468                (inetd-configuration
 469                 (entries (list
 470                           (inetd-entry
 471                            (name "echo")
 472                            (socket-type 'stream)
 473                            (protocol "tcp")
 474                            (wait? #f)
 475                            (user "root"))))))
 476       (service iptables-service-type
 477                (iptables-configuration
 478                 (ipv4-rules (plain-file "iptables.rules" iptables-rules))
 479                 (ipv6-rules (plain-file "ip6tables.rules" ip6tables-rules)))))
 480      #:imported-modules '((gnu services herd))
 481      #:requirements '(inetd iptables)))
 482
 483   (define test
 484     (with-imported-modules '((gnu build marionette))
 485       #~(begin
 486           (use-modules (srfi srfi-64)
 487                        (gnu build marionette))
 488           (define marionette
 489             (make-marionette (list #$(virtual-machine os))))
 490
 491           (define (dump-iptables iptables-save marionette)
 492             (marionette-eval
 493              `(begin
 494                 (use-modules (ice-9 popen)
 495                              (ice-9 rdelim)
 496                              (ice-9 regex))
 497                 (call-with-output-string
 498                   (lambda (out)
 499                     (call-with-port
 500                      (open-pipe* OPEN_READ ,iptables-save)
 501                      (lambda (in)
 502                        (let loop ((line (read-line in)))
 503                          ;; iptables-save does not output rules in the exact
 504                          ;; same format we loaded using iptables-restore. It
 505                          ;; adds comments, packet counters, etc. We remove
 506                          ;; these additions.
 507                          (unless (eof-object? line)
 508                            (cond
 509                             ;; Remove comments
 510                             ((string-match "^#" line) #t)
 511                             ;; Remove packet counters
 512                             ((string-match "^:([A-Z]*) ([A-Z]*) .*" line)
 513                              => (lambda (match-record)
 514                                   (format out ":~a ~a~%"
 515                                           (match:substring match-record 1)
 516                                           (match:substring match-record 2))))
 517                             ;; Pass other lines without modification
 518                             (else (display line out)
 519                                   (newline out)))
 520                            (loop (read-line in)))))))))
 521              marionette))
 522
 523           (mkdir #$output)
 524           (chdir #$output)
 525
 526           (test-begin "iptables")
 527
 528           (test-equal "iptables-save dumps the same rules that were loaded"
 529             (dump-iptables #$(file-append iptables "/sbin/iptables-save")
 530                            marionette)
 531             #$iptables-rules)
 532
 533           (test-equal "ip6tables-save dumps the same rules that were loaded"
 534             (dump-iptables #$(file-append iptables "/sbin/ip6tables-save")
 535                            marionette)
 536             #$ip6tables-rules)
 537
 538           (test-error "iptables firewall blocks access to inetd echo service"
 539                       'misc-error
 540                       (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))
 541
 542           ;; TODO: This test freezes up at the login prompt without any
 543           ;; relevant messages on the console. Perhaps it is waiting for some
 544           ;; timeout. Find and fix this issue.
 545           ;; (test-assert "inetd echo service is accessible after iptables firewall is stopped"
 546           ;;   (begin
 547           ;;     (marionette-eval
 548           ;;      '(begin
 549           ;;         (use-modules (gnu services herd))
 550           ;;         (stop-service 'iptables))
 551           ;;      marionette)
 552           ;;     (wait-for-tcp-port inetd-echo-port marionette #:timeout 5)))
 553
 554           (test-end)
 555           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 556
 557   (gexp->derivation "iptables" test))
 558
 559 (define %test-iptables
 560   (system-test
 561    (name "iptables")
 562    (description "Test a running iptables daemon.")
 563    (value (run-iptables-test))))