mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
services: static-networking: Add support for bonding.
* gnu/services/base.scm (<network-link>): Add mac-address field. Set type field to #f by default, so it won't be mandatory. network-link without a type will be used for existing interfaces. (assert-network-link-mac-address, mac-address?): Add sanitizer. Allow valid mac-address or #f. (assert-network-link-type): Add sanitizer. Allow symbol or #f. * gnu/services/base.scm (network-set-up/linux, network-tear-down/linux): Adapt to new structure. * doc/guix.texi (Networking Setup): Document it. * gnu/tests/networking.scm (run-static-networking-advanced-test): New variable. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Alexey Abramov
Ludovic Courtès
parent
b4f2b681ad
commit
670d985cab
3 changed files with 330 additions and 16 deletions
|
|
@ -20453,20 +20453,75 @@ IP address (a string) through which traffic is routed.
|
|||
|
||||
@deftp {Data Type} network-link
|
||||
Data type for a network link (@pxref{Link,,, guile-netlink,
|
||||
Guile-Netlink Manual}).
|
||||
Guile-Netlink Manual}). During startup, network links are employed to
|
||||
construct or modify existing or virtual ethernet links. These ethernet
|
||||
links can be identified by their @var{name} or @var{mac-address}. If
|
||||
there is a need to create virtual interface, @var{name} and @var{type}
|
||||
fields are required.
|
||||
|
||||
@table @code
|
||||
@item name
|
||||
The name of the link---e.g., @code{"v0p0"}.
|
||||
The name of the link---e.g., @code{"v0p0"} (default: @code{#f}).
|
||||
|
||||
@item type
|
||||
A symbol denoting the type of the link---e.g., @code{'veth}.
|
||||
A symbol denoting the type of the link---e.g., @code{'veth} (default: @code{#f}).
|
||||
|
||||
@item mac-address
|
||||
The mac-address of the link---e.g., @code{"98:11:22:33:44:55"} (default: @code{#f}).
|
||||
|
||||
@item arguments
|
||||
List of arguments for this type of link.
|
||||
@end table
|
||||
@end deftp
|
||||
|
||||
Consider a scenario where a server equipped with a network interface
|
||||
which has multiple ports. These ports are connected to a switch, which
|
||||
supports @uref{https://en.wikipedia.org/wiki/Link_aggregation, link
|
||||
aggregation} (also known as bonding or NIC teaming). The switch uses
|
||||
port channels to consolidate multiple physical interfaces into one
|
||||
logical interface to provide higher bandwidth, load balancing, and link
|
||||
redundancy. When a port is added to a LAG (or link aggregation group),
|
||||
it inherits the properties of the port-channel. Some of these
|
||||
properties are VLAN membership, trunk status, and so on.
|
||||
|
||||
@uref{https://en.wikipedia.org/wiki/Virtual_LAN, VLAN} (or virtual local
|
||||
area network) is a logical network that is isolated from other VLANs on
|
||||
the same physical network. This can be used to segregate traffic,
|
||||
improve security, and simplify network management.
|
||||
|
||||
With all that in mind let's configure our static network for the server.
|
||||
We will bond two existing interfaces together using 802.3ad schema and on
|
||||
top of it, build a VLAN interface with id 1055. We assign a static ip
|
||||
to our new VLAN interface.
|
||||
|
||||
@lisp
|
||||
(static-networking
|
||||
(links (list (network-link
|
||||
(name "bond0")
|
||||
(type 'bond)
|
||||
(arguments '((mode . "802.3ad")
|
||||
(miimon . 100)
|
||||
(lacp-active . "on")
|
||||
(lacp-rate . "fast"))))
|
||||
|
||||
(network-link
|
||||
(mac-address "98:11:22:33:44:55")
|
||||
(arguments '((master . "bond0"))))
|
||||
|
||||
(network-link
|
||||
(mac-address "98:11:22:33:44:56")
|
||||
(arguments '((master . "bond0"))))
|
||||
|
||||
(network-link
|
||||
(name "bond0.1055")
|
||||
(type 'vlan)
|
||||
(arguments '((id . 1055)
|
||||
(link . "bond0"))))))
|
||||
(addresses (list (network-address
|
||||
(value "192.168.1.4/24")
|
||||
(device "bond0.1055")))))
|
||||
@end lisp
|
||||
|
||||
@cindex loopback device
|
||||
@defvar %loopback-static-networking
|
||||
This is the @code{static-networking} record representing the ``loopback
|
||||
|
|
|
|||
|
|
@ -2692,6 +2692,33 @@ (define-compile-time-procedure (assert-valid-address (address string?))
|
|||
address)))))))
|
||||
address)
|
||||
|
||||
(define (mac-address? str)
|
||||
"Return true if STR is a valid MAC address."
|
||||
(let ((pattern (make-regexp "^([0-9A-Fa-f]{2}:?){6}$")))
|
||||
(false-if-exception (vector? (regexp-exec pattern str)))))
|
||||
|
||||
(define-compile-time-procedure (assert-network-link-mac-address (value identity))
|
||||
(cond
|
||||
((eq? value #f) value)
|
||||
((and (string? value) (mac-address? value)) value)
|
||||
(else (raise
|
||||
(make-compound-condition
|
||||
(formatted-message (G_ "Value (~S) is not a valid mac address.~%")
|
||||
value)
|
||||
(condition (&error-location
|
||||
(location (source-properties->location procedure-call-location)))))))))
|
||||
|
||||
(define-compile-time-procedure (assert-network-link-type (value identity))
|
||||
(match value
|
||||
(#f value)
|
||||
(('quote _) (datum->syntax #'value value))
|
||||
(else
|
||||
(raise
|
||||
(make-compound-condition
|
||||
(formatted-message (G_ "Value (~S) is not a symbol.~%") value)
|
||||
(condition (&error-location
|
||||
(location (source-properties->location procedure-call-location)))))))))
|
||||
|
||||
(define-record-type* <static-networking>
|
||||
static-networking make-static-networking
|
||||
static-networking?
|
||||
|
|
@ -2719,8 +2746,14 @@ (define-record-type* <network-address>
|
|||
(define-record-type* <network-link>
|
||||
network-link make-network-link
|
||||
network-link?
|
||||
(name network-link-name) ;string--e.g, "v0p0"
|
||||
(type network-link-type) ;symbol--e.g.,'veth
|
||||
(name network-link-name
|
||||
(default #f)) ;string or #f --e.g, "v0p0"
|
||||
(type network-link-type
|
||||
(sanitize assert-network-link-type)
|
||||
(default #f)) ;symbol or #f--e.g.,'veth, 'bond
|
||||
(mac-address network-link-mac-address
|
||||
(sanitize assert-network-link-mac-address)
|
||||
(default #f))
|
||||
(arguments network-link-arguments)) ;list
|
||||
|
||||
(define-record-type* <network-route>
|
||||
|
|
@ -2845,7 +2878,77 @@ (define (network-set-up/linux config)
|
|||
(scheme-file "set-up-network"
|
||||
(with-extensions (list guile-netlink)
|
||||
#~(begin
|
||||
(use-modules (ip addr) (ip link) (ip route))
|
||||
(use-modules (ip addr) (ip link) (ip route)
|
||||
(srfi srfi-1)
|
||||
(ice-9 format)
|
||||
(ice-9 match))
|
||||
|
||||
(define (match-link-by field-accessor value)
|
||||
(fold (lambda (link result)
|
||||
(if (equal? (field-accessor link) value)
|
||||
link
|
||||
result))
|
||||
#f
|
||||
(get-links)))
|
||||
|
||||
(define (alist->keyword+value alist)
|
||||
(fold (match-lambda*
|
||||
(((k . v) r)
|
||||
(cons* (symbol->keyword k) v r))) '() alist))
|
||||
|
||||
;; FIXME: It is interesting that "modprobe bonding" creates an
|
||||
;; interface bond0 straigt away. If we won't have bonding
|
||||
;; module, and execute `ip link add name bond0 type bond' we
|
||||
;; will get
|
||||
;;
|
||||
;; RTNETLINK answers: File exists
|
||||
;;
|
||||
;; This breaks our configuration if we want to
|
||||
;; use `bond0' name. Create (force modprobe
|
||||
;; bonding) and delete the interface to free up
|
||||
;; bond0 name.
|
||||
#$(let lp ((links links))
|
||||
(cond
|
||||
((null? links) #f)
|
||||
((and (network-link? (car links))
|
||||
;; Type is not mandatory
|
||||
(false-if-exception
|
||||
(eq? (network-link-type (car links)) 'bond)))
|
||||
#~(begin
|
||||
(false-if-exception (link-add "bond0" "bond"))
|
||||
(link-del "bond0")))
|
||||
(else (lp (cdr links)))))
|
||||
|
||||
#$@(map (match-lambda
|
||||
(($ <network-link> name type mac-address arguments)
|
||||
(cond
|
||||
;; Create a new interface
|
||||
((and (string? name) (symbol? type))
|
||||
#~(begin
|
||||
(link-add #$name (symbol->string '#$type) #:type-args '#$arguments)
|
||||
;; XXX: If we add routes, addresses must be
|
||||
;; already assigned, and interfaces must be
|
||||
;; up. It doesn't matter if they won't have
|
||||
;; carrier or anything.
|
||||
(link-set #$name #:up #t)))
|
||||
|
||||
;; Amend an existing interface
|
||||
((and (string? name)
|
||||
(eq? type #f))
|
||||
#~(let ((link (match-link-by link-name #$name)))
|
||||
(if link
|
||||
(apply link-set
|
||||
(link-id link)
|
||||
(alist->keyword+value '#$arguments))
|
||||
(format #t (G_ "Interface with name '~a' not found~%") #$name))))
|
||||
((string? mac-address)
|
||||
#~(let ((link (match-link-by link-addr #$mac-address)))
|
||||
(if link
|
||||
(apply link-set
|
||||
(link-id link)
|
||||
(alist->keyword+value '#$arguments))
|
||||
(format #t (G_ "Interface with mac-address '~a' not found~%") #$mac-address)))))))
|
||||
links)
|
||||
|
||||
#$@(map (lambda (address)
|
||||
#~(begin
|
||||
|
|
@ -2864,11 +2967,7 @@ (define (network-set-up/linux config)
|
|||
#:multicast-on #t
|
||||
#:up #t)))
|
||||
addresses)
|
||||
#$@(map (match-lambda
|
||||
(($ <network-link> name type arguments)
|
||||
#~(link-add #$name #$type
|
||||
#:type-args '#$arguments)))
|
||||
links)
|
||||
|
||||
#$@(map (lambda (route)
|
||||
#~(route-add #$(network-route-destination route)
|
||||
#:device
|
||||
|
|
@ -2912,11 +3011,9 @@ (define-syntax-rule (false-if-netlink-error exp)
|
|||
#:src
|
||||
#$(network-route-source route))))
|
||||
routes)
|
||||
#$@(map (match-lambda
|
||||
(($ <network-link> name type arguments)
|
||||
#~(false-if-netlink-error
|
||||
(link-del #$name))))
|
||||
links)
|
||||
|
||||
;; Cleanup addresses first, they might be assigned to
|
||||
;; created bonds, vlans or bridges.
|
||||
#$@(map (lambda (address)
|
||||
#~(false-if-netlink-error
|
||||
(addr-del #$(network-address-device
|
||||
|
|
@ -2925,6 +3022,17 @@ (define-syntax-rule (false-if-netlink-error exp)
|
|||
#:ipv6?
|
||||
#$(network-address-ipv6? address))))
|
||||
addresses)
|
||||
|
||||
;; It is now safe to delete some links
|
||||
#$@(map (match-lambda
|
||||
(($ <network-link> name type mac-address arguments)
|
||||
(cond
|
||||
;; We delete interfaces that were created
|
||||
((and (string? name) (symbol? type))
|
||||
#~(false-if-netlink-error
|
||||
(link-del #$name)))
|
||||
(else #t))))
|
||||
links)
|
||||
#f)))))
|
||||
|
||||
(define (static-networking-shepherd-service config)
|
||||
|
|
|
|||
|
|
@ -39,6 +39,7 @@ (define-module (gnu tests networking)
|
|||
#:use-module (gnu services shepherd)
|
||||
#:use-module (ice-9 match)
|
||||
#:export (%test-static-networking
|
||||
%test-static-networking-advanced
|
||||
%test-inetd
|
||||
%test-openvswitch
|
||||
%test-dhcpd
|
||||
|
|
@ -124,6 +125,156 @@ (define %test-static-networking
|
|||
(guix combinators)))))
|
||||
(run-static-networking-test (virtual-machine os))))))
|
||||
|
||||
(define (run-static-networking-advanced-test vm)
|
||||
(define test
|
||||
(with-imported-modules '((gnu build marionette)
|
||||
(guix build syscalls))
|
||||
#~(begin
|
||||
(use-modules (gnu build marionette)
|
||||
(guix build syscalls)
|
||||
(srfi srfi-64))
|
||||
|
||||
(define marionette
|
||||
(make-marionette
|
||||
'(#$vm "-net" "nic,model=e1000,macaddr=98:11:22:33:44:55"
|
||||
"-net" "nic,model=e1000,macaddr=98:11:22:33:44:56")))
|
||||
|
||||
(test-runner-current (system-test-runner #$output))
|
||||
(test-begin "static-networking-advanced")
|
||||
|
||||
(test-assert "service is up"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(start-service 'networking))
|
||||
marionette))
|
||||
|
||||
(test-assert "network interfaces"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (guix build syscalls))
|
||||
(network-interface-names))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0 bonding mode"
|
||||
"802.3ad 4"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim))
|
||||
(call-with-input-file "/sys/class/net/bond0/bonding/mode" read-line))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0 bonding lacp_rate"
|
||||
"fast 1"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim))
|
||||
(call-with-input-file "/sys/class/net/bond0/bonding/lacp_rate" read-line))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0 bonding miimon"
|
||||
"100"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim))
|
||||
(call-with-input-file "/sys/class/net/bond0/bonding/miimon" read-line))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0 bonding slaves"
|
||||
"a b"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim))
|
||||
(call-with-input-file "/sys/class/net/bond0/bonding/slaves" read-line))
|
||||
marionette))
|
||||
|
||||
;; The hw mac address will come from the first slave bonded to the
|
||||
;; channel.
|
||||
(test-equal "bond0 mac address"
|
||||
"98:11:22:33:44:55"
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (ice-9 rdelim))
|
||||
(call-with-input-file "/sys/class/net/bond0/address" read-line))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0.1055 is up"
|
||||
IFF_UP
|
||||
(marionette-eval
|
||||
'(let* ((sock (socket AF_INET SOCK_STREAM 0))
|
||||
(flags (network-interface-flags sock "bond0.1055")))
|
||||
(logand flags IFF_UP))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0.1055 address is correct"
|
||||
"192.168.1.4"
|
||||
(marionette-eval
|
||||
'(let* ((sock (socket AF_INET SOCK_STREAM 0))
|
||||
(addr (network-interface-address sock "bond0.1055")))
|
||||
(close-port sock)
|
||||
(inet-ntop (sockaddr:fam addr) (sockaddr:addr addr)))
|
||||
marionette))
|
||||
|
||||
(test-equal "bond0.1055 netmask is correct"
|
||||
"255.255.255.0"
|
||||
(marionette-eval
|
||||
'(let* ((sock (socket AF_INET SOCK_STREAM 0))
|
||||
(mask (network-interface-netmask sock "bond0.1055")))
|
||||
(close-port sock)
|
||||
(inet-ntop (sockaddr:fam mask) (sockaddr:addr mask)))
|
||||
marionette))
|
||||
(test-end))))
|
||||
|
||||
(gexp->derivation "static-networking-advanced" test))
|
||||
|
||||
(define %test-static-networking-advanced
|
||||
(system-test
|
||||
(name "static-networking-advanced")
|
||||
(description "Test the 'static-networking' service with advanced features like bonds, vlans etc...")
|
||||
(value
|
||||
(let ((os (marionette-operating-system
|
||||
(simple-operating-system
|
||||
(service static-networking-service-type
|
||||
(list (static-networking
|
||||
(links (list
|
||||
|
||||
(network-link
|
||||
(mac-address "98:11:22:33:44:55")
|
||||
(arguments '((name . "a"))))
|
||||
|
||||
(network-link
|
||||
(mac-address "98:11:22:33:44:56")
|
||||
(arguments '((name . "b"))))
|
||||
|
||||
(network-link
|
||||
(name "bond0")
|
||||
(type 'bond)
|
||||
(arguments '((mode . "802.3ad")
|
||||
(miimon . 100)
|
||||
(lacp-active . "on")
|
||||
(lacp-rate . "fast"))))
|
||||
|
||||
(network-link
|
||||
(name "a")
|
||||
(arguments '((master . "bond0"))))
|
||||
|
||||
(network-link
|
||||
(name "b")
|
||||
(arguments '((master . "bond0"))))
|
||||
|
||||
(network-link
|
||||
(name "bond0.1055")
|
||||
(type 'vlan)
|
||||
(arguments '((id . 1055)
|
||||
(link . "bond0"))))))
|
||||
|
||||
(addresses (list (network-address
|
||||
(value "192.168.1.4/24")
|
||||
(device "bond0.1055"))))))))
|
||||
#:imported-modules '((gnu services herd)
|
||||
(guix combinators)))))
|
||||
(run-static-networking-advanced-test (virtual-machine os))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Inetd.
|
||||
|
|
|
|||
Loading…
Reference in a new issue