;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (test-minetest) #:use-module (guix build-system minetest) #:use-module (guix upstream) #:use-module (guix memoization) #:use-module (guix import minetest) #:use-module (guix i
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017, 2020 Marius Bakke <marius@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu tests networking)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services networking)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:use-module (guix monads)
  #:use-module (guix modules)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages networking)
  #:use-module (gnu packages guile)
  #:use-module (gnu services shepherd)
  #:use-module (ice-9 match)
  #:export (%test-static-networking
            %test-static-networking-failure
            %test-static-networking-advanced
            %test-inetd
            %test-openvswitch
            %test-dhcpd
            %test-tor
            %test-iptables
            %test-ipfs))


;;;
;;; Static networking.
;;;

(define (run-static-networking-test vm)
  (define test
    (with-imported-modules '((gnu build marionette)
                             (guix build syscalls))
      #~(begin
          (use-modules (gnu build marionette)
                       (guix build syscalls)
                       (srfi srfi-64))

          (define marionette
            (make-marionette
             '(#$vm "-nic" "user,model=virtio-net-pci")))

          (test-runner-current (system-test-runner #$output))
          (test-begin "static-networking")

          (test-assert "service is up"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'networking))
             marionette))

          (test-assert "network interfaces"
            (marionette-eval
             '(begin
                (use-modules (guix build syscalls))
                (network-interface-names))
             marionette))

          (test-equal "address of eth0"
            "10.0.2.15"
            (marionette-eval
             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
                     (addr (network-interface-address sock "eth0")))
                (close-port sock)
                (inet-ntop (sockaddr:fam addr) (sockaddr:addr addr)))
             marionette))

          (test-equal "netmask of eth0"
            "255.255.255.0"
            (marionette-eval
             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
                     (mask (network-interface-netmask sock "eth0")))
                (close-port sock)
                (inet-ntop (sockaddr:fam mask) (sockaddr:addr mask)))
             marionette))

          (test-equal "eth0 is up"
            IFF_UP
            (marionette-eval
             '(let* ((sock  (socket AF_INET SOCK_STREAM 0))
                     (flags (network-interface-flags sock "eth0")))
                (logand flags IFF_UP))
             marionette))

          (test-end))))

  (gexp->derivation "static-networking" test))

(define %test-static-networking
  (system-test
   (name "static-networking")
   (description "Test the 'static-networking' service.")
   (value
    (let ((os (marionette-operating-system
               (simple-operating-system
                (service static-networking-service-type
                         (list %qemu-static-networking)))
               #:imported-modules '((gnu services herd)
                                    (guix combinators)))))
      (run-static-networking-test (virtual-machine os))))))


(define %static-networking-with-nonexistent-device
  ;; Similar to %QEMU-STATIC-NETWORKING except that the device does not exist.
  (static-networking
   (addresses (list (network-address
                     (device "does-not-exist")    ;<- really
                     (value "10.0.2.15/24"))))
   (routes (list (network-route
                  (destination "default")
                  (gateway "10.0.2.2"))))
   (requirement '())
   (provision '(networking))
   (name-servers '("10.0.2.3"))))

(define (run-static-networking-failure-test vm)
  (define test
    (with-imported-modules '((gnu build marionette)
                             (guix build syscalls))
      #~(begin
          (use-modules (gnu build marionette)
                       (guix build syscalls)
                       (srfi srfi-64))

          (define marionette
            (make-marionette '(#$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "static-networking")

          (test-equal "service fails to start"
            #f
            ;; The 'start' method of the 'networking' service should fail
            ;; within a minute or so.  Previously it would never complete:
            ;; <https://issues.guix.gnu.org/71173>.
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (alarm 180)                 ;must complete in a timely fashion
                (start-service 'networking))
             marionette))

          (test-equal "network interfaces"
            '("lo")
            (marionette-eval
             '(begin
                (use-modules (guix build syscalls))
                (network-interface-names))
             marionette))

          (test-end))))

  (gexp->derivation "static-networking-failure" test))

(define %test-static-networking-failure
  (system-test
   (name "static-networking-failure")
   (description "Test the behavior of the 'static-networking' service when
passed an invalid device.")
   (value
    (let ((os (marionette-operating-system
               (simple-operating-system
                (service static-networking-service-type
                         (list %static-networking-with-nonexistent-device)))
               #:imported-modules '((gnu services herd)
                                    (guix combinators)))))
      (run-static-networking-failure-test (virtual-machine os))))))


(define (run-static-networking-advanced-test vm)
  (define test
    (with-imported-modules '((gnu build marionette)
                             (guix build syscalls))
      #~(begin
          (use-modules (gnu build marionette)
                       (guix build syscalls)
                       (srfi srfi-64))

          (define marionette
            (make-marionette
             '(#$vm "-net" "nic,model=e1000,macaddr=98:11:22:33:44:55"
                    "-net" "nic,model=e1000,macaddr=98:11:22:33:44:56")))

          (test-runner-current (system-test-runner #$output))
          (test-begin "static-networking-advanced")

          (test-assert "service is up"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'networking))
             marionette))

          (test-assert "network interfaces"
            (marionette-eval
             '(begin
                (use-modules (guix build syscalls))
                (network-interface-names))
             marionette))

          (test-equal "bond0 bonding mode"
            "802.3ad 4"
            (marionette-eval
             '(begin
                (use-modules (ice-9 rdelim))
                (call-with-input-file "/sys/class/net/bond0/bonding/mode" read-line))
             marionette))

          (test-equal "bond0 bonding lacp_rate"
            "fast 1"
            (marionette-eval
             '(begin
                (use-modules (ice-9 rdelim))
                (call-with-input-file "/sys/class/net/bond0/bonding/lacp_rate" read-line))
             marionette))

          (test-equal "bond0 bonding miimon"
            "100"
            (marionette-eval
             '(begin
                (use-modules (ice-9 rdelim))
                (call-with-input-file "/sys/class/net/bond0/bonding/miimon" read-line))
             marionette))

          (test-equal "bond0 bonding slaves"
            "a b"
            (marionette-eval
             '(begin
                (use-modules (ice-9 rdelim))
                (call-with-input-file "/sys/class/net/bond0/bonding/slaves" read-line))
             marionette))

          ;; The hw mac address will come from the first slave bonded to the
          ;; channel.
          (test-equal "bond0 mac address"
            "98:11:22:33:44:55"
            (marionette-eval
             '(begin
                (use-modules (ice-9 rdelim))
                (call-with-input-file "/sys/class/net/bond0/address" read-line))
             marionette))

          (test-equal "bond0.1055 is up"
            IFF_UP
            (marionette-eval
             '(let* ((sock  (socket AF_INET SOCK_STREAM 0))
                     (flags (network-interface-flags sock "bond0.1055")))
                (logand flags IFF_UP))
             marionette))

          (test-equal "bond0.1055 address is correct"
            "192.168.1.4"
            (marionette-eval
             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
                     (addr (network-interface-address sock "bond0.1055")))
                (close-port sock)
                (inet-ntop (sockaddr:fam addr) (sockaddr:addr addr)))
             marionette))

          (test-equal "bond0.1055 netmask is correct"
            "255.255.255.0"
            (marionette-eval
             '(let* ((sock (socket AF_INET SOCK_STREAM 0))
                     (mask (network-interface-netmask sock "bond0.1055")))
                (close-port sock)
                (inet-ntop (sockaddr:fam mask) (sockaddr:addr mask)))
             marionette))
          (test-end))))

  (gexp->derivation "static-networking-advanced" test))

(define %test-static-networking-advanced
  (system-test
   (name "static-networking-advanced")
   (description "Test the 'static-networking' service with advanced features like bonds, vlans etc...")
   (value
    (let ((os (marionette-operating-system
               (simple-operating-system
                (service static-networking-service-type
                         (list (static-networking
                                (links (list

                                        (network-link
                                         (mac-address "98:11:22:33:44:55")
                                         (arguments '((name . "a"))))

                                        (network-link
                                         (mac-address "98:11:22:33:44:56")
                                         (arguments '((name . "b"))))

                                        (network-link
                                         (name "bond0")
                                         (type 'bond)
                                         (arguments '((mode . "802.3ad")
                                                      (miimon . 100)
                                                      (lacp-active . "on")
                                                      (lacp-rate . "fast"))))

                                        (network-link
                                         (name "a")
                                         (arguments '((master . "bond0"))))

                                        (network-link
                                         (name "b")
                                         (arguments '((master . "bond0"))))

                                        (network-link
                                         (name "bond0.1055")
                                         (type 'vlan)
                                         (arguments '((id . 1055)
                                                      (link . "bond0"))))))

                                (addresses (list (network-address
                                                  (value "192.168.1.4/24")
                                                  (device "bond0.1055"))))))))
               #:imported-modules '((gnu services herd)
                                    (guix combinators)))))
      (run-static-networking-advanced-test (virtual-machine os))))))


;;;
;;; Inetd.
;;;

(define %inetd-os
  ;; Operating system with 2 inetd services.
  (simple-operating-system
   (service dhcp-client-service-type)
   (service inetd-service-type
            (inetd-configuration
             (entries (list
                       (inetd-entry
                        (name "echo")
                        (socket-type 'stream)
                        (protocol "tcp")
                        (wait? #f)
                        (user "root"))
                       (inetd-entry
                        (name "dict")
                        (socket-type 'stream)
                        (protocol "tcp")
                        (wait? #f)
                        (user "root")
                        (program (file-append bash
                                              "/bin/bash"))
                        (arguments
                         (list "bash" (plain-file "my-dict.sh" "\
while read line
do
    if [[ $line =~ ^DEFINE\\ (.*)$ ]]
    then
        case ${BASH_REMATCH[1]} in
            Guix)
                echo GNU Guix is a package management tool for the GNU system.
                ;;
            G-expression)
                echo Like an S-expression but with a G.
                ;;
            *)
                echo NO DEFINITION FOUND
                ;;
        esac
    else
        echo ERROR
    fi
done" ))))))))))

(define* (run-inetd-test)
  "Run tests in %INETD-OS, where the inetd service provides an echo service on
port 7, and a dict service on port 2628."
  (define os
    (marionette-operating-system %inetd-os))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings `((8007 . 7)
                         (8628 . 2628)))))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (ice-9 rdelim)
                       (srfi srfi-64)
                       (gnu build marionette))
          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "inetd")

          ;; Make sure the PID file is created.
          (test-assert "PID file"
            (wait-for-file "/var/run/inetd.pid" marionette
                           #:timeout 30))

          ;; Test the echo service.
          (test-equal "echo response"
            "Hello, Guix!"
            (let ((echo (socket PF_INET SOCK_STREAM 0))
                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
              (connect echo addr)
              (display "Hello, Guix!\n" echo)
              (let ((response (read-line echo)))
                (close echo)
                response)))

          ;; Test the dict service
          (test-equal "dict response"
            "GNU Guix is a package management tool for the GNU system."
            (let ((dict (socket PF_INET SOCK_STREAM 0))
                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
              (connect dict addr)
              (display "DEFINE Guix\n" dict)
              (let ((response (read-line dict)))
                (close dict)