[jackhill/guix/guix.git] / gnu / tests / networking.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; 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 (gnu packages bash)
  #:use-module (gnu packages networking)
  #:use-module (gnu services shepherd)
  #:export (%test-inetd %test-openvswitch %test-dhcpd))

(define %inetd-os
  ;; Operating system with 2 inetd services.
  (simple-operating-system
   (dhcp-client-service)
   (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)))

          (mkdir #$output)
          (chdir #$output)

          (test-begin "inetd")

          ;; Make sure the PID file is created.
          (test-assert "PID file"
            (marionette-eval
             '(file-exists? "/var/run/inetd.pid")
             marionette))

          ;; 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)
                response)))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "inetd-test" test))

(define %test-inetd
  (system-test
   (name "inetd")
   (description "Connect to a host with an INETD server.")
   (value (run-inetd-test))))

\f
;;;
;;; Open vSwitch
;;;

(define setup-openvswitch
  #~(let ((ovs-vsctl (lambda (str)
                       (zero? (apply system*
                                     #$(file-append openvswitch "/bin/ovs-vsctl")
                                     (string-tokenize str)))))
          (add-native-port (lambda (if)
                             (string-append "--may-exist add-port br0 " if
                                            " vlan_mode=native-untagged"
                                            " -- set Interface " if
                                            " type=internal"))))
      (and (ovs-vsctl "--may-exist add-br br0")
           ;; Connect eth0 as an "untagged" port (no VLANs).
           (ovs-vsctl "--may-exist add-port br0 eth0 vlan_mode=native-untagged")
           (ovs-vsctl (add-native-port "ovs0")))))

(define openvswitch-configuration-service
  (simple-service 'openvswitch-configuration shepherd-root-service-type
                  (list (shepherd-service
                         (provision '(openvswitch-configuration))
                         (requirement '(vswitchd))
                         (start #~(lambda ()
                                    #$setup-openvswitch))
                         (respawn? #f)))))

(define %openvswitch-os
  (simple-operating-system
   (static-networking-service "ovs0" "10.1.1.1"
                              #:netmask "255.255.255.252"
                              #:requirement '(openvswitch-configuration))
   (service openvswitch-service-type
            (openvswitch-configuration
             (package openvswitch)))
   openvswitch-configuration-service))

(define (run-openvswitch-test)
  (define os
    (marionette-operating-system %openvswitch-os
                                 #:imported-modules '((gnu services herd))))

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

          (define marionette
            (make-marionette (list #$(virtual-machine os))))

          (mkdir #$output)
          (chdir #$output)

          (test-begin "openvswitch")

          ;; Make sure the bridge is created.
          (test-assert "br0 exists"
            (marionette-eval
             '(zero? (system* "ovs-vsctl" "br-exists" "br0"))
             marionette))

          ;; Make sure eth0 is connected to the bridge.
          (test-equal "eth0 is connected to br0"
            "br0"
            (marionette-eval
             '(begin
                (use-modules (ice-9 popen) (ice-9 rdelim))
                (let* ((port (open-pipe*
                              OPEN_READ
                              (string-append #$openvswitch "/bin/ovs-vsctl")
                              "port-to-br" "eth0"))
                       (output (read-line port)))
                  (close-pipe port)
                  output))
             marionette))

          ;; Make sure the virtual interface got a static IP.
          (test-assert "networking has started on ovs0"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (srfi srfi-1))
                (live-service-running
                 (find (lambda (live)
                         (memq 'networking-ovs0
                               (live-service-provision live)))
                       (current-services))))
             marionette))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "openvswitch-test" test))

(define %test-openvswitch
  (system-test
   (name "openvswitch")
   (description "Test a running OpenvSwitch configuration.")
   (value (run-openvswitch-test))))

\f
;;;
;;; DHCP Daemon
;;;

(define minimal-dhcpd-v4-config-file
  (plain-file "dhcpd.conf"
              "\
default-lease-time 600;
max-lease-time 7200;

subnet 192.168.1.0 netmask 255.255.255.0 {
 range 192.168.1.100 192.168.1.200;
 option routers 192.168.1.1;
 option domain-name-servers 192.168.1.2, 192.168.1.3;
 option domain-name \"dummy.domain.name.abc123xyz\";
}
"))

(define dhcpd-v4-configuration
  (dhcpd-configuration
   (config-file minimal-dhcpd-v4-config-file)
   (version "4")
   (interfaces '("eth0"))))

(define %dhcpd-os
  (simple-operating-system
   (static-networking-service "eth0" "192.168.1.4"
                              #:netmask "255.255.255.0"
                              #:gateway "192.168.1.1"
                              #:name-servers '("192.168.1.2" "192.168.1.3"))
   (service dhcpd-service-type dhcpd-v4-configuration)))

(define (run-dhcpd-test)
  (define os
    (marionette-operating-system %dhcpd-os
                                 #:imported-modules '((gnu services herd))))

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

          (define marionette
            (make-marionette (list #$(virtual-machine os))))

          (mkdir #$output)
          (chdir #$output)

          (test-begin "dhcpd")

          (test-assert "pid file exists"
            (marionette-eval
             '(file-exists?
               #$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
             marionette))

          (test-assert "lease file exists"
            (marionette-eval
             '(file-exists?
               #$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
             marionette))

          (test-assert "run directory exists"
            (marionette-eval
             '(file-exists?
               #$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
             marionette))

          (test-assert "dhcpd is alive"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (srfi srfi-1))
                (live-service-running
                 (find (lambda (live)
                         (memq 'dhcpv4-daemon
                               (live-service-provision live)))
                       (current-services))))
             marionette))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "dhcpd-test" test))

(define %test-dhcpd
  (system-test
   (name "dhcpd")
   (description "Test a running DHCP daemon configuration.")
   (value (run-dhcpd-test))))
Commit	Line	Data
9260b9d1 TD	1	;;; GNU Guix --- Functional package management for GNU
9260b9d1 TD	2	;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
671dbdb9	3	;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
9260b9d1 TD	4	;;;
	5	;;; This file is part of GNU Guix.
	6	;;;
	7	;;; GNU Guix is free software; you can redistribute it and/or modify it
	8	;;; under the terms of the GNU General Public License as published by
	9	;;; the Free Software Foundation; either version 3 of the License, or (at
	10	;;; your option) any later version.
	11	;;;
	12	;;; GNU Guix is distributed in the hope that it will be useful, but
	13	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	14	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	;;; GNU General Public License for more details.
	16	;;;
	17	;;; You should have received a copy of the GNU General Public License
	18	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	19
	20	(define-module (gnu tests networking)
	21	#:use-module (gnu tests)
	22	#:use-module (gnu system)
9260b9d1 TD	23	#:use-module (gnu system vm)
9260b9d1 TD	24	#:use-module (gnu services)
d94e81db	25	#:use-module (gnu services base)
9260b9d1 TD	26	#:use-module (gnu services networking)
	27	#:use-module (guix gexp)
	28	#:use-module (guix store)
	29	#:use-module (guix monads)
	30	#:use-module (gnu packages bash)
671dbdb9 MB	31	#:use-module (gnu packages networking)
671dbdb9 MB	32	#:use-module (gnu services shepherd)
f1104d90	33	#:export (%test-inetd %test-openvswitch %test-dhcpd))
9260b9d1 TD	34
	35	(define %inetd-os
	36	;; Operating system with 2 inetd services.
892d9089 LC	37	(simple-operating-system
	38	(dhcp-client-service)
	39	(service inetd-service-type
	40	(inetd-configuration
	41	(entries (list
	42	(inetd-entry
	43	(name "echo")
	44	(socket-type 'stream)
	45	(protocol "tcp")
	46	(wait? #f)
	47	(user "root"))
	48	(inetd-entry
	49	(name "dict")
	50	(socket-type 'stream)
	51	(protocol "tcp")
	52	(wait? #f)
	53	(user "root")
	54	(program (file-append bash
	55	"/bin/bash"))
	56	(arguments
	57	(list "bash" (plain-file "my-dict.sh" "\
9260b9d1 TD	58	while read line
	59	do
	60	if [[ $line =~ ^DEFINE\\ (.*)$ ]]
	61	then
	62	case ${BASH_REMATCH[1]} in
	63	Guix)
	64	echo GNU Guix is a package management tool for the GNU system.
	65	;;
	66	G-expression)
	67	echo Like an S-expression but with a G.
	68	;;
	69	*)
	70	echo NO DEFINITION FOUND
	71	;;
	72	esac
	73	else
	74	echo ERROR
	75	fi
892d9089	76	done" ))))))))))
9260b9d1 TD	77
	78	(define* (run-inetd-test)
	79	"Run tests in %INETD-OS, where the inetd service provides an echo service on
	80	port 7, and a dict service on port 2628."
8b113790 LC	81	(define os
8b113790 LC	82	(marionette-operating-system %inetd-os))
9260b9d1	83
8b113790 LC	84	(define vm
	85	(virtual-machine
	86	(operating-system os)
	87	(port-forwardings `((8007 . 7)
	88	(8628 . 2628)))))
9260b9d1	89
8b113790 LC	90	(define test
	91	(with-imported-modules '((gnu build marionette))
	92	#~(begin
	93	(use-modules (ice-9 rdelim)
	94	(srfi srfi-64)
	95	(gnu build marionette))
	96	(define marionette
	97	(make-marionette (list #$vm)))
9260b9d1	98
8b113790 LC	99	(mkdir #$output)
8b113790 LC	100	(chdir #$output)
9260b9d1	101
8b113790	102	(test-begin "inetd")
9260b9d1	103
8b113790 LC	104	;; Make sure the PID file is created.
	105	(test-assert "PID file"
	106	(marionette-eval
	107	'(file-exists? "/var/run/inetd.pid")
	108	marionette))
9260b9d1	109
8b113790 LC	110	;; Test the echo service.
	111	(test-equal "echo response"
	112	"Hello, Guix!"
	113	(let ((echo (socket PF_INET SOCK_STREAM 0))
	114	(addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
	115	(connect echo addr)
	116	(display "Hello, Guix!\n" echo)
	117	(let ((response (read-line echo)))
	118	(close echo)
	119	response)))
9260b9d1	120
8b113790 LC	121	;; Test the dict service
	122	(test-equal "dict response"
	123	"GNU Guix is a package management tool for the GNU system."
	124	(let ((dict (socket PF_INET SOCK_STREAM 0))
	125	(addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
	126	(connect dict addr)
	127	(display "DEFINE Guix\n" dict)
	128	(let ((response (read-line dict)))
	129	(close dict)
	130	response)))
	131
	132	(test-end)
	133	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
	134
	135	(gexp->derivation "inetd-test" test))
9260b9d1 TD	136
	137	(define %test-inetd
	138	(system-test
	139	(name "inetd")
	140	(description "Connect to a host with an INETD server.")
	141	(value (run-inetd-test))))
671dbdb9 MB	142
	143	\f
	144	;;;
	145	;;; Open vSwitch
	146	;;;
	147
	148	(define setup-openvswitch
	149	#~(let ((ovs-vsctl (lambda (str)
	150	(zero? (apply system*
	151	#$(file-append openvswitch "/bin/ovs-vsctl")
	152	(string-tokenize str)))))
	153	(add-native-port (lambda (if)
	154	(string-append "--may-exist add-port br0 " if
	155	" vlan_mode=native-untagged"
	156	" -- set Interface " if
	157	" type=internal"))))
	158	(and (ovs-vsctl "--may-exist add-br br0")
	159	;; Connect eth0 as an "untagged" port (no VLANs).
	160	(ovs-vsctl "--may-exist add-port br0 eth0 vlan_mode=native-untagged")
	161	(ovs-vsctl (add-native-port "ovs0")))))
	162
	163	(define openvswitch-configuration-service
	164	(simple-service 'openvswitch-configuration shepherd-root-service-type
	165	(list (shepherd-service
	166	(provision '(openvswitch-configuration))
	167	(requirement '(vswitchd))
	168	(start #~(lambda ()
	169	#$setup-openvswitch))
	170	(respawn? #f)))))
	171
	172	(define %openvswitch-os
	173	(simple-operating-system
	174	(static-networking-service "ovs0" "10.1.1.1"
	175	#:netmask "255.255.255.252"
	176	#:requirement '(openvswitch-configuration))
	177	(service openvswitch-service-type
	178	(openvswitch-configuration
	179	(package openvswitch)))
	180	openvswitch-configuration-service))
	181
	182	(define (run-openvswitch-test)
	183	(define os
	184	(marionette-operating-system %openvswitch-os
	185	#:imported-modules '((gnu services herd))))
	186
	187	(define test
	188	(with-imported-modules '((gnu build marionette))
	189	#~(begin
	190	(use-modules (gnu build marionette)
	191	(ice-9 popen)
	192	(ice-9 rdelim)
	193	(srfi srfi-64))
	194
	195	(define marionette
	196	(make-marionette (list #$(virtual-machine os))))
	197
	198	(mkdir #$output)
	199	(chdir #$output)
	200
	201	(test-begin "openvswitch")
	202
	203	;; Make sure the bridge is created.
	204	(test-assert "br0 exists"
	205	(marionette-eval
206	'(zero? (system* "ovs-vsctl" "br-exists" "br0"))
207	marionette))
208
209	;; Make sure eth0 is connected to the bridge.
210	(test-equal "eth0 is connected to br0"
211	"br0"
212	(marionette-eval
213	'(begin
214	(use-modules (ice-9 popen) (ice-9 rdelim))
215	(let* ((port (open-pipe*
216	OPEN_READ
217	(string-append #$openvswitch "/bin/ovs-vsctl")
218	"port-to-br" "eth0"))
219	(output (read-line port)))
220	(close-pipe port)
221	output))
222	marionette))
223
224	;; Make sure the virtual interface got a static IP.
225	(test-assert "networking has started on ovs0"
226	(marionette-eval
227	'(begin
228	(use-modules (gnu services herd)
229	(srfi srfi-1))
230	(live-service-running
231	(find (lambda (live)
232	(memq 'networking-ovs0
233	(live-service-provision live)))
234	(current-services))))
235	marionette))
236
237	(test-end)
238	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
239
240	(gexp->derivation "openvswitch-test" test))
241
242	(define %test-openvswitch
243	(system-test
244	(name "openvswitch")
245	(description "Test a running OpenvSwitch configuration.")
246	(value (run-openvswitch-test))))
f1104d90 CM	247
	248	\f
	249	;;;
	250	;;; DHCP Daemon
	251	;;;
	252
	253	(define minimal-dhcpd-v4-config-file
	254	(plain-file "dhcpd.conf"
	255	"\
	256	default-lease-time 600;
	257	max-lease-time 7200;
	258
	259	subnet 192.168.1.0 netmask 255.255.255.0 {
	260	range 192.168.1.100 192.168.1.200;
	261	option routers 192.168.1.1;
	262	option domain-name-servers 192.168.1.2, 192.168.1.3;
	263	option domain-name \"dummy.domain.name.abc123xyz\";
	264	}
	265	"))
	266
	267	(define dhcpd-v4-configuration
	268	(dhcpd-configuration
	269	(config-file minimal-dhcpd-v4-config-file)
	270	(version "4")
	271	(interfaces '("eth0"))))
	272
	273	(define %dhcpd-os
	274	(simple-operating-system
	275	(static-networking-service "eth0" "192.168.1.4"
	276	#:netmask "255.255.255.0"
	277	#:gateway "192.168.1.1"
	278	#:name-servers '("192.168.1.2" "192.168.1.3"))
	279	(service dhcpd-service-type dhcpd-v4-configuration)))
	280
	281	(define (run-dhcpd-test)
	282	(define os
	283	(marionette-operating-system %dhcpd-os
	284	#:imported-modules '((gnu services herd))))
	285
	286	(define test
	287	(with-imported-modules '((gnu build marionette))
	288	#~(begin
	289	(use-modules (gnu build marionette)
	290	(ice-9 popen)
	291	(ice-9 rdelim)
	292	(srfi srfi-64))
	293
	294	(define marionette
	295	(make-marionette (list #$(virtual-machine os))))
	296
	297	(mkdir #$output)
	298	(chdir #$output)
	299
	300	(test-begin "dhcpd")
	301
	302	(test-assert "pid file exists"
	303	(marionette-eval
	304	'(file-exists?
	305	#$(dhcpd-configuration-pid-file dhcpd-v4-configuration))
	306	marionette))
	307
	308	(test-assert "lease file exists"
	309	(marionette-eval
	310	'(file-exists?
311	#$(dhcpd-configuration-lease-file dhcpd-v4-configuration))
312	marionette))
313
314	(test-assert "run directory exists"
315	(marionette-eval
316	'(file-exists?
317	#$(dhcpd-configuration-run-directory dhcpd-v4-configuration))
318	marionette))
319
320	(test-assert "dhcpd is alive"
321	(marionette-eval
322	'(begin
323	(use-modules (gnu services herd)
324	(srfi srfi-1))
325	(live-service-running
326	(find (lambda (live)
327	(memq 'dhcpv4-daemon
328	(live-service-provision live)))
329	(current-services))))
330	marionette))
331
332	(test-end)
333	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
334
335	(gexp->derivation "dhcpd-test" test))
336
337	(define %test-dhcpd
338	(system-test
339	(name "dhcpd")
340	(description "Test a running DHCP daemon configuration.")
341	(value (run-dhcpd-test))))