From patchwork Wed Oct 27 14:02:42 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 34112 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 6ECCF27BBE3; Wed, 27 Oct 2021 16:06:54 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 2126B27BBE1 for ; Wed, 27 Oct 2021 16:06:53 +0100 (BST) Received: from localhost ([::1]:59044 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mfkVw-00075H-6N for patchwork@mira.cbaines.net; Wed, 27 Oct 2021 11:06:52 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43154) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mfjXA-0008OY-SJ for guix-patches@gnu.org; Wed, 27 Oct 2021 10:04:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:38546) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mfjXA-0005GW-G8 for guix-patches@gnu.org; Wed, 27 Oct 2021 10:04:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mfjXA-0002ZV-C5 for guix-patches@gnu.org; Wed, 27 Oct 2021 10:04:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#51440] [PATCH 07/10] services: static-networking: Change interface to mimic netlink. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 27 Oct 2021 14:04:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51440 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 51440@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 51440-submit@debbugs.gnu.org id=B51440.16353434009748 (code B ref 51440); Wed, 27 Oct 2021 14:04:04 +0000 Received: (at 51440) by debbugs.gnu.org; 27 Oct 2021 14:03:20 +0000 Received: from localhost ([127.0.0.1]:50080 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mfjWQ-0002X3-UZ for submit@debbugs.gnu.org; Wed, 27 Oct 2021 10:03:20 -0400 Received: from eggs.gnu.org ([209.51.188.92]:45568) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mfjWK-0002Vj-34 for 51440@debbugs.gnu.org; Wed, 27 Oct 2021 10:03:13 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:37976) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mfjWE-00058J-Rx; Wed, 27 Oct 2021 10:03:06 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=zbIt4xF0kkuo3g5h7cxqz7CjdZNPt6hwu/7MdVLEsWY=; b=GMHfI21bkW5aDEpB1UaA Jq1p+bb2jTbipwtkmfJU7Mo4G1OfVZK3BlbrKokVePHVIRaNlZ1/3SUAF+MHLBAoX8FbPBsKilgwM 1tbE0PCPSckSjibP6d1ztPMmH/ifnwWk+UxEIDgX/9YsRJkKDAuIJPboPPduCPHcICcbADZ0eKHs7 efbZ/M6LdBPZG8O35IKWt6ZusSnBwhDLmXJAUYWDyx+G771VowF3BDXaeeHMI+0ot1qgEYSvILNJR lznSRj6XFmC1JfM9YSZaLCEZkRLLCZUeDxp6ZJA9JxBfare/T9A4Hqu+iCp9du6xoWWP6dry87Mv1 coqatHBjy72AHw==; Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55004 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mfjWE-0002Tf-B0; Wed, 27 Oct 2021 10:03:06 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 27 Oct 2021 16:02:42 +0200 Message-Id: <20211027140245.18970-7-ludo@gnu.org> X-Mailer: git-send-email 2.33.0 In-Reply-To: <20211027140245.18970-1-ludo@gnu.org> References: <20211027140245.18970-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/services/base.scm ()[interface, ip, netmask] [gateway]: Remove. [addresses, links, routes]: New fields. [requirement]: Default to '(udev). (, , ): New record types. (ensure-no-separate-netmask, %ensure-no-separate-netmask): Remove. (ipv6-address?, cidr->netmask, ip+netmask->cidr) (network-set-up/hurd, network-tear-down/hurd) (network-set-up/linux, network-tear-down/linux) (static-networking->hurd-pfinet-options): New procedures. (static-networking-shepherd-service): New procedure. (static-networking-shepherd-services): Rewrite in terms of the above. (static-networking-service): Deprecate. Adjust to new 'static-networking' API. (%base-services): Likewise. * gnu/system/install.scm (%installation-services): Likewise. * gnu/system/hurd.scm (%base-services/hurd): Likewise, and separate 'loopback' from 'networking'. * gnu/build/hurd-boot.scm (set-hurd-device-translators): Remove "servers/socket/2". * gnu/tests/networking.scm (run-openvswitch-test)["networking has started on ovs0"]: Check for 'networking instead of 'networking-ovs0, which is no longer provided. * doc/guix.texi (Networking Setup): Document the new interface. Remove documentation of 'static-networking-service'. (Virtualization Services): Change Ganeti example to use the new interface. --- doc/guix.texi | 191 +++++++++++++++--- gnu/build/hurd-boot.scm | 10 +- gnu/services/base.scm | 410 +++++++++++++++++++++++++++------------ gnu/system/hurd.scm | 27 ++- gnu/system/install.scm | 11 +- gnu/tests/networking.scm | 2 +- 6 files changed, 481 insertions(+), 170 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index f7de378bdd..b529a8db6c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16762,32 +16762,166 @@ This section describes the various network setup services available, starting with static network configuration. @defvr {Scheme Variable} static-networking-service-type -This is the type for statically-configured network interfaces. -@c TODO Document data structures. +This is the type for statically-configured network interfaces. Its +value must be a list of @code{static-networking} records. Each of them +declares a set of @dfn{addresses}, @dfn{routes}, and @dfn{links}, as +show below. + +@cindex network interface controller (NIC) +@cindex NIC, networking interface controller +Here is the simplest configuration, with only one network interface +controller (NIC) and only IPv4 connectivity: + +@example +;; Static networking for one NIC, IPv4-only. +(service static-networking-service-type + (list (static-networking + (addresses + (list (network-address + (device "eno1") + (value "10.0.2.15/24")))) + (routes + (list (network-route + (destination "default") + (gateway "10.0.2.2")))) + (name-servers '("10.0.2.3"))))) +@end example + +The snippet above can be added to the @code{services} field of your +operating system configuration (@pxref{Using the Configuration System}). +It will configure your machine to have 10.0.2.15 as its IP address, with +a 24-bit netmask for the local network---meaning that any 10.0.2.@var{x} +address is on the local area network (LAN). Traffic to addresses +outside the local network is routed @i{via} 10.0.2.2. Host names are +resolved by sending domain name system (DNS) queries to 10.0.2.3. @end defvr -@deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @ - [#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}] @ - [#:requirement @code{'(udev)}] -Return a service that starts @var{interface} with address @var{ip}. If -@var{netmask} is true, use it as the network mask. If @var{gateway} is true, -it must be a string specifying the default network gateway. @var{requirement} -can be used to declare a dependency on another service before configuring the -interface. +@deftp {Data Type} static-networking +This is the data type representing a static network configuration. -This procedure can be called several times, one for each network -interface of interest. Behind the scenes what it does is extend -@code{static-networking-service-type} with additional network interfaces -to handle. - -For example: +As an example, here is how you would declare the configuration of a +machine with a single network interface controller (NIC) available as +@code{eno1}, and with one IPv4 and one IPv6 address: @lisp -(static-networking-service "eno1" "192.168.1.82" - #:gateway "192.168.1.2" - #:name-servers '("192.168.1.2")) +;; Network configuration for one NIC, IPv4 + IPv6. +(static-networking + (addresses (list (network-address + (device "eno1") + (value "10.0.2.15/24")) + (network-address + (device "eno1") + (value "2001:123:4567:101::1")))) + (routes (list (network-route + (destination "default") + (gateway "10.0.2.2")) + (network-route + (destination "default") + (gateway "2020:321:4567:42::1")))) + (name-servers '("10.0.2.3"))) @end lisp -@end deffn + +If you are familiar with the @command{ip} command of the +@uref{https://wiki.linuxfoundation.org/networking/iproute2, +@code{iproute2} package} found on Linux-based systems, the declaration +above is equivalent to typing: + +@example +ip address add 10.0.2.15/24 dev eno1 +ip address add 2001:123:4567:101::1 dev eno1 +ip route add default via inet 10.0.2.2 +ip route add default via inet6 2020:321:4567:42::1 +@end example + +Run @command{man 8 ip} for more info. Venerable GNU/Linux users will +certainly know how to do it with @command{ifconfig} and @command{route}, +but we'll spare you that. + +The available fields of this data type are as follows: + +@table @asis +@item @code{addresses} +@itemx @code{links} (default: @code{'()}) +@itemx @code{links} (default: @code{'()}) +The list of @code{network-address}, @code{network-link}, and +@code{network-route} records for this network (see below). + +@item @code{name-servers} (default: @code{'()}) +The list of IP addresses (strings) of domain name servers. These IP +addresses go to @file{/etc/resolv.conf}. + +@item @code{provision} (default: @code{#f}) +If true, this should be a list of symbols for the Shepherd service +corresponding to this network configuration. When @code{#f}, +@code{'(networking)} or @code{'(loopback)} is used. + +@item @code{requirement} (default @code{'()}) +The list of Shepherd services depended on. +@end table +@end deftp + +@deftp {Data Type} network-address +This is the data type representing the IP address of a network +interface. + +@table @code +@item device +The name of the network interface for this address---e.g., +@code{"eno1"}. + +@item value +The actual IP address and network mask, in +@uref{https://en.wikipedia.org/wiki/CIDR#CIDR_notation, @acronym{CIDR, +Classless Inter-Domain Routing} notation}, as a string. + +For example, @code{"10.0.2.15/24"} denotes IPv4 address 10.0.2.15 on a +24-bit sub-network---all 10.0.2.@var{x} addresses are on the same local +network. + +@item ipv6? +Whether @code{value} denotes an IPv6 address. By default this is +automatically determined. +@end table +@end deftp + +@deftp {Data Type} network-route +This is the data type representing a network route. + +@table @asis +@item @code{destination} +The route destination (a string), either an IP address or +@code{"default"} to denote the default route. + +@item @code{source} (default: @code{#f}) +The route source. + +@item @code{device} (default: @code{#f}) +The device used for this route---e.g., @code{"eno2"}. + +@item @code{ipv6?} (default: auto) +Whether this is an IPv6 route. By default this is automatically +determined based on @code{destination} or @code{gateway}. + +@item @code{gateway} (default: @code{#f}) +IP address (a string) through which traffic is routed. +@end table +@end deftp + +@deftp {Data Type} network-link +Data type for a network link (@pxref{Link,,, guile-netlink, +Guile-Netlink Manual}). + +@table @code +@item name +The name of the link---e.g., @code{"v0p0"}. + +@item type +A symbol denoting the type of the link---e.g., @code{'veth}. + +@item arguments +List of arguments for this type of link. +@end table +@end deftp @cindex DHCP, networking service @defvr {Scheme Variable} dhcp-client-service-type @@ -30300,11 +30434,18 @@ cluster node that supports multiple storage backends, and installs the "ganeti-instance-guix" "ganeti-instance-debootstrap")) %base-packages)) (services - (append (list (static-networking-service "eth0" "192.168.1.201" - #:netmask "255.255.255.0" - #:gateway "192.168.1.254" - #:name-servers '("192.168.1.252" - "192.168.1.253")) + (append (list (service static-networking-service-type + (list (static-networking + (addresses + (list (network-address + (device "eth0") + (value "192.168.1.201/24")))) + (routes + (list (network-route + (destination "default") + (gateway "192.168.1.254")))) + (name-servers '("192.168.1.252" + "192.168.1.253"))))) ;; Ganeti uses SSH to communicate between nodes. (service openssh-service-type diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index 8b27995438..ac36bd17d4 100644 --- a/gnu/build/hurd-boot.scm +++ b/gnu/build/hurd-boot.scm @@ -185,13 +185,9 @@ (define servers ("servers/crash-suspend" ("/hurd/crash" "--suspend")) ("servers/password" ("/hurd/password")) ("servers/socket/1" ("/hurd/pflocal")) - ("servers/socket/2" ("/hurd/pfinet" - "--interface" "eth0" - "--address" - "10.0.2.15" ;the default QEMU guest IP - "--netmask" "255.255.255.0" - "--gateway" "10.0.2.2" - "--ipv6" "/servers/socket/26")) + ;; /servers/socket/2 and /26 are created by 'static-networking-service'. + ;; XXX: Spawn pfinet without arguments on these nodes so that a DHCP + ;; client has someone to talk to? ("proc" ("/hurd/procfs" "--stat-mode=444")))) (define devices diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d5ee03bbbd..03f6b388a8 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -35,6 +35,8 @@ (define-module (gnu services base) #:use-module (guix store) #:use-module (guix deprecation) + #:autoload (guix diagnostics) (warning) + #:autoload (guix i18n) (G_) #:use-module (gnu services) #:use-module (gnu services admin) #:use-module (gnu services shepherd) @@ -54,6 +56,7 @@ (define-module (gnu services base) #:use-module ((gnu packages base) #:select (coreutils glibc glibc-utf8-locales)) #:autoload (gnu packages guile-xyz) (guile-netlink) + #:autoload (gnu packages hurd) (hurd) #:use-module (gnu packages package-management) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module (gnu packages linux) @@ -81,14 +84,32 @@ (define-module (gnu services base) virtual-terminal-service-type static-networking - static-networking? - static-networking-interface - static-networking-ip - static-networking-netmask - static-networking-gateway + static-networking-addresses + static-networking-links + static-networking-routes static-networking-requirement + network-address + network-address? + network-address-device + network-address-value + network-address-ipv6? + + network-link + network-link? + network-link-name + network-link-type + network-link-arguments + + network-route + network-route? + network-route-destination + network-route-source + network-route-device + network-route-ipv6? + network-route-gateway + static-networking-service static-networking-service-type @@ -2316,113 +2337,254 @@ (define kmscon-command (description "Start the @command{kmscon} virtual terminal emulator for the Linux @dfn{kernel mode setting} (KMS)."))) + +;;; +;;; Static networking. +;;; + +(define (ipv6-address? str) + "Return true if STR denotes an IPv6 address." + (false-if-exception (->bool (inet-pton AF_INET6 str)))) + (define-record-type* static-networking make-static-networking static-networking? - (interface static-networking-interface) - (ip static-networking-ip) - (netmask static-networking-netmask - (default #f)) - (gateway static-networking-gateway ;FIXME: doesn't belong here - (default #f)) + (addresses static-networking-addresses) ;list of + (links static-networking-links (default '())) ;list of + (routes static-networking-routes (default '())) ;list of (provision static-networking-provision (default #f)) (requirement static-networking-requirement - (default '())) + (default '(udev))) (name-servers static-networking-name-servers ;FIXME: doesn't belong here (default '()))) -(define static-networking-shepherd-service +(define-record-type* + network-address make-network-address + network-address? + (device network-address-device) ;string--e.g., "en01" + (value network-address-value) ;string--CIDR notation + (ipv6? network-address-ipv6? ;Boolean + (thunked) + (default + (ipv6-address? (cidr->ip (network-address-value this-record)))))) + +(define-record-type* + network-link make-network-link + network-link? + (name network-link-name) ;string--e.g, "v0p0" + (type network-link-type) ;symbol--e.g.,'veth + (arguments network-link-arguments)) ;list + +(define-record-type* + network-route make-network-route + network-route? + (destination network-route-destination) + (source network-route-source (default #f)) + (device network-route-device (default #f)) + (ipv6? network-route-ipv6? (thunked) + (default + (or (ipv6-address? (network-route-destination this-record)) + (and=> (network-route-gateway this-record) + ipv6-address?)))) + (gateway network-route-gateway (default #f))) + +(define* (cidr->netmask str #:optional (family AF_INET)) + "Given @var{str}, a string in CIDR notation (e.g., \"1.2.3.4/24\"), return +the netmask as a string like \"255.255.255.0\"." + (match (string-split str #\/) + ((ip (= string->number bits)) + (let ((mask (ash (- (expt 2 bits) 1) + (- (if (= family AF_INET6) 128 32) + bits)))) + (inet-ntop family mask))) + (_ #f))) + +(define (cidr->ip str) + "Strip the netmask bit of @var{str}, a CIDR-notation IP/netmask address." + (match (string-split str #\/) + ((or (ip _) (ip)) + ip))) + +(define* (ip+netmask->cidr ip netmask #:optional (family AF_INET)) + "Return the CIDR notation (a string) for @var{ip} and @var{netmask}, two +@var{family} address strings, where @var{family} is @code{AF_INET} or +@code{AF_INET6}." + (let* ((netmask (inet-pton family netmask)) + (bits (logcount netmask))) + (string-append ip "/" (number->string bits)))) + +(define (static-networking->hurd-pfinet-options config) + "Return command-line options for the Hurd's pfinet translator corresponding +to CONFIG." + (unless (null? (static-networking-links config)) + ;; XXX: Presumably this is not supported, or perhaps could be approximated + ;; by running separate pfinet instances in some cases? + (warning (G_ "network links are currently ignored on GNU/Hurd~%"))) + + (match (static-networking-addresses config) + ((and addresses (first _ ...)) + `("--ipv6" "/servers/socket/26" + "--interface" ,(network-address-device first) + ,@(append-map (lambda (address) + `(,(if (network-address-ipv6? address) + "--address6" + "--address") + ,(cidr->ip (network-address-value address)) + ,@(match (cidr->netmask (network-address-value address) + (if (network-address-ipv6? address) + AF_INET6 + AF_INET)) + (#f '()) + (mask (list "--netmask" mask))))) + addresses) + ,@(append-map (lambda (route) + (match route + (($ "default" #f device _ gateway) + (if (network-route-ipv6? route) + `("--gateway6" ,gateway) + `("--gateway" ,gateway))) + (($ destination) + (warning (G_ "ignoring network route for '~a'~%") + destination) + '()))) + (static-networking-routes config)))))) + +(define (network-set-up/hurd config) + "Set up networking for the Hurd." + ;; The Hurd implements SIOCGIFADDR and other old-style ioctls, but the only + ;; way to set up IPv6 is by starting pfinet with the right options. + (if (equal? (static-networking-provision config) '(loopback)) + (scheme-file "set-up-pflocal" #~(begin 'nothing-to-do! #t)) + (scheme-file "set-up-pfinet" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 format)) + + ;; TODO: Do that without forking. + (let ((options '#$(static-networking->hurd-pfinet-options + config))) + (format #t "starting '~a~{ ~s~}'~%" + #$(file-append hurd "/hurd/pfinet") + options) + (apply invoke #$(file-append hurd "/bin/settrans") "-fac" + "/servers/socket/2" + #$(file-append hurd "/hurd/pfinet") + options))))))) + +(define (network-tear-down/hurd config) + (scheme-file "tear-down-pfinet" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + ;; Forcefully terminate pfinet. XXX: In theory this + ;; should just undo the addresses and routes of CONFIG; + ;; this could be done using ioctls like SIOCDELRT, but + ;; these are IPv4-only; another option would be to use + ;; fsysopts but that seems to crash pfinet. + (invoke #$(file-append hurd "/bin/settrans") "-fg" + "/servers/socket/2") + #f)))) + +(define network-set-up/linux (match-lambda - (($ interface ip netmask gateway provision - requirement name-servers) + (($ addresses links routes) + (scheme-file "set-up-network" + (with-extensions (list guile-netlink) + #~(begin + (use-modules (ip addr) (ip link) (ip route)) + + #$@(map (lambda (address) + #~(begin + (addr-add #$(network-address-device address) + #$(network-address-value address) + #:ipv6? + #$(network-address-ipv6? address)) + ;; FIXME: loopback? + (link-set #$(network-address-device address) + #:up #t))) + addresses) + #$@(map (match-lambda + (($ name type arguments) + #~(link-add #:device #$name #$type + #:type-args '#$arguments))) + links) + #$@(map (lambda (route) + #~(route-add #$(network-route-destination route) + #:device + #$(network-route-device route) + #:ipv6? + #$(network-route-ipv6? route) + #:via + #$(network-route-gateway route) + #:src + #$(network-route-source route))) + routes) + #t)))))) + +(define network-tear-down/linux + (match-lambda + (($ addresses links routes) + (scheme-file "set-up-network" + (with-extensions (list guile-netlink) + #~(begin + (use-modules (ip addr) (ip link) (ip route)) + + #$@(map (lambda (route) + #~(route-del #$(network-route-destination route) + #:device + #$(network-route-device route) + #:ipv6? + #$(network-route-ipv6? route) + #:via + #$(network-route-gateway route) + #:src + #$(network-route-source route))) + routes) + #$@(map (match-lambda + (($ name type arguments) + #~(link-del #$name))) + links) + #$@(map (lambda (address) + #~(addr-del #$(network-address-device + address) + #$(network-address-value address) + #:ipv6? + #$(network-address-ipv6? address))) + addresses) + #f)))))) + +(define (static-networking-shepherd-service config) + (match config + (($ addresses links routes + provision requirement name-servers) (let ((loopback? (and provision (memq 'loopback provision)))) - (define set-up-via-ioctl - #~(let* ((addr (inet-pton AF_INET #$ip)) - (sockaddr (make-socket-address AF_INET addr 0)) - (mask (and #$netmask (inet-pton AF_INET #$netmask))) - (maskaddr (and mask - (make-socket-address AF_INET mask 0))) - (gateway (and #$gateway - (inet-pton AF_INET #$gateway))) - (gatewayaddr (and gateway - (make-socket-address AF_INET - gateway 0)))) - (configure-network-interface #$interface sockaddr - (logior IFF_UP - #$(if loopback? - #~IFF_LOOPBACK - 0)) - #:netmask maskaddr) - (when gateway - (let ((sock (socket AF_INET SOCK_DGRAM 0))) - (add-network-route/gateway sock gatewayaddr) - (close-port sock))))) - - (define tear-down-via-ioctl - #~(let ((sock (socket AF_INET SOCK_STREAM 0))) - (when #$gateway - (delete-network-route sock - (make-socket-address AF_INET - INADDR_ANY 0))) - (set-network-interface-flags sock #$interface 0) - (close-port sock) - #f)) - - (define set-up-via-netlink - (with-extensions (list guile-netlink) - #~(let ((ip #$(if netmask - #~(ip+netmask->cidr #$ip #$netmask) - ip))) - (addr-add #$interface ip) - (when #$gateway - (route-add "default" #:device #$interface - #:via #$gateway)) - (link-set #$interface #:up #t)))) - - (define tear-down-via-netlink - (with-extensions (list guile-netlink) - #~(begin - (link-set #$interface #:down #t) - (when #$gateway - (route-del "default" #:device #$interface)) - (addr-del #$interface #$ip) - #f))) - - (define helpers - #~(define (ip+netmask->cidr ip netmask) - ;; Return the CIDR notation (a string) for IP and NETMASK, two - ;; IPv4 address strings. - (let* ((netmask (inet-pton AF_INET netmask)) - (bits (logcount netmask))) - (string-append ip "/" (number->string bits))))) - (shepherd-service (documentation "Bring up the networking interface using a static IP address.") (requirement requirement) - (provision (or provision - (list (symbol-append 'networking- - (string->symbol interface))))) + (provision (or provision '(networking))) (start #~(lambda _ ;; Return #t if successfully started. - #$helpers - (if (string-contains %host-type "-linux") - #$set-up-via-netlink - #$set-up-via-ioctl))) + (load #$(let-system (system target) + (if (string-contains (or target system) "-linux") + (network-set-up/linux config) + (network-set-up/hurd config)))))) (stop #~(lambda _ ;; Return #f is successfully stopped. - (if (string-contains %host-type "-linux") - #$tear-down-via-netlink - #$tear-down-via-ioctl))) - (modules `((ip addr) - (ip link) - (ip route) - ,@%default-modules)) + #$(let-system (system target) + (if (string-contains (or target system) "-linux") + (network-tear-down/linux config) + (network-tear-down/hurd config))))) (respawn? #f)))))) +(define (static-networking-shepherd-services networks) + (map static-networking-shepherd-service networks)) + (define (static-networking-etc-files interfaces) "Return a /etc/resolv.conf entry for INTERFACES or the empty list." (match (delete-duplicates @@ -2441,30 +2603,6 @@ (define (static-networking-etc-files interfaces) # Generated by 'static-networking-service'.\n" content)))))))) -(define (static-networking-shepherd-services interfaces) - "Return the list of Shepherd services to bring up INTERFACES, a list of - objects." - (define (loopback? service) - (memq 'loopback (shepherd-service-provision service))) - - (let ((services (map static-networking-shepherd-service interfaces))) - (match (remove loopback? services) - (() - ;; There's no interface other than 'loopback', so we assume that the - ;; 'networking' service will be provided by dhclient or similar. - services) - ((non-loopback ...) - ;; Assume we're providing all the interfaces, and thus, provide a - ;; 'networking' service. - (cons (shepherd-service - (provision '(networking)) - (requirement (append-map shepherd-service-provision - services)) - (start #~(const #t)) - (stop #~(const #f)) - (documentation "Bring up all the networking interfaces.")) - services))))) - (define static-networking-service-type ;; The service type for statically-defined network interfaces. (service-type (name 'static-networking) @@ -2482,12 +2620,13 @@ (define static-networking-service-type services of this type is a list of @code{static-networking} objects, one per network interface."))) -(define* (static-networking-service interface ip - #:key - netmask gateway provision - ;; Most interfaces require udev to be usable. - (requirement '(udev)) - (name-servers '())) +(define-deprecated (static-networking-service interface ip + #:key + netmask gateway provision + ;; Most interfaces require udev to be usable. + (requirement '(udev)) + (name-servers '())) + static-networking-service-type "Return a service that starts @var{interface} with address @var{ip}. If @var{netmask} is true, use it as the network mask. If @var{gateway} is true, it must be a string specifying the default network gateway. @@ -2498,11 +2637,24 @@ (define* (static-networking-service interface ip to handle." (simple-service 'static-network-interface static-networking-service-type - (list (static-networking (interface interface) (ip ip) - (netmask netmask) (gateway gateway) - (provision provision) - (requirement requirement) - (name-servers name-servers))))) + (list (static-networking + (addresses + (list (network-address + (device interface) + (value (if netmask + (ip+netmask->cidr ip netmask) + ip)) + (ipv6? #f)))) + (routes + (if gateway + (list (network-route + (destination "default") + (gateway gateway) + (ipv6? #f))) + '())) + (requirement requirement) + (provision provision) + (name-servers name-servers))))) (define %base-services @@ -2534,10 +2686,12 @@ (define %base-services (tty "tty6"))) (service static-networking-service-type - (list (static-networking (interface "lo") - (ip "127.0.0.1") - (requirement '()) - (provision '(loopback))))) + (list (static-networking + (addresses (list (network-address + (device "lo") + (value "127.0.0.1")))) + (requirement '()) + (provision '(loopback))))) (syslog-service) (service urandom-seed-service-type) (service guix-service-type) diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 0794671ce4..0e73ca0d99 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -79,11 +79,28 @@ (define %base-services/hurd (service hurd-getty-service-type (hurd-getty-configuration (tty "tty2"))) (service static-networking-service-type - (list (static-networking (interface "lo") - (ip "127.0.0.1") - (requirement '()) - (provision '(loopback networking)) - (name-servers '("10.0.2.3"))))) + (list (static-networking + (addresses + (list (network-address + (device "lo") + (value "127.0.0.1")))) + (requirement '()) + (provision '(loopback))) + (static-networking + (addresses + ;; The default QEMU guest address. To get "eth0", + ;; you need QEMU to emulate a device for which Mach + ;; has an in-kernel driver, for instance with: + ;; --device rtl8139,netdev=net0 --netdev user,id=net0 + (list (network-address + (device "eth0") + (value "10.0.2.15/24")))) + (routes + (list (network-route + (destination "default") + (gateway "10.0.2.2")))) + (provision '(networking)) + (name-servers '("10.0.2.3"))))) (syslog-service) (service guix-service-type (guix-configuration diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 7b394184ad..bdfe580145 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -408,10 +408,13 @@ (define bare-bones-os ;; Loopback device, needed by OpenSSH notably. (service static-networking-service-type - (list (static-networking (interface "lo") - (ip "127.0.0.1") - (requirement '()) - (provision '(loopback))))) + (list (static-networking + (addresses + (list (network-address + (device "lo") + (value "127.0.0.1")))) + (requirement '()) + (provision '(loopback))))) (service wpa-supplicant-service-type) (dbus-service) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 131428c128..c66af279f2 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -337,7 +337,7 @@ (define marionette (srfi srfi-1)) (live-service-running (find (lambda (live) - (memq 'networking-ovs0 + (memq 'networking (live-service-provision live))) (current-services)))) marionette))