mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-05-28 03:51:53 +02:00
services: static-networking: Change interface to mimic netlink.
* gnu/services/base.scm (<static-networking>)[interface, ip, netmask] [gateway]: Remove. [addresses, links, routes]: New fields. [requirement]: Default to '(udev). (<network-address>, <network-link>, <network-route>): 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.
This commit is contained in:
+165
-25
@@ -16852,32 +16852,165 @@ This section describes the various network setup services available,
|
|||||||
starting with static network configuration.
|
starting with static network configuration.
|
||||||
|
|
||||||
@defvr {Scheme Variable} static-networking-service-type
|
@defvr {Scheme Variable} static-networking-service-type
|
||||||
This is the type for statically-configured network interfaces.
|
This is the type for statically-configured network interfaces. Its
|
||||||
@c TODO Document <static-networking> data structures.
|
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
|
@end defvr
|
||||||
|
|
||||||
@deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @
|
@deftp {Data Type} static-networking
|
||||||
[#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}] @
|
This is the data type representing a static network configuration.
|
||||||
[#: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.
|
|
||||||
|
|
||||||
This procedure can be called several times, one for each network
|
As an example, here is how you would declare the configuration of a
|
||||||
interface of interest. Behind the scenes what it does is extend
|
machine with a single network interface controller (NIC) available as
|
||||||
@code{static-networking-service-type} with additional network interfaces
|
@code{eno1}, and with one IPv4 and one IPv6 address:
|
||||||
to handle.
|
|
||||||
|
|
||||||
For example:
|
|
||||||
|
|
||||||
@lisp
|
@lisp
|
||||||
(static-networking-service "eno1" "192.168.1.82"
|
;; Network configuration for one NIC, IPv4 + IPv6.
|
||||||
#:gateway "192.168.1.2"
|
(static-networking
|
||||||
#:name-servers '("192.168.1.2"))
|
(addresses (list (network-address
|
||||||
|
(device "eno1")
|
||||||
|
(value "10.0.2.15/24"))
|
||||||
|
(network-address
|
||||||
|
(device "eno1")
|
||||||
|
(value "2001:123:4567:101::1/64"))))
|
||||||
|
(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 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/64 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{routes} (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{'(networking)})
|
||||||
|
If true, this should be a list of symbols for the Shepherd service
|
||||||
|
corresponding to this network configuration.
|
||||||
|
|
||||||
|
@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
|
@cindex DHCP, networking service
|
||||||
@defvr {Scheme Variable} dhcp-client-service-type
|
@defvr {Scheme Variable} dhcp-client-service-type
|
||||||
@@ -30442,11 +30575,18 @@ cluster node that supports multiple storage backends, and installs the
|
|||||||
"ganeti-instance-guix" "ganeti-instance-debootstrap"))
|
"ganeti-instance-guix" "ganeti-instance-debootstrap"))
|
||||||
%base-packages))
|
%base-packages))
|
||||||
(services
|
(services
|
||||||
(append (list (static-networking-service "eth0" "192.168.1.201"
|
(append (list (service static-networking-service-type
|
||||||
#:netmask "255.255.255.0"
|
(list (static-networking
|
||||||
#:gateway "192.168.1.254"
|
(addresses
|
||||||
#:name-servers '("192.168.1.252"
|
(list (network-address
|
||||||
"192.168.1.253"))
|
(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.
|
;; Ganeti uses SSH to communicate between nodes.
|
||||||
(service openssh-service-type
|
(service openssh-service-type
|
||||||
|
|||||||
@@ -185,13 +185,9 @@ set."
|
|||||||
("servers/crash-suspend" ("/hurd/crash" "--suspend"))
|
("servers/crash-suspend" ("/hurd/crash" "--suspend"))
|
||||||
("servers/password" ("/hurd/password"))
|
("servers/password" ("/hurd/password"))
|
||||||
("servers/socket/1" ("/hurd/pflocal"))
|
("servers/socket/1" ("/hurd/pflocal"))
|
||||||
("servers/socket/2" ("/hurd/pfinet"
|
;; /servers/socket/2 and /26 are created by 'static-networking-service'.
|
||||||
"--interface" "eth0"
|
;; XXX: Spawn pfinet without arguments on these nodes so that a DHCP
|
||||||
"--address"
|
;; client has someone to talk to?
|
||||||
"10.0.2.15" ;the default QEMU guest IP
|
|
||||||
"--netmask" "255.255.255.0"
|
|
||||||
"--gateway" "10.0.2.2"
|
|
||||||
"--ipv6" "/servers/socket/26"))
|
|
||||||
("proc" ("/hurd/procfs" "--stat-mode=444"))))
|
("proc" ("/hurd/procfs" "--stat-mode=444"))))
|
||||||
|
|
||||||
(define devices
|
(define devices
|
||||||
|
|||||||
+296
-129
@@ -35,6 +35,8 @@
|
|||||||
(define-module (gnu services base)
|
(define-module (gnu services base)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix deprecation)
|
#:use-module (guix deprecation)
|
||||||
|
#:autoload (guix diagnostics) (warning)
|
||||||
|
#:autoload (guix i18n) (G_)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services admin)
|
#:use-module (gnu services admin)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
@@ -54,6 +56,7 @@
|
|||||||
#:use-module ((gnu packages base)
|
#:use-module ((gnu packages base)
|
||||||
#:select (coreutils glibc glibc-utf8-locales))
|
#:select (coreutils glibc glibc-utf8-locales))
|
||||||
#:autoload (gnu packages guile-xyz) (guile-netlink)
|
#:autoload (gnu packages guile-xyz) (guile-netlink)
|
||||||
|
#:autoload (gnu packages hurd) (hurd)
|
||||||
#:use-module (gnu packages package-management)
|
#:use-module (gnu packages package-management)
|
||||||
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
|
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
|
||||||
#:use-module (gnu packages linux)
|
#:use-module (gnu packages linux)
|
||||||
@@ -84,14 +87,32 @@
|
|||||||
virtual-terminal-service-type
|
virtual-terminal-service-type
|
||||||
|
|
||||||
static-networking
|
static-networking
|
||||||
|
|
||||||
static-networking?
|
static-networking?
|
||||||
static-networking-interface
|
static-networking-addresses
|
||||||
static-networking-ip
|
static-networking-links
|
||||||
static-networking-netmask
|
static-networking-routes
|
||||||
static-networking-gateway
|
|
||||||
static-networking-requirement
|
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
|
||||||
static-networking-service-type
|
static-networking-service-type
|
||||||
|
|
||||||
@@ -2355,113 +2376,267 @@ notably to select, copy, and paste text. The default options use the
|
|||||||
(description "Start the @command{kmscon} virtual terminal emulator for the
|
(description "Start the @command{kmscon} virtual terminal emulator for the
|
||||||
Linux @dfn{kernel mode setting} (KMS).")))
|
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>
|
(define-record-type* <static-networking>
|
||||||
static-networking make-static-networking
|
static-networking make-static-networking
|
||||||
static-networking?
|
static-networking?
|
||||||
(interface static-networking-interface)
|
(addresses static-networking-addresses) ;list of <network-address>
|
||||||
(ip static-networking-ip)
|
(links static-networking-links (default '())) ;list of <network-link>
|
||||||
(netmask static-networking-netmask
|
(routes static-networking-routes (default '())) ;list of <network-routes>
|
||||||
(default #f))
|
|
||||||
(gateway static-networking-gateway ;FIXME: doesn't belong here
|
|
||||||
(default #f))
|
|
||||||
(provision static-networking-provision
|
(provision static-networking-provision
|
||||||
(default #f))
|
(default '(networking)))
|
||||||
(requirement static-networking-requirement
|
(requirement static-networking-requirement
|
||||||
(default '()))
|
(default '(udev)))
|
||||||
(name-servers static-networking-name-servers ;FIXME: doesn't belong here
|
(name-servers static-networking-name-servers ;FIXME: doesn't belong here
|
||||||
(default '())))
|
(default '())))
|
||||||
|
|
||||||
(define static-networking-shepherd-service
|
(define-record-type* <network-address>
|
||||||
|
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>
|
||||||
|
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>
|
||||||
|
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
|
||||||
|
(($ <network-route> "default" #f device _ gateway)
|
||||||
|
(if (network-route-ipv6? route)
|
||||||
|
`("--gateway6" ,gateway)
|
||||||
|
`("--gateway" ,gateway)))
|
||||||
|
(($ <network-route> 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
|
(match-lambda
|
||||||
(($ <static-networking> interface ip netmask gateway provision
|
(($ <static-networking> addresses links routes)
|
||||||
requirement name-servers)
|
(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
|
||||||
|
(($ <network-link> name type arguments)
|
||||||
|
#~(link-add #$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
|
||||||
|
(($ <static-networking> addresses links routes)
|
||||||
|
(scheme-file "tear-down-network"
|
||||||
|
(with-extensions (list guile-netlink)
|
||||||
|
#~(begin
|
||||||
|
(use-modules (ip addr) (ip link) (ip route)
|
||||||
|
(netlink error)
|
||||||
|
(srfi srfi-34))
|
||||||
|
|
||||||
|
(define-syntax-rule (false-if-netlink-error exp)
|
||||||
|
(guard (c ((netlink-error? c) #f))
|
||||||
|
exp))
|
||||||
|
|
||||||
|
;; Wrap calls in 'false-if-netlink-error' so this
|
||||||
|
;; script goes as far as possible undoing the effects
|
||||||
|
;; of "set-up-network".
|
||||||
|
|
||||||
|
#$@(map (lambda (route)
|
||||||
|
#~(false-if-netlink-error
|
||||||
|
(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
|
||||||
|
(($ <network-link> name type arguments)
|
||||||
|
#~(false-if-netlink-error
|
||||||
|
(link-del #$name))))
|
||||||
|
links)
|
||||||
|
#$@(map (lambda (address)
|
||||||
|
#~(false-if-netlink-error
|
||||||
|
(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
|
||||||
|
(($ <static-networking> addresses links routes
|
||||||
|
provision requirement name-servers)
|
||||||
(let ((loopback? (and provision (memq 'loopback provision))))
|
(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
|
(shepherd-service
|
||||||
|
|
||||||
(documentation
|
(documentation
|
||||||
"Bring up the networking interface using a static IP address.")
|
"Bring up the networking interface using a static IP address.")
|
||||||
(requirement requirement)
|
(requirement requirement)
|
||||||
(provision (or provision
|
(provision provision)
|
||||||
(list (symbol-append 'networking-
|
|
||||||
(string->symbol interface)))))
|
|
||||||
|
|
||||||
(start #~(lambda _
|
(start #~(lambda _
|
||||||
;; Return #t if successfully started.
|
;; Return #t if successfully started.
|
||||||
#$helpers
|
(load #$(let-system (system target)
|
||||||
(if (string-contains %host-type "-linux")
|
(if (string-contains (or target system) "-linux")
|
||||||
#$set-up-via-netlink
|
(network-set-up/linux config)
|
||||||
#$set-up-via-ioctl)))
|
(network-set-up/hurd config))))))
|
||||||
(stop #~(lambda _
|
(stop #~(lambda _
|
||||||
;; Return #f is successfully stopped.
|
;; Return #f is successfully stopped.
|
||||||
(if (string-contains %host-type "-linux")
|
(load #$(let-system (system target)
|
||||||
#$tear-down-via-netlink
|
(if (string-contains (or target system) "-linux")
|
||||||
#$tear-down-via-ioctl)))
|
(network-tear-down/linux config)
|
||||||
(modules `((ip addr)
|
(network-tear-down/hurd config))))))
|
||||||
(ip link)
|
|
||||||
(ip route)
|
|
||||||
,@%default-modules))
|
|
||||||
(respawn? #f))))))
|
(respawn? #f))))))
|
||||||
|
|
||||||
|
(define (static-networking-shepherd-services networks)
|
||||||
|
(map static-networking-shepherd-service networks))
|
||||||
|
|
||||||
(define (static-networking-etc-files interfaces)
|
(define (static-networking-etc-files interfaces)
|
||||||
"Return a /etc/resolv.conf entry for INTERFACES or the empty list."
|
"Return a /etc/resolv.conf entry for INTERFACES or the empty list."
|
||||||
(match (delete-duplicates
|
(match (delete-duplicates
|
||||||
@@ -2480,30 +2655,6 @@ Linux @dfn{kernel mode setting} (KMS).")))
|
|||||||
# Generated by 'static-networking-service'.\n"
|
# Generated by 'static-networking-service'.\n"
|
||||||
content))))))))
|
content))))))))
|
||||||
|
|
||||||
(define (static-networking-shepherd-services interfaces)
|
|
||||||
"Return the list of Shepherd services to bring up INTERFACES, a list of
|
|
||||||
<static-networking> 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
|
(define static-networking-service-type
|
||||||
;; The service type for statically-defined network interfaces.
|
;; The service type for statically-defined network interfaces.
|
||||||
(service-type (name 'static-networking)
|
(service-type (name 'static-networking)
|
||||||
@@ -2521,12 +2672,13 @@ with the given IP address, gateway, netmask, and so on. The value for
|
|||||||
services of this type is a list of @code{static-networking} objects, one per
|
services of this type is a list of @code{static-networking} objects, one per
|
||||||
network interface.")))
|
network interface.")))
|
||||||
|
|
||||||
(define* (static-networking-service interface ip
|
(define-deprecated (static-networking-service interface ip
|
||||||
#:key
|
#:key
|
||||||
netmask gateway provision
|
netmask gateway provision
|
||||||
;; Most interfaces require udev to be usable.
|
;; Most interfaces require udev to be usable.
|
||||||
(requirement '(udev))
|
(requirement '(udev))
|
||||||
(name-servers '()))
|
(name-servers '()))
|
||||||
|
static-networking-service-type
|
||||||
"Return a service that starts @var{interface} with address @var{ip}. If
|
"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,
|
@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.
|
it must be a string specifying the default network gateway.
|
||||||
@@ -2537,11 +2689,24 @@ interface of interest. Behind the scenes what it does is extend
|
|||||||
to handle."
|
to handle."
|
||||||
(simple-service 'static-network-interface
|
(simple-service 'static-network-interface
|
||||||
static-networking-service-type
|
static-networking-service-type
|
||||||
(list (static-networking (interface interface) (ip ip)
|
(list (static-networking
|
||||||
(netmask netmask) (gateway gateway)
|
(addresses
|
||||||
(provision provision)
|
(list (network-address
|
||||||
(requirement requirement)
|
(device interface)
|
||||||
(name-servers name-servers)))))
|
(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 (or provision '(networking)))
|
||||||
|
(name-servers name-servers)))))
|
||||||
|
|
||||||
|
|
||||||
(define %base-services
|
(define %base-services
|
||||||
@@ -2573,10 +2738,12 @@ to handle."
|
|||||||
(tty "tty6")))
|
(tty "tty6")))
|
||||||
|
|
||||||
(service static-networking-service-type
|
(service static-networking-service-type
|
||||||
(list (static-networking (interface "lo")
|
(list (static-networking
|
||||||
(ip "127.0.0.1")
|
(addresses (list (network-address
|
||||||
(requirement '())
|
(device "lo")
|
||||||
(provision '(loopback)))))
|
(value "127.0.0.1"))))
|
||||||
|
(requirement '())
|
||||||
|
(provision '(loopback)))))
|
||||||
(syslog-service)
|
(syslog-service)
|
||||||
(service urandom-seed-service-type)
|
(service urandom-seed-service-type)
|
||||||
(service guix-service-type)
|
(service guix-service-type)
|
||||||
|
|||||||
+22
-5
@@ -79,11 +79,28 @@
|
|||||||
(service hurd-getty-service-type (hurd-getty-configuration
|
(service hurd-getty-service-type (hurd-getty-configuration
|
||||||
(tty "tty2")))
|
(tty "tty2")))
|
||||||
(service static-networking-service-type
|
(service static-networking-service-type
|
||||||
(list (static-networking (interface "lo")
|
(list (static-networking
|
||||||
(ip "127.0.0.1")
|
(addresses
|
||||||
(requirement '())
|
(list (network-address
|
||||||
(provision '(loopback networking))
|
(device "lo")
|
||||||
(name-servers '("10.0.2.3")))))
|
(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)
|
(syslog-service)
|
||||||
(service guix-service-type
|
(service guix-service-type
|
||||||
(guix-configuration
|
(guix-configuration
|
||||||
|
|||||||
@@ -408,10 +408,13 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
|
|||||||
|
|
||||||
;; Loopback device, needed by OpenSSH notably.
|
;; Loopback device, needed by OpenSSH notably.
|
||||||
(service static-networking-service-type
|
(service static-networking-service-type
|
||||||
(list (static-networking (interface "lo")
|
(list (static-networking
|
||||||
(ip "127.0.0.1")
|
(addresses
|
||||||
(requirement '())
|
(list (network-address
|
||||||
(provision '(loopback)))))
|
(device "lo")
|
||||||
|
(value "127.0.0.1"))))
|
||||||
|
(requirement '())
|
||||||
|
(provision '(loopback)))))
|
||||||
|
|
||||||
(service wpa-supplicant-service-type)
|
(service wpa-supplicant-service-type)
|
||||||
(dbus-service)
|
(dbus-service)
|
||||||
|
|||||||
@@ -337,7 +337,7 @@ port 7, and a dict service on port 2628."
|
|||||||
(srfi srfi-1))
|
(srfi srfi-1))
|
||||||
(live-service-running
|
(live-service-running
|
||||||
(find (lambda (live)
|
(find (lambda (live)
|
||||||
(memq 'networking-ovs0
|
(memq 'networking
|
||||||
(live-service-provision live)))
|
(live-service-provision live)))
|
||||||
(current-services))))
|
(current-services))))
|
||||||
marionette))
|
marionette))
|
||||||
|
|||||||
Reference in New Issue
Block a user