@@ -20414,20 +20414,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
@@ -2642,6 +2642,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?
@@ -2669,8 +2696,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>
@@ -2795,7 +2828,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
@@ -2814,11 +2917,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
@@ -2862,11 +2961,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
@@ -2875,6 +2972,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.