gnu/tests/networking.scm

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