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>
7 ;;; This file is part of GNU Guix.
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.
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.
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/>.
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))
40 ;; Operating system with 2 inetd services.
41 (simple-operating-system
42 (service dhcp-client-service-type)
43 (service inetd-service-type
58 (program (file-append bash
61 (list "bash" (plain-file "my-dict.sh" "\
64 if [[ $line =~ ^DEFINE\\ (.*)$ ]]
66 case ${BASH_REMATCH[1]} in
68 echo GNU Guix is a package management tool for the GNU system.
71 echo Like an S-expression but with a G.
74 echo NO DEFINITION FOUND
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."
86 (marionette-operating-system %inetd-os))
91 (port-forwardings `((8007 . 7)
95 (with-imported-modules '((gnu build marionette))
97 (use-modules (ice-9 rdelim)
99 (gnu build marionette))
101 (make-marionette (list #$vm)))
108 ;; Make sure the PID file is created.
109 (test-assert "PID file"
111 '(file-exists? "/var/run/inetd.pid")
114 ;; Test the echo service.
115 (test-equal "echo response"
117 (let ((echo (socket PF_INET SOCK_STREAM 0))
118 (addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
120 (display "Hello, Guix!\n" echo)
121 (let ((response (read-line echo)))
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)))
131 (display "DEFINE Guix\n" dict)
132 (let ((response (read-line dict)))
137 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
139 (gexp->derivation "inetd-test" test))
144 (description "Connect to a host with an INETD server.")
145 (value (run-inetd-test))))
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
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")))))
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))
173 #$setup-openvswitch))
176 (define %openvswitch-os
178 (inherit (simple-operating-system
179 (static-networking-service "ovs0" "10.1.1.1"
180 #:netmask "255.255.255.252"
181 #:requirement '(openvswitch-configuration))
182 (service openvswitch-service-type)
183 openvswitch-configuration-service))
184 ;; Ensure the interface name does not change depending on the driver.
185 (kernel-arguments (cons "net.ifnames=0" %default-kernel-arguments))))
187 (define (run-openvswitch-test)
189 (marionette-operating-system %openvswitch-os
190 #:imported-modules '((gnu services herd))))
193 (with-imported-modules '((gnu build marionette))
195 (use-modules (gnu build marionette)
201 (make-marionette (list #$(virtual-machine os))))
206 (test-begin "openvswitch")
208 ;; Make sure the bridge is created.
209 (test-assert "br0 exists"
211 '(zero? (system* #$(file-append openvswitch "/bin/ovs-vsctl")
215 ;; Make sure eth0 is connected to the bridge.
216 (test-equal "eth0 is connected to br0"
220 (use-modules (ice-9 popen) (ice-9 rdelim))
221 (let* ((port (open-pipe*
223 (string-append #$openvswitch "/bin/ovs-vsctl")
224 "port-to-br" "eth0"))
225 (output (read-line port)))
230 ;; Make sure the virtual interface got a static IP.
231 (test-assert "networking has started on ovs0"
234 (use-modules (gnu services herd)
236 (live-service-running
238 (memq 'networking-ovs0
239 (live-service-provision live)))
240 (current-services))))
244 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
246 (gexp->derivation "openvswitch-test" test))
248 (define %test-openvswitch
251 (description "Test a running OpenvSwitch configuration.")
252 (value (run-openvswitch-test))))
259 (define minimal-dhcpd-v4-config-file
260 (plain-file "dhcpd.conf"
262 default-lease-time 600;
265 subnet 192.168.1.0 netmask 255.255.255.0 {
266 range 192.168.1.100 192.168.1.200;
267 option routers 192.168.1.1;
268 option domain-name-servers 192.168.1.2, 192.168.1.3;
269 option domain-name \"dummy.domain.name.abc123xyz\";
273 (define dhcpd-v4-configuration
275 (config-file minimal-dhcpd-v4-config-file)
277 (interfaces '("ens3"))))
280 (simple-operating-system
281 (static-networking-service "ens3" "192.168.1.4"
282 #:netmask "255.255.255.0"
283 #:gateway "192.168.1.1"
284 #:name-servers '("192.168.1.2" "192.168.1.3"))
285 (service dhcpd-service-type dhcpd-v4-configuration)))
287 (define (run-dhcpd-test)
289 (marionette-operating-system %dhcpd-os
290 #:imported-modules '((gnu services herd))))
293 (with-imported-modules '((gnu build marionette))
295 (use-modules (gnu build marionette)
301 (make-marionette (list #$(virtual-machine os))))
308 (test-assert "pid file exists"
311 #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
314 (test-assert "lease file exists"
317 #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
320 (test-assert "run directory exists"
323 #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
326 (test-assert "dhcpd is alive"
329 (use-modules (gnu services herd)
331 (live-service-running
334 (live-service-provision live)))
335 (current-services))))
339 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
341 (gexp->derivation "dhcpd-test" test))
346 (description "Test a running DHCP daemon configuration.")
347 (value (run-dhcpd-test))))
351 ;;; Services related to Tor
355 (simple-operating-system
356 (service tor-service-type)))
358 (define %tor-os/unix-socks-socket
359 (simple-operating-system
360 (service tor-service-type
362 (socks-socket-type 'unix)))))
364 (define (run-tor-test)
366 (marionette-operating-system %tor-os
367 #:imported-modules '((gnu services herd))
368 #:requirements '(tor)))
370 (define os/unix-socks-socket
371 (marionette-operating-system %tor-os/unix-socks-socket
372 #:imported-modules '((gnu services herd))
373 #:requirements '(tor)))
376 (with-imported-modules '((gnu build marionette))
378 (use-modules (gnu build marionette)
384 (make-marionette (list #$(virtual-machine os))))
386 (define (tor-is-alive? marionette)
389 (use-modules (gnu services herd)
391 (live-service-running
394 (live-service-provision live)))
395 (current-services))))
403 ;; Test the usual Tor service.
405 (test-assert "tor is alive"
406 (tor-is-alive? marionette))
408 (test-assert "tor is listening"
409 (let ((default-port 9050))
410 (wait-for-tcp-port default-port marionette)))
412 ;; Don't run two VMs at once.
413 (marionette-control "quit" marionette)
415 ;; Test the Tor service using a SOCKS socket.
417 (let* ((socket-directory "/tmp/more-sockets")
418 (_ (mkdir socket-directory))
419 (marionette/unix-socks-socket
421 (list #$(virtual-machine os/unix-socks-socket))
422 ;; We can't use the same socket directory as the first
424 #:socket-directory socket-directory)))
425 (test-assert "tor is alive, even when using a SOCKS socket"
426 (tor-is-alive? marionette/unix-socks-socket))
428 (test-assert "tor is listening, even when using a SOCKS socket"
429 (wait-for-unix-socket "/var/run/tor/socks-sock"
430 marionette/unix-socks-socket)))
433 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
435 (gexp->derivation "tor-test" test))
440 (description "Test a running Tor daemon configuration.")
441 (value (run-tor-test))))
443 (define* (run-iptables-test)
444 "Run tests of 'iptables-service-type'."
445 (define iptables-rules
450 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp-port-unreachable
454 (define ip6tables-rules
459 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp6-port-unreachable
463 (define inetd-echo-port 7)
466 (marionette-operating-system
467 (simple-operating-system
468 (service dhcp-client-service-type)
469 (service inetd-service-type
474 (socket-type 'stream)
478 (service iptables-service-type
479 (iptables-configuration
480 (ipv4-rules (plain-file "iptables.rules" iptables-rules))
481 (ipv6-rules (plain-file "ip6tables.rules" ip6tables-rules)))))
482 #:imported-modules '((gnu services herd))
483 #:requirements '(inetd iptables)))
486 (with-imported-modules '((gnu build marionette))
488 (use-modules (srfi srfi-64)
489 (gnu build marionette))
491 (make-marionette (list #$(virtual-machine os))))
493 (define (dump-iptables iptables-save marionette)
496 (use-modules (ice-9 popen)
499 (call-with-output-string
502 (open-pipe* OPEN_READ ,iptables-save)
504 (let loop ((line (read-line in)))
505 ;; iptables-save does not output rules in the exact
506 ;; same format we loaded using iptables-restore. It
507 ;; adds comments, packet counters, etc. We remove
509 (unless (eof-object? line)
512 ((string-match "^#" line) #t)
513 ;; Remove packet counters
514 ((string-match "^:([A-Z]*) ([A-Z]*) .*" line)
515 => (lambda (match-record)
516 (format out ":~a ~a~%"
517 (match:substring match-record 1)
518 (match:substring match-record 2))))
519 ;; Pass other lines without modification
520 (else (display line out)
522 (loop (read-line in)))))))))
528 (test-begin "iptables")
530 (test-equal "iptables-save dumps the same rules that were loaded"
531 (dump-iptables #$(file-append iptables "/sbin/iptables-save")
535 (test-equal "ip6tables-save dumps the same rules that were loaded"
536 (dump-iptables #$(file-append iptables "/sbin/ip6tables-save")
540 (test-error "iptables firewall blocks access to inetd echo service"
542 (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))
544 ;; TODO: This test freezes up at the login prompt without any
545 ;; relevant messages on the console. Perhaps it is waiting for some
546 ;; timeout. Find and fix this issue.
547 ;; (test-assert "inetd echo service is accessible after iptables firewall is stopped"
551 ;; (use-modules (gnu services herd))
552 ;; (stop-service 'iptables))
554 ;; (wait-for-tcp-port inetd-echo-port marionette #:timeout 5)))
557 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
559 (gexp->derivation "iptables" test))
561 (define %test-iptables
564 (description "Test a running iptables daemon.")
565 (value (run-iptables-test))))