[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>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.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 %test-tor))

(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))))

\f
;;;
;;; Services related to Tor
;;;

(define %tor-os
  (simple-operating-system
   (tor-service)))

(define %tor-os/unix-socks-socket
  (simple-operating-system
   (service tor-service-type
            (tor-configuration
             (config-file
              (plain-file "test-torrc"
                          "\
SocksPort unix:/var/run/tor/socks-sock
UnixSocksGroupWritable 1
")
              )))))

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

  (define os/unix-socks-socket
    (marionette-operating-system %tor-os/unix-socks-socket
                                 #:imported-modules '((gnu services herd))
                                 #:requirements '(tor)))

  (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))))

          (define (tor-is-alive? marionette)
            (marionette-eval
             '(begin
                (use-modules (gnu services herd)
                             (srfi srfi-1))
                (live-service-running
                 (find (lambda (live)
                         (memq 'tor
                               (live-service-provision live)))
                       (current-services))))
             marionette))

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

          (test-begin "tor")

          ;; Test the usual Tor service.

          (test-assert "tor is alive"
            (tor-is-alive? marionette))

          (test-assert "tor is listening"
            (let ((default-port 9050))
              (wait-for-tcp-port default-port marionette)))

          ;; Don't run two VMs at once.
          (marionette-control "quit" marionette)

          ;; Test the Tor service using a SOCKS socket.

          (let* ((socket-directory "/tmp/more-sockets")
                 (_ (mkdir socket-directory))
                 (marionette/unix-socks-socket
                  (make-marionette
                   (list #$(virtual-machine os/unix-socks-socket))
                   ;; We can't use the same socket directory as the first
                   ;; marionette.
                   #:socket-directory socket-directory)))
            (test-assert "tor is alive, even when using a SOCKS socket"
              (tor-is-alive? marionette/unix-socks-socket))

            (test-assert "tor is listening, even when using a SOCKS socket"
              (wait-for-unix-socket "/var/run/tor/socks-sock"
                                    marionette/unix-socks-socket)))

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

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

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