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>
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
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))
184 (define (run-openvswitch-test)
186 (marionette-operating-system %openvswitch-os
187 #:imported-modules '((gnu services herd))))
190 (with-imported-modules '((gnu build marionette))
192 (use-modules (gnu build marionette)
198 (make-marionette (list #$(virtual-machine os))))
203 (test-begin "openvswitch")
205 ;; Make sure the bridge is created.
206 (test-assert "br0 exists"
208 '(zero? (system* #$(file-append openvswitch "/bin/ovs-vsctl")
212 ;; Make sure eth0 is connected to the bridge.
213 (test-equal "eth0 is connected to br0"
217 (use-modules (ice-9 popen) (ice-9 rdelim))
218 (let* ((port (open-pipe*
220 (string-append #$openvswitch "/bin/ovs-vsctl")
221 "port-to-br" "eth0"))
222 (output (read-line port)))
227 ;; Make sure the virtual interface got a static IP.
228 (test-assert "networking has started on ovs0"
231 (use-modules (gnu services herd)
233 (live-service-running
235 (memq 'networking-ovs0
236 (live-service-provision live)))
237 (current-services))))
241 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
243 (gexp->derivation "openvswitch-test" test))
245 (define %test-openvswitch
248 (description "Test a running OpenvSwitch configuration.")
249 (value (run-openvswitch-test))))
256 (define minimal-dhcpd-v4-config-file
257 (plain-file "dhcpd.conf"
259 default-lease-time 600;
262 subnet 192.168.1.0 netmask 255.255.255.0 {
263 range 192.168.1.100 192.168.1.200;
264 option routers 192.168.1.1;
265 option domain-name-servers 192.168.1.2, 192.168.1.3;
266 option domain-name \"dummy.domain.name.abc123xyz\";
270 (define dhcpd-v4-configuration
272 (config-file minimal-dhcpd-v4-config-file)
274 (interfaces '("ens3"))))
277 (simple-operating-system
278 (static-networking-service "ens3" "192.168.1.4"
279 #:netmask "255.255.255.0"
280 #:gateway "192.168.1.1"
281 #:name-servers '("192.168.1.2" "192.168.1.3"))
282 (service dhcpd-service-type dhcpd-v4-configuration)))
284 (define (run-dhcpd-test)
286 (marionette-operating-system %dhcpd-os
287 #:imported-modules '((gnu services herd))))
290 (with-imported-modules '((gnu build marionette))
292 (use-modules (gnu build marionette)
298 (make-marionette (list #$(virtual-machine os))))
305 (test-assert "pid file exists"
308 #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
311 (test-assert "lease file exists"
314 #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
317 (test-assert "run directory exists"
320 #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
323 (test-assert "dhcpd is alive"
326 (use-modules (gnu services herd)
328 (live-service-running
331 (live-service-provision live)))
332 (current-services))))
336 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
338 (gexp->derivation "dhcpd-test" test))
343 (description "Test a running DHCP daemon configuration.")
344 (value (run-dhcpd-test))))
348 ;;; Services related to Tor
352 (simple-operating-system
353 (service tor-service-type)))
355 (define %tor-os/unix-socks-socket
356 (simple-operating-system
357 (service tor-service-type
359 (socks-socket-type 'unix)))))
361 (define (run-tor-test)
363 (marionette-operating-system %tor-os
364 #:imported-modules '((gnu services herd))
365 #:requirements '(tor)))
367 (define os/unix-socks-socket
368 (marionette-operating-system %tor-os/unix-socks-socket
369 #:imported-modules '((gnu services herd))
370 #:requirements '(tor)))
373 (with-imported-modules '((gnu build marionette))
375 (use-modules (gnu build marionette)
381 (make-marionette (list #$(virtual-machine os))))
383 (define (tor-is-alive? marionette)
386 (use-modules (gnu services herd)
388 (live-service-running
391 (live-service-provision live)))
392 (current-services))))
400 ;; Test the usual Tor service.
402 (test-assert "tor is alive"
403 (tor-is-alive? marionette))
405 (test-assert "tor is listening"
406 (let ((default-port 9050))
407 (wait-for-tcp-port default-port marionette)))
409 ;; Don't run two VMs at once.
410 (marionette-control "quit" marionette)
412 ;; Test the Tor service using a SOCKS socket.
414 (let* ((socket-directory "/tmp/more-sockets")
415 (_ (mkdir socket-directory))
416 (marionette/unix-socks-socket
418 (list #$(virtual-machine os/unix-socks-socket))
419 ;; We can't use the same socket directory as the first
421 #:socket-directory socket-directory)))
422 (test-assert "tor is alive, even when using a SOCKS socket"
423 (tor-is-alive? marionette/unix-socks-socket))
425 (test-assert "tor is listening, even when using a SOCKS socket"
426 (wait-for-unix-socket "/var/run/tor/socks-sock"
427 marionette/unix-socks-socket)))
430 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
432 (gexp->derivation "tor-test" test))
437 (description "Test a running Tor daemon configuration.")
438 (value (run-tor-test))))
440 (define* (run-iptables-test)
441 "Run tests of 'iptables-service-type'."
442 (define iptables-rules
447 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp-port-unreachable
451 (define ip6tables-rules
456 -A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp6-port-unreachable
460 (define inetd-echo-port 7)
463 (marionette-operating-system
464 (simple-operating-system
465 (service dhcp-client-service-type)
466 (service inetd-service-type
471 (socket-type 'stream)
475 (service iptables-service-type
476 (iptables-configuration
477 (ipv4-rules (plain-file "iptables.rules" iptables-rules))
478 (ipv6-rules (plain-file "ip6tables.rules" ip6tables-rules)))))
479 #:imported-modules '((gnu services herd))
480 #:requirements '(inetd iptables)))
483 (with-imported-modules '((gnu build marionette))
485 (use-modules (srfi srfi-64)
486 (gnu build marionette))
488 (make-marionette (list #$(virtual-machine os))))
490 (define (dump-iptables iptables-save marionette)
493 (use-modules (ice-9 popen)
496 (call-with-output-string
499 (open-pipe* OPEN_READ ,iptables-save)
501 (let loop ((line (read-line in)))
502 ;; iptables-save does not output rules in the exact
503 ;; same format we loaded using iptables-restore. It
504 ;; adds comments, packet counters, etc. We remove
506 (unless (eof-object? line)
509 ((string-match "^#" line) #t)
510 ;; Remove packet counters
511 ((string-match "^:([A-Z]*) ([A-Z]*) .*" line)
512 => (lambda (match-record)
513 (format out ":~a ~a~%"
514 (match:substring match-record 1)
515 (match:substring match-record 2))))
516 ;; Pass other lines without modification
517 (else (display line out)
519 (loop (read-line in)))))))))
525 (test-begin "iptables")
527 (test-equal "iptables-save dumps the same rules that were loaded"
528 (dump-iptables #$(file-append iptables "/sbin/iptables-save")
532 (test-equal "ip6tables-save dumps the same rules that were loaded"
533 (dump-iptables #$(file-append iptables "/sbin/ip6tables-save")
537 (test-error "iptables firewall blocks access to inetd echo service"
539 (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))
541 ;; TODO: This test freezes up at the login prompt without any
542 ;; relevant messages on the console. Perhaps it is waiting for some
543 ;; timeout. Find and fix this issue.
544 ;; (test-assert "inetd echo service is accessible after iptables firewall is stopped"
548 ;; (use-modules (gnu services herd))
549 ;; (stop-service 'iptables))
551 ;; (wait-for-tcp-port inetd-echo-port marionette #:timeout 5)))
554 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
556 (gexp->derivation "iptables" test))
558 (define %test-iptables
561 (description "Test a running iptables daemon.")
562 (value (run-iptables-test))))