mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-26 22:38:07 -05:00
5dfd80e1c5
* gnu/services/networking.scm (tor-configuration->torrc): Set PidFile to /var/run/tor/tor.pid in the base torrc configuration. (tor-shepherd-service) <start>: Call make-forkexec-constructor/container with a new #:pid-file argument to tell Shepherd where to find the PID file. Add a a new <file-system-mapping> to its existing #:mappings argument to share /var/run/tor with the the container. (tor-hidden-services-activation): Update docstring. Create /var/run/tor and set its permissions so only the tor user can access it. * gnu/tests/networking.scm (%test-tor, %tor-os): New variables. (run-tor-test): New procedure.
395 lines
12 KiB
Scheme
395 lines
12 KiB
Scheme
;;; 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 %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))))
|
||
|
||
|
||
;;;
|
||
;;; 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))))
|
||
|
||
|
||
;;;
|
||
;;; 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))))
|
||
|
||
|
||
;;;
|
||
;;; Services related to Tor
|
||
;;;
|
||
|
||
(define %tor-os
|
||
(simple-operating-system
|
||
(tor-service)))
|
||
|
||
(define (run-tor-test)
|
||
(define os
|
||
(marionette-operating-system %tor-os
|
||
#: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))))
|
||
|
||
(mkdir #$output)
|
||
(chdir #$output)
|
||
|
||
(test-begin "tor")
|
||
|
||
(test-assert "tor is alive"
|
||
(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))
|
||
|
||
(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))))
|