diff options
| -rw-r--r-- | doc/guix.texi | 61 | ||||
| -rw-r--r-- | gnu/services/base.scm | 134 | ||||
| -rw-r--r-- | gnu/tests/networking.scm | 151 |
3 files changed, 330 insertions, 16 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index ad26a29513..dc16ec1d15 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 98d59fd36d..82c6940780 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -2692,6 +2692,33 @@ Write, say, @samp{\"~a/24\"} for a 24-bit network mask.") 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 @@ Write, say, @samp{\"~a/24\"} for a 24-bit network mask.") (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 @@ to 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 @@ to 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 @@ to CONFIG." #: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 @@ to CONFIG." #: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) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index a192c7e655..52f818af48 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -39,6 +39,7 @@ #: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 @@ (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. |