diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-10-17 23:43:52 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-12-12 23:20:49 +0100 |
| commit | 223f1b1eb3707f1d3ef91200dd616ee6c8b77db0 (patch) | |
| tree | 87484966b696d301f8bb99033e2217b3be58e448 | |
| parent | 39e3b4b7cee175a3c1f37329744c582528d55f5d (diff) | |
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.
| -rw-r--r-- | doc/guix.texi | 190 | ||||
| -rw-r--r-- | gnu/build/hurd-boot.scm | 10 | ||||
| -rw-r--r-- | gnu/services/base.scm | 425 | ||||
| -rw-r--r-- | gnu/system/hurd.scm | 27 | ||||
| -rw-r--r-- | gnu/system/install.scm | 11 | ||||
| -rw-r--r-- | gnu/tests/networking.scm | 2 |
6 files changed, 494 insertions, 171 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 1535fb9f93f..73ad818cb6b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi | |||
| @@ -16852,32 +16852,165 @@ This section describes the various network setup services available, | |||
| 16852 | starting with static network configuration. | 16852 | starting with static network configuration. |
| 16853 | 16853 | ||
| 16854 | @defvr {Scheme Variable} static-networking-service-type | 16854 | @defvr {Scheme Variable} static-networking-service-type |
| 16855 | This is the type for statically-configured network interfaces. | 16855 | This is the type for statically-configured network interfaces. Its |
| 16856 | @c TODO Document <static-networking> data structures. | 16856 | value must be a list of @code{static-networking} records. Each of them |
| 16857 | declares a set of @dfn{addresses}, @dfn{routes}, and @dfn{links}, as | ||
| 16858 | show below. | ||
| 16859 | |||
| 16860 | @cindex network interface controller (NIC) | ||
| 16861 | @cindex NIC, networking interface controller | ||
| 16862 | Here is the simplest configuration, with only one network interface | ||
| 16863 | controller (NIC) and only IPv4 connectivity: | ||
| 16864 | |||
| 16865 | @example | ||
| 16866 | ;; Static networking for one NIC, IPv4-only. | ||
| 16867 | (service static-networking-service-type | ||
| 16868 | (list (static-networking | ||
| 16869 | (addresses | ||
| 16870 | (list (network-address | ||
| 16871 | (device "eno1") | ||
| 16872 | (value "10.0.2.15/24")))) | ||
| 16873 | (routes | ||
| 16874 | (list (network-route | ||
| 16875 | (destination "default") | ||
| 16876 | (gateway "10.0.2.2")))) | ||
| 16877 | (name-servers '("10.0.2.3"))))) | ||
| 16878 | @end example | ||
| 16879 | |||
| 16880 | The snippet above can be added to the @code{services} field of your | ||
| 16881 | operating system configuration (@pxref{Using the Configuration System}). | ||
| 16882 | It will configure your machine to have 10.0.2.15 as its IP address, with | ||
| 16883 | a 24-bit netmask for the local network---meaning that any 10.0.2.@var{x} | ||
| 16884 | address is on the local area network (LAN). Traffic to addresses | ||
| 16885 | outside the local network is routed @i{via} 10.0.2.2. Host names are | ||
| 16886 | resolved by sending domain name system (DNS) queries to 10.0.2.3. | ||
| 16857 | @end defvr | 16887 | @end defvr |
| 16858 | 16888 | ||
| 16859 | @deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @ | 16889 | @deftp {Data Type} static-networking |
| 16860 | [#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}] @ | 16890 | This is the data type representing a static network configuration. |
| 16861 | [#:requirement @code{'(udev)}] | ||
| 16862 | Return a service that starts @var{interface} with address @var{ip}. If | ||
| 16863 | @var{netmask} is true, use it as the network mask. If @var{gateway} is true, | ||
| 16864 | it must be a string specifying the default network gateway. @var{requirement} | ||
| 16865 | can be used to declare a dependency on another service before configuring the | ||
| 16866 | interface. | ||
| 16867 | |||
| 16868 | This procedure can be called several times, one for each network | ||
| 16869 | interface of interest. Behind the scenes what it does is extend | ||
| 16870 | @code{static-networking-service-type} with additional network interfaces | ||
| 16871 | to handle. | ||
| 16872 | 16891 | ||
| 16873 | For example: | 16892 | As an example, here is how you would declare the configuration of a |
| 16893 | machine with a single network interface controller (NIC) available as | ||
| 16894 | @code{eno1}, and with one IPv4 and one IPv6 address: | ||
| 16874 | 16895 | ||
| 16875 | @lisp | 16896 | @lisp |
| 16876 | (static-networking-service "eno1" "192.168.1.82" | 16897 | ;; Network configuration for one NIC, IPv4 + IPv6. |
| 16877 | #:gateway "192.168.1.2" | 16898 | (static-networking |
| 16878 | #:name-servers '("192.168.1.2")) | 16899 | (addresses (list (network-address |
| 16900 | (device "eno1") | ||
| 16901 | (value "10.0.2.15/24")) | ||
| 16902 | (network-address | ||
| 16903 | (device "eno1") | ||
| 16904 | (value "2001:123:4567:101::1/64")))) | ||
| 16905 | (routes (list (network-route | ||
| 16906 | (destination "default") | ||
| 16907 | (gateway "10.0.2.2")) | ||
| 16908 | (network-route | ||
| 16909 | (destination "default") | ||
| 16910 | (gateway "2020:321:4567:42::1")))) | ||
| 16911 | (name-servers '("10.0.2.3"))) | ||
| 16879 | @end lisp | 16912 | @end lisp |
| 16880 | @end deffn | 16913 | |
| 16914 | If you are familiar with the @command{ip} command of the | ||
| 16915 | @uref{https://wiki.linuxfoundation.org/networking/iproute2, | ||
| 16916 | @code{iproute2} package} found on Linux-based systems, the declaration | ||
| 16917 | above is equivalent to typing: | ||
| 16918 | |||
| 16919 | @example | ||
| 16920 | ip address add 10.0.2.15/24 dev eno1 | ||
| 16921 | ip address add 2001:123:4567:101::1/64 dev eno1 | ||
| 16922 | ip route add default via inet 10.0.2.2 | ||
| 16923 | ip route add default via inet6 2020:321:4567:42::1 | ||
| 16924 | @end example | ||
| 16925 | |||
| 16926 | Run @command{man 8 ip} for more info. Venerable GNU/Linux users will | ||
| 16927 | certainly know how to do it with @command{ifconfig} and @command{route}, | ||
| 16928 | but we'll spare you that. | ||
| 16929 | |||
| 16930 | The available fields of this data type are as follows: | ||
| 16931 | |||
| 16932 | @table @asis | ||
| 16933 | @item @code{addresses} | ||
| 16934 | @itemx @code{links} (default: @code{'()}) | ||
| 16935 | @itemx @code{routes} (default: @code{'()}) | ||
| 16936 | The list of @code{network-address}, @code{network-link}, and | ||
| 16937 | @code{network-route} records for this network (see below). | ||
| 16938 | |||
| 16939 | @item @code{name-servers} (default: @code{'()}) | ||
| 16940 | The list of IP addresses (strings) of domain name servers. These IP | ||
| 16941 | addresses go to @file{/etc/resolv.conf}. | ||
| 16942 | |||
| 16943 | @item @code{provision} (default: @code{'(networking)}) | ||
| 16944 | If true, this should be a list of symbols for the Shepherd service | ||
| 16945 | corresponding to this network configuration. | ||
| 16946 | |||
| 16947 | @item @code{requirement} (default @code{'()}) | ||
| 16948 | The list of Shepherd services depended on. | ||
| 16949 | @end table | ||
| 16950 | @end deftp | ||
| 16951 | |||
| 16952 | @deftp {Data Type} network-address | ||
| 16953 | This is the data type representing the IP address of a network | ||
| 16954 | interface. | ||
| 16955 | |||
| 16956 | @table @code | ||
| 16957 | @item device | ||
| 16958 | The name of the network interface for this address---e.g., | ||
| 16959 | @code{"eno1"}. | ||
| 16960 | |||
| 16961 | @item value | ||
| 16962 | The actual IP address and network mask, in | ||
| 16963 | @uref{https://en.wikipedia.org/wiki/CIDR#CIDR_notation, @acronym{CIDR, | ||
| 16964 | Classless Inter-Domain Routing} notation}, as a string. | ||
| 16965 | |||
| 16966 | For example, @code{"10.0.2.15/24"} denotes IPv4 address 10.0.2.15 on a | ||
| 16967 | 24-bit sub-network---all 10.0.2.@var{x} addresses are on the same local | ||
| 16968 | network. | ||
| 16969 | |||
| 16970 | @item ipv6? | ||
| 16971 | Whether @code{value} denotes an IPv6 address. By default this is | ||
| 16972 | automatically determined. | ||
| 16973 | @end table | ||
| 16974 | @end deftp | ||
| 16975 | |||
| 16976 | @deftp {Data Type} network-route | ||
| 16977 | This is the data type representing a network route. | ||
| 16978 | |||
| 16979 | @table @asis | ||
| 16980 | @item @code{destination} | ||
| 16981 | The route destination (a string), either an IP address or | ||
| 16982 | @code{"default"} to denote the default route. | ||
| 16983 | |||
| 16984 | @item @code{source} (default: @code{#f}) | ||
| 16985 | The route source. | ||
| 16986 | |||
| 16987 | @item @code{device} (default: @code{#f}) | ||
| 16988 | The device used for this route---e.g., @code{"eno2"}. | ||
| 16989 | |||
| 16990 | @item @code{ipv6?} (default: auto) | ||
| 16991 | Whether this is an IPv6 route. By default this is automatically | ||
| 16992 | determined based on @code{destination} or @code{gateway}. | ||
| 16993 | |||
| 16994 | @item @code{gateway} (default: @code{#f}) | ||
| 16995 | IP address (a string) through which traffic is routed. | ||
| 16996 | @end table | ||
| 16997 | @end deftp | ||
| 16998 | |||
| 16999 | @deftp {Data Type} network-link | ||
| 17000 | Data type for a network link (@pxref{Link,,, guile-netlink, | ||
| 17001 | Guile-Netlink Manual}). | ||
| 17002 | |||
| 17003 | @table @code | ||
| 17004 | @item name | ||
| 17005 | The name of the link---e.g., @code{"v0p0"}. | ||
| 17006 | |||
| 17007 | @item type | ||
| 17008 | A symbol denoting the type of the link---e.g., @code{'veth}. | ||
| 17009 | |||
| 17010 | @item arguments | ||
| 17011 | List of arguments for this type of link. | ||
| 17012 | @end table | ||
| 17013 | @end deftp | ||
| 16881 | 17014 | ||
| 16882 | @cindex DHCP, networking service | 17015 | @cindex DHCP, networking service |
| 16883 | @defvr {Scheme Variable} dhcp-client-service-type | 17016 | @defvr {Scheme Variable} dhcp-client-service-type |
| @@ -30442,11 +30575,18 @@ cluster node that supports multiple storage backends, and installs the | |||
| 30442 | "ganeti-instance-guix" "ganeti-instance-debootstrap")) | 30575 | "ganeti-instance-guix" "ganeti-instance-debootstrap")) |
| 30443 | %base-packages)) | 30576 | %base-packages)) |
| 30444 | (services | 30577 | (services |
| 30445 | (append (list (static-networking-service "eth0" "192.168.1.201" | 30578 | (append (list (service static-networking-service-type |
| 30446 | #:netmask "255.255.255.0" | 30579 | (list (static-networking |
| 30447 | #:gateway "192.168.1.254" | 30580 | (addresses |
| 30448 | #:name-servers '("192.168.1.252" | 30581 | (list (network-address |
| 30449 | "192.168.1.253")) | 30582 | (device "eth0") |
| 30583 | (value "192.168.1.201/24")))) | ||
| 30584 | (routes | ||
| 30585 | (list (network-route | ||
| 30586 | (destination "default") | ||
| 30587 | (gateway "192.168.1.254")))) | ||
| 30588 | (name-servers '("192.168.1.252" | ||
| 30589 | "192.168.1.253"))))) | ||
| 30450 | 30590 | ||
| 30451 | ;; Ganeti uses SSH to communicate between nodes. | 30591 | ;; Ganeti uses SSH to communicate between nodes. |
| 30452 | (service openssh-service-type | 30592 | (service openssh-service-type |
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index 8b279954384..ac36bd17d4f 100644 --- a/gnu/build/hurd-boot.scm +++ b/gnu/build/hurd-boot.scm | |||
| @@ -185,13 +185,9 @@ set." | |||
| 185 | ("servers/crash-suspend" ("/hurd/crash" "--suspend")) | 185 | ("servers/crash-suspend" ("/hurd/crash" "--suspend")) |
| 186 | ("servers/password" ("/hurd/password")) | 186 | ("servers/password" ("/hurd/password")) |
| 187 | ("servers/socket/1" ("/hurd/pflocal")) | 187 | ("servers/socket/1" ("/hurd/pflocal")) |
| 188 | ("servers/socket/2" ("/hurd/pfinet" | 188 | ;; /servers/socket/2 and /26 are created by 'static-networking-service'. |
| 189 | "--interface" "eth0" | 189 | ;; XXX: Spawn pfinet without arguments on these nodes so that a DHCP |
| 190 | "--address" | 190 | ;; client has someone to talk to? |
| 191 | "10.0.2.15" ;the default QEMU guest IP | ||
| 192 | "--netmask" "255.255.255.0" | ||
| 193 | "--gateway" "10.0.2.2" | ||
| 194 | "--ipv6" "/servers/socket/26")) | ||
| 195 | ("proc" ("/hurd/procfs" "--stat-mode=444")))) | 191 | ("proc" ("/hurd/procfs" "--stat-mode=444")))) |
| 196 | 192 | ||
| 197 | (define devices | 193 | (define devices |
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 7008ab137c8..d93ea6f0631 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm | |||
| @@ -35,6 +35,8 @@ | |||
| 35 | (define-module (gnu services base) | 35 | (define-module (gnu services base) |
| 36 | #:use-module (guix store) | 36 | #:use-module (guix store) |
| 37 | #:use-module (guix deprecation) | 37 | #:use-module (guix deprecation) |
| 38 | #:autoload (guix diagnostics) (warning) | ||
| 39 | #:autoload (guix i18n) (G_) | ||
| 38 | #:use-module (gnu services) | 40 | #:use-module (gnu services) |
| 39 | #:use-module (gnu services admin) | 41 | #:use-module (gnu services admin) |
| 40 | #:use-module (gnu services shepherd) | 42 | #:use-module (gnu services shepherd) |
| @@ -54,6 +56,7 @@ | |||
| 54 | #:use-module ((gnu packages base) | 56 | #:use-module ((gnu packages base) |
| 55 | #:select (coreutils glibc glibc-utf8-locales)) | 57 | #:select (coreutils glibc glibc-utf8-locales)) |
| 56 | #:autoload (gnu packages guile-xyz) (guile-netlink) | 58 | #:autoload (gnu packages guile-xyz) (guile-netlink) |
| 59 | #:autoload (gnu packages hurd) (hurd) | ||
| 57 | #:use-module (gnu packages package-management) | 60 | #:use-module (gnu packages package-management) |
| 58 | #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) | 61 | #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) |
| 59 | #:use-module (gnu packages linux) | 62 | #:use-module (gnu packages linux) |
| @@ -84,14 +87,32 @@ | |||
| 84 | virtual-terminal-service-type | 87 | virtual-terminal-service-type |
| 85 | 88 | ||
| 86 | static-networking | 89 | static-networking |
| 87 | |||
| 88 | static-networking? | 90 | static-networking? |
| 89 | static-networking-interface | 91 | static-networking-addresses |
| 90 | static-networking-ip | 92 | static-networking-links |
| 91 | static-networking-netmask | 93 | static-networking-routes |
| 92 | static-networking-gateway | ||
| 93 | static-networking-requirement | 94 | static-networking-requirement |
| 94 | 95 | ||
| 96 | network-address | ||
| 97 | network-address? | ||
| 98 | network-address-device | ||
| 99 | network-address-value | ||
| 100 | network-address-ipv6? | ||
| 101 | |||
| 102 | network-link | ||
| 103 | network-link? | ||
| 104 | network-link-name | ||
| 105 | network-link-type | ||
| 106 | network-link-arguments | ||
| 107 | |||
| 108 | network-route | ||
| 109 | network-route? | ||
| 110 | network-route-destination | ||
| 111 | network-route-source | ||
| 112 | network-route-device | ||
| 113 | network-route-ipv6? | ||
| 114 | network-route-gateway | ||
| 115 | |||
| 95 | static-networking-service | 116 | static-networking-service |
| 96 | static-networking-service-type | 117 | static-networking-service-type |
| 97 | 118 | ||
| @@ -2355,113 +2376,267 @@ notably to select, copy, and paste text. The default options use the | |||
| 2355 | (description "Start the @command{kmscon} virtual terminal emulator for the | 2376 | (description "Start the @command{kmscon} virtual terminal emulator for the |
| 2356 | Linux @dfn{kernel mode setting} (KMS)."))) | 2377 | Linux @dfn{kernel mode setting} (KMS)."))) |
| 2357 | 2378 | ||
| 2379 | |||
| 2380 | ;;; | ||
| 2381 | ;;; Static networking. | ||
| 2382 | ;;; | ||
| 2383 | |||
| 2384 | (define (ipv6-address? str) | ||
| 2385 | "Return true if STR denotes an IPv6 address." | ||
| 2386 | (false-if-exception (->bool (inet-pton AF_INET6 str)))) | ||
| 2387 | |||
| 2358 | (define-record-type* <static-networking> | 2388 | (define-record-type* <static-networking> |
| 2359 | static-networking make-static-networking | 2389 | static-networking make-static-networking |
| 2360 | static-networking? | 2390 | static-networking? |
| 2361 | (interface static-networking-interface) | 2391 | (addresses static-networking-addresses) ;list of <network-address> |
| 2362 | (ip static-networking-ip) | 2392 | (links static-networking-links (default '())) ;list of <network-link> |
| 2363 | (netmask static-networking-netmask | 2393 | (routes static-networking-routes (default '())) ;list of <network-routes> |
| 2364 | (default #f)) | ||
| 2365 | (gateway static-networking-gateway ;FIXME: doesn't belong here | ||
| 2366 | (default #f)) | ||
| 2367 | (provision static-networking-provision | 2394 | (provision static-networking-provision |
| 2368 | (default #f)) | 2395 | (default '(networking))) |
| 2369 | (requirement static-networking-requirement | 2396 | (requirement static-networking-requirement |
| 2370 | (default '())) | 2397 | (default '(udev))) |
| 2371 | (name-servers static-networking-name-servers ;FIXME: doesn't belong here | 2398 | (name-servers static-networking-name-servers ;FIXME: doesn't belong here |
| 2372 | (default '()))) | 2399 | (default '()))) |
| 2373 | 2400 | ||
| 2374 | (define static-networking-shepherd-service | 2401 | (define-record-type* <network-address> |
| 2402 | network-address make-network-address | ||
| 2403 | network-address? | ||
| 2404 | (device network-address-device) ;string--e.g., "en01" | ||
| 2405 | (value network-address-value) ;string--CIDR notation | ||
| 2406 | (ipv6? network-address-ipv6? ;Boolean | ||
| 2407 | (thunked) | ||
| 2408 | (default | ||
| 2409 | (ipv6-address? (cidr->ip (network-address-value this-record)))))) | ||
| 2410 | |||
| 2411 | (define-record-type* <network-link> | ||
| 2412 | network-link make-network-link | ||
| 2413 | network-link? | ||
| 2414 | (name network-link-name) ;string--e.g, "v0p0" | ||
| 2415 | (type network-link-type) ;symbol--e.g.,'veth | ||
| 2416 | (arguments network-link-arguments)) ;list | ||
| 2417 | |||
| 2418 | (define-record-type* <network-route> | ||
| 2419 | network-route make-network-route | ||
| 2420 | network-route? | ||
| 2421 | (destination network-route-destination) | ||
| 2422 | (source network-route-source (default #f)) | ||
| 2423 | (device network-route-device (default #f)) | ||
| 2424 | (ipv6? network-route-ipv6? (thunked) | ||
| 2425 | (default | ||
| 2426 | (or (ipv6-address? (network-route-destination this-record)) | ||
| 2427 | (and=> (network-route-gateway this-record) | ||
| 2428 | ipv6-address?)))) | ||
| 2429 | (gateway network-route-gateway (default #f))) | ||
| 2430 | |||
| 2431 | (define* (cidr->netmask str #:optional (family AF_INET)) | ||
| 2432 | "Given @var{str}, a string in CIDR notation (e.g., \"1.2.3.4/24\"), return | ||
| 2433 | the netmask as a string like \"255.255.255.0\"." | ||
| 2434 | (match (string-split str #\/) | ||
| 2435 | ((ip (= string->number bits)) | ||
| 2436 | (let ((mask (ash (- (expt 2 bits) 1) | ||
| 2437 | (- (if (= family AF_INET6) 128 32) | ||
| 2438 | bits)))) | ||
| 2439 | (inet-ntop family mask))) | ||
| 2440 | (_ #f))) | ||
| 2441 | |||
| 2442 | (define (cidr->ip str) | ||
| 2443 | "Strip the netmask bit of @var{str}, a CIDR-notation IP/netmask address." | ||
| 2444 | (match (string-split str #\/) | ||
| 2445 | ((or (ip _) (ip)) | ||
| 2446 | ip))) | ||
| 2447 | |||
| 2448 | (define* (ip+netmask->cidr ip netmask #:optional (family AF_INET)) | ||
| 2449 | "Return the CIDR notation (a string) for @var{ip} and @var{netmask}, two | ||
| 2450 | @var{family} address strings, where @var{family} is @code{AF_INET} or | ||
| 2451 | @code{AF_INET6}." | ||
| 2452 | (let* ((netmask (inet-pton family netmask)) | ||
| 2453 | (bits (logcount netmask))) | ||
| 2454 | (string-append ip "/" (number->string bits)))) | ||
| 2455 | |||
| 2456 | (define (static-networking->hurd-pfinet-options config) | ||
| 2457 | "Return command-line options for the Hurd's pfinet translator corresponding | ||
| 2458 | to CONFIG." | ||
| 2459 | (unless (null? (static-networking-links config)) | ||
| 2460 | ;; XXX: Presumably this is not supported, or perhaps could be approximated | ||
| 2461 | ;; by running separate pfinet instances in some cases? | ||
| 2462 | (warning (G_ "network links are currently ignored on GNU/Hurd~%"))) | ||
| 2463 | |||
| 2464 | (match (static-networking-addresses config) | ||
| 2465 | ((and addresses (first _ ...)) | ||
| 2466 | `("--ipv6" "/servers/socket/26" | ||
| 2467 | "--interface" ,(network-address-device first) | ||
| 2468 | ,@(append-map (lambda (address) | ||
| 2469 | `(,(if (network-address-ipv6? address) | ||
| 2470 | "--address6" | ||
| 2471 | "--address") | ||
| 2472 | ,(cidr->ip (network-address-value address)) | ||
| 2473 | ,@(match (cidr->netmask (network-address-value address) | ||
| 2474 | (if (network-address-ipv6? address) | ||
| 2475 | AF_INET6 | ||
| 2476 | AF_INET)) | ||
| 2477 | (#f '()) | ||
| 2478 | (mask (list "--netmask" mask))))) | ||
| 2479 | addresses) | ||
| 2480 | ,@(append-map (lambda (route) | ||
| 2481 | (match route | ||
| 2482 | (($ <network-route> "default" #f device _ gateway) | ||
| 2483 | (if (network-route-ipv6? route) | ||
| 2484 | `("--gateway6" ,gateway) | ||
| 2485 | `("--gateway" ,gateway))) | ||
| 2486 | (($ <network-route> destination) | ||
| 2487 | (warning (G_ "ignoring network route for '~a'~%") | ||
| 2488 | destination) | ||
| 2489 | '()))) | ||
| 2490 | (static-networking-routes config)))))) | ||
| 2491 | |||
| 2492 | (define (network-set-up/hurd config) | ||
| 2493 | "Set up networking for the Hurd." | ||
| 2494 | ;; The Hurd implements SIOCGIFADDR and other old-style ioctls, but the only | ||
| 2495 | ;; way to set up IPv6 is by starting pfinet with the right options. | ||
| 2496 | (if (equal? (static-networking-provision config) '(loopback)) | ||
| 2497 | (scheme-file "set-up-pflocal" #~(begin 'nothing-to-do! #t)) | ||
| 2498 | (scheme-file "set-up-pfinet" | ||
| 2499 | (with-imported-modules '((guix build utils)) | ||
| 2500 | #~(begin | ||
| 2501 | (use-modules (guix build utils) | ||
| 2502 | (ice-9 format)) | ||
| 2503 | |||
| 2504 | ;; TODO: Do that without forking. | ||
| 2505 | (let ((options '#$(static-networking->hurd-pfinet-options | ||
| 2506 | config))) | ||
| 2507 | (format #t "starting '~a~{ ~s~}'~%" | ||
| 2508 | #$(file-append hurd "/hurd/pfinet") | ||
| 2509 | options) | ||
| 2510 | (apply invoke #$(file-append hurd "/bin/settrans") "-fac" | ||
| 2511 | "/servers/socket/2" | ||
| 2512 | #$(file-append hurd "/hurd/pfinet") | ||
| 2513 | options))))))) | ||
| 2514 | |||
| 2515 | (define (network-tear-down/hurd config) | ||
| 2516 | (scheme-file "tear-down-pfinet" | ||
| 2517 | (with-imported-modules '((guix build utils)) | ||
| 2518 | #~(begin | ||
| 2519 | (use-modules (guix build utils)) | ||
| 2520 | |||
| 2521 | ;; Forcefully terminate pfinet. XXX: In theory this | ||
| 2522 | ;; should just undo the addresses and routes of CONFIG; | ||
| 2523 | ;; this could be done using ioctls like SIOCDELRT, but | ||
| 2524 | ;; these are IPv4-only; another option would be to use | ||
| 2525 | ;; fsysopts but that seems to crash pfinet. | ||
| 2526 | (invoke #$(file-append hurd "/bin/settrans") "-fg" | ||
| 2527 | "/servers/socket/2") | ||
| 2528 | #f)))) | ||
| 2529 | |||
| 2530 | (define network-set-up/linux | ||
| 2375 | (match-lambda | 2531 | (match-lambda |
| 2376 | (($ <static-networking> interface ip netmask gateway provision | 2532 | (($ <static-networking> addresses links routes) |
| 2377 | requirement name-servers) | 2533 | (scheme-file "set-up-network" |
| 2534 | (with-extensions (list guile-netlink) | ||
| 2535 | #~(begin | ||
| 2536 | (use-modules (ip addr) (ip link) (ip route)) | ||
| 2537 | |||
| 2538 | #$@(map (lambda (address) | ||
| 2539 | #~(begin | ||
| 2540 | (addr-add #$(network-address-device address) | ||
| 2541 | #$(network-address-value address) | ||
| 2542 | #:ipv6? | ||
| 2543 | #$(network-address-ipv6? address)) | ||
| 2544 | ;; FIXME: loopback? | ||
| 2545 | (link-set #$(network-address-device address) | ||
| 2546 | #:up #t))) | ||
| 2547 | addresses) | ||
| 2548 | #$@(map (match-lambda | ||
| 2549 | (($ <network-link> name type arguments) | ||
| 2550 | #~(link-add #$name #$type | ||
| 2551 | #:type-args '#$arguments))) | ||
| 2552 | links) | ||
| 2553 | #$@(map (lambda (route) | ||
| 2554 | #~(route-add #$(network-route-destination route) | ||
| 2555 | #:device | ||
| 2556 | #$(network-route-device route) | ||
| 2557 | #:ipv6? | ||
| 2558 | #$(network-route-ipv6? route) | ||
| 2559 | #:via | ||
| 2560 | #$(network-route-gateway route) | ||
| 2561 | #:src | ||
| 2562 | #$(network-route-source route))) | ||
| 2563 | routes) | ||
| 2564 | #t)))))) | ||
| 2565 | |||
| 2566 | (define network-tear-down/linux | ||
| 2567 | (match-lambda | ||
| 2568 | (($ <static-networking> addresses links routes) | ||
| 2569 | (scheme-file "tear-down-network" | ||
| 2570 | (with-extensions (list guile-netlink) | ||
| 2571 | #~(begin | ||
| 2572 | (use-modules (ip addr) (ip link) (ip route) | ||
| 2573 | (netlink error) | ||
| 2574 | (srfi srfi-34)) | ||
| 2575 | |||
| 2576 | (define-syntax-rule (false-if-netlink-error exp) | ||
| 2577 | (guard (c ((netlink-error? c) #f)) | ||
| 2578 | exp)) | ||
| 2579 | |||
| 2580 | ;; Wrap calls in 'false-if-netlink-error' so this | ||
| 2581 | ;; script goes as far as possible undoing the effects | ||
| 2582 | ;; of "set-up-network". | ||
| 2583 | |||
| 2584 | #$@(map (lambda (route) | ||
| 2585 | #~(false-if-netlink-error | ||
| 2586 | (route-del #$(network-route-destination route) | ||
| 2587 | #:device | ||
| 2588 | #$(network-route-device route) | ||
| 2589 | #:ipv6? | ||
| 2590 | #$(network-route-ipv6? route) | ||
| 2591 | #:via | ||
| 2592 | #$(network-route-gateway route) | ||
| 2593 | #:src | ||
| 2594 | #$(network-route-source route)))) | ||
| 2595 | routes) | ||
| 2596 | #$@(map (match-lambda | ||
| 2597 | (($ <network-link> name type arguments) | ||
| 2598 | #~(false-if-netlink-error | ||
| 2599 | (link-del #$name)))) | ||
| 2600 | links) | ||
| 2601 | #$@(map (lambda (address) | ||
| 2602 | #~(false-if-netlink-error | ||
| 2603 | (addr-del #$(network-address-device | ||
| 2604 | address) | ||
| 2605 | #$(network-address-value address) | ||
| 2606 | #:ipv6? | ||
| 2607 | #$(network-address-ipv6? address)))) | ||
| 2608 | addresses) | ||
| 2609 | #f)))))) | ||
| 2610 | |||
| 2611 | (define (static-networking-shepherd-service config) | ||
| 2612 | (match config | ||
| 2613 | (($ <static-networking> addresses links routes | ||
| 2614 | provision requirement name-servers) | ||
| 2378 | (let ((loopback? (and provision (memq 'loopback provision)))) | 2615 | (let ((loopback? (and provision (memq 'loopback provision)))) |
| 2379 | (define set-up-via-ioctl | ||
| 2380 | #~(let* ((addr (inet-pton AF_INET #$ip)) | ||
| 2381 | (sockaddr (make-socket-address AF_INET addr 0)) | ||
| 2382 | (mask (and #$netmask (inet-pton AF_INET #$netmask))) | ||
| 2383 | (maskaddr (and mask | ||
| 2384 | (make-socket-address AF_INET mask 0))) | ||
| 2385 | (gateway (and #$gateway | ||
| 2386 | (inet-pton AF_INET #$gateway))) | ||
| 2387 | (gatewayaddr (and gateway | ||
| 2388 | (make-socket-address AF_INET | ||
| 2389 | gateway 0)))) | ||
| 2390 | (configure-network-interface #$interface sockaddr | ||
| 2391 | (logior IFF_UP | ||
| 2392 | #$(if loopback? | ||
| 2393 | #~IFF_LOOPBACK | ||
| 2394 | 0)) | ||
| 2395 | #:netmask maskaddr) | ||
| 2396 | (when gateway | ||
| 2397 | (let ((sock (socket AF_INET SOCK_DGRAM 0))) | ||
| 2398 | (add-network-route/gateway sock gatewayaddr) | ||
| 2399 | (close-port sock))))) | ||
| 2400 | |||
| 2401 | (define tear-down-via-ioctl | ||
| 2402 | #~(let ((sock (socket AF_INET SOCK_STREAM 0))) | ||
| 2403 | (when #$gateway | ||
| 2404 | (delete-network-route sock | ||
| 2405 | (make-socket-address AF_INET | ||
| 2406 | INADDR_ANY 0))) | ||
| 2407 | (set-network-interface-flags sock #$interface 0) | ||
| 2408 | (close-port sock) | ||
| 2409 | #f)) | ||
| 2410 | |||
| 2411 | (define set-up-via-netlink | ||
| 2412 | (with-extensions (list guile-netlink) | ||
| 2413 | #~(let ((ip #$(if netmask | ||
| 2414 | #~(ip+netmask->cidr #$ip #$netmask) | ||
| 2415 | ip))) | ||
| 2416 | (addr-add #$interface ip) | ||
| 2417 | (when #$gateway | ||
| 2418 | (route-add "default" #:device #$interface | ||
| 2419 | #:via #$gateway)) | ||
| 2420 | (link-set #$interface #:up #t)))) | ||
| 2421 | |||
| 2422 | (define tear-down-via-netlink | ||
| 2423 | (with-extensions (list guile-netlink) | ||
| 2424 | #~(begin | ||
| 2425 | (link-set #$interface #:down #t) | ||
| 2426 | (when #$gateway | ||
| 2427 | (route-del "default" #:device #$interface)) | ||
| 2428 | (addr-del #$interface #$ip) | ||
| 2429 | #f))) | ||
| 2430 | |||
| 2431 | (define helpers | ||
| 2432 | #~(define (ip+netmask->cidr ip netmask) | ||
| 2433 | ;; Return the CIDR notation (a string) for IP and NETMASK, two | ||
| 2434 | ;; IPv4 address strings. | ||
| 2435 | (let* ((netmask (inet-pton AF_INET netmask)) | ||
| 2436 | (bits (logcount netmask))) | ||
| 2437 | (string-append ip "/" (number->string bits))))) | ||
| 2438 | |||
| 2439 | (shepherd-service | 2616 | (shepherd-service |
| 2440 | 2617 | ||
| 2441 | (documentation | 2618 | (documentation |
| 2442 | "Bring up the networking interface using a static IP address.") | 2619 | "Bring up the networking interface using a static IP address.") |
| 2443 | (requirement requirement) | 2620 | (requirement requirement) |
| 2444 | (provision (or provision | 2621 | (provision provision) |
| 2445 | (list (symbol-append 'networking- | ||
| 2446 | (string->symbol interface))))) | ||
| 2447 | 2622 | ||
| 2448 | (start #~(lambda _ | 2623 | (start #~(lambda _ |
| 2449 | ;; Return #t if successfully started. | 2624 | ;; Return #t if successfully started. |
| 2450 | #$helpers | 2625 | (load #$(let-system (system target) |
| 2451 | (if (string-contains %host-type "-linux") | 2626 | (if (string-contains (or target system) "-linux") |
| 2452 | #$set-up-via-netlink | 2627 | (network-set-up/linux config) |
| 2453 | #$set-up-via-ioctl))) | 2628 | (network-set-up/hurd config)))))) |
| 2454 | (stop #~(lambda _ | 2629 | (stop #~(lambda _ |
| 2455 | ;; Return #f is successfully stopped. | 2630 | ;; Return #f is successfully stopped. |
| 2456 | (if (string-contains %host-type "-linux") | 2631 | (load #$(let-system (system target) |
| 2457 | #$tear-down-via-netlink | 2632 | (if (string-contains (or target system) "-linux") |
| 2458 | #$tear-down-via-ioctl))) | 2633 | (network-tear-down/linux config) |
| 2459 | (modules `((ip addr) | 2634 | (network-tear-down/hurd config)))))) |
| 2460 | (ip link) | ||
| 2461 | (ip route) | ||
| 2462 | ,@%default-modules)) | ||
| 2463 | (respawn? #f)))))) | 2635 | (respawn? #f)))))) |
| 2464 | 2636 | ||
| 2637 | (define (static-networking-shepherd-services networks) | ||
| 2638 | (map static-networking-shepherd-service networks)) | ||
| 2639 | |||
| 2465 | (define (static-networking-etc-files interfaces) | 2640 | (define (static-networking-etc-files interfaces) |
| 2466 | "Return a /etc/resolv.conf entry for INTERFACES or the empty list." | 2641 | "Return a /etc/resolv.conf entry for INTERFACES or the empty list." |
| 2467 | (match (delete-duplicates | 2642 | (match (delete-duplicates |
| @@ -2480,30 +2655,6 @@ Linux @dfn{kernel mode setting} (KMS)."))) | |||
| 2480 | # Generated by 'static-networking-service'.\n" | 2655 | # Generated by 'static-networking-service'.\n" |
| 2481 | content)))))))) | 2656 | content)))))))) |
| 2482 | 2657 | ||
| 2483 | (define (static-networking-shepherd-services interfaces) | ||
| 2484 | "Return the list of Shepherd services to bring up INTERFACES, a list of | ||
| 2485 | <static-networking> objects." | ||
| 2486 | (define (loopback? service) | ||
| 2487 | (memq 'loopback (shepherd-service-provision service))) | ||
| 2488 | |||
| 2489 | (let ((services (map static-networking-shepherd-service interfaces))) | ||
| 2490 | (match (remove loopback? services) | ||
| 2491 | (() | ||
| 2492 | ;; There's no interface other than 'loopback', so we assume that the | ||
| 2493 | ;; 'networking' service will be provided by dhclient or similar. | ||
| 2494 | services) | ||
| 2495 | ((non-loopback ...) | ||
| 2496 | ;; Assume we're providing all the interfaces, and thus, provide a | ||
| 2497 | ;; 'networking' service. | ||
| 2498 | (cons (shepherd-service | ||
| 2499 | (provision '(networking)) | ||
| 2500 | (requirement (append-map shepherd-service-provision | ||
| 2501 | services)) | ||
| 2502 | (start #~(const #t)) | ||
| 2503 | (stop #~(const #f)) | ||
| 2504 | (documentation "Bring up all the networking interfaces.")) | ||
| 2505 | services))))) | ||
| 2506 | |||
| 2507 | (define static-networking-service-type | 2658 | (define static-networking-service-type |
| 2508 | ;; The service type for statically-defined network interfaces. | 2659 | ;; The service type for statically-defined network interfaces. |
| 2509 | (service-type (name 'static-networking) | 2660 | (service-type (name 'static-networking) |
| @@ -2521,12 +2672,13 @@ with the given IP address, gateway, netmask, and so on. The value for | |||
| 2521 | services of this type is a list of @code{static-networking} objects, one per | 2672 | services of this type is a list of @code{static-networking} objects, one per |
| 2522 | network interface."))) | 2673 | network interface."))) |
| 2523 | 2674 | ||
| 2524 | (define* (static-networking-service interface ip | 2675 | (define-deprecated (static-networking-service interface ip |
| 2525 | #:key | 2676 | #:key |
| 2526 | netmask gateway provision | 2677 | netmask gateway provision |
| 2527 | ;; Most interfaces require udev to be usable. | 2678 | ;; Most interfaces require udev to be usable. |
| 2528 | (requirement '(udev)) | 2679 | (requirement '(udev)) |
| 2529 | (name-servers '())) | 2680 | (name-servers '())) |
| 2681 | static-networking-service-type | ||
| 2530 | "Return a service that starts @var{interface} with address @var{ip}. If | 2682 | "Return a service that starts @var{interface} with address @var{ip}. If |
| 2531 | @var{netmask} is true, use it as the network mask. If @var{gateway} is true, | 2683 | @var{netmask} is true, use it as the network mask. If @var{gateway} is true, |
| 2532 | it must be a string specifying the default network gateway. | 2684 | 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 | |||
| 2537 | to handle." | 2689 | to handle." |
| 2538 | (simple-service 'static-network-interface | 2690 | (simple-service 'static-network-interface |
| 2539 | static-networking-service-type | 2691 | static-networking-service-type |
| 2540 | (list (static-networking (interface interface) (ip ip) | 2692 | (list (static-networking |
| 2541 | (netmask netmask) (gateway gateway) | 2693 | (addresses |
| 2542 | (provision provision) | 2694 | (list (network-address |
| 2543 | (requirement requirement) | 2695 | (device interface) |
| 2544 | (name-servers name-servers))))) | 2696 | (value (if netmask |
| 2697 | (ip+netmask->cidr ip netmask) | ||
| 2698 | ip)) | ||
| 2699 | (ipv6? #f)))) | ||
| 2700 | (routes | ||
| 2701 | (if gateway | ||
| 2702 | (list (network-route | ||
| 2703 | (destination "default") | ||
| 2704 | (gateway gateway) | ||
| 2705 | (ipv6? #f))) | ||
| 2706 | '())) | ||
| 2707 | (requirement requirement) | ||
| 2708 | (provision (or provision '(networking))) | ||
| 2709 | (name-servers name-servers))))) | ||
| 2545 | 2710 | ||
| 2546 | 2711 | ||
| 2547 | (define %base-services | 2712 | (define %base-services |
| @@ -2573,10 +2738,12 @@ to handle." | |||
| 2573 | (tty "tty6"))) | 2738 | (tty "tty6"))) |
| 2574 | 2739 | ||
| 2575 | (service static-networking-service-type | 2740 | (service static-networking-service-type |
| 2576 | (list (static-networking (interface "lo") | 2741 | (list (static-networking |
| 2577 | (ip "127.0.0.1") | 2742 | (addresses (list (network-address |
| 2578 | (requirement '()) | 2743 | (device "lo") |
| 2579 | (provision '(loopback))))) | 2744 | (value "127.0.0.1")))) |
| 2745 | (requirement '()) | ||
| 2746 | (provision '(loopback))))) | ||
| 2580 | (syslog-service) | 2747 | (syslog-service) |
| 2581 | (service urandom-seed-service-type) | 2748 | (service urandom-seed-service-type) |
| 2582 | (service guix-service-type) | 2749 | (service guix-service-type) |
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 0794671ce4c..0e73ca0d998 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm | |||
| @@ -79,11 +79,28 @@ | |||
| 79 | (service hurd-getty-service-type (hurd-getty-configuration | 79 | (service hurd-getty-service-type (hurd-getty-configuration |
| 80 | (tty "tty2"))) | 80 | (tty "tty2"))) |
| 81 | (service static-networking-service-type | 81 | (service static-networking-service-type |
| 82 | (list (static-networking (interface "lo") | 82 | (list (static-networking |
| 83 | (ip "127.0.0.1") | 83 | (addresses |
| 84 | (requirement '()) | 84 | (list (network-address |
| 85 | (provision '(loopback networking)) | 85 | (device "lo") |
| 86 | (name-servers '("10.0.2.3"))))) | 86 | (value "127.0.0.1")))) |
| 87 | (requirement '()) | ||
| 88 | (provision '(loopback))) | ||
| 89 | (static-networking | ||
| 90 | (addresses | ||
| 91 | ;; The default QEMU guest address. To get "eth0", | ||
| 92 | ;; you need QEMU to emulate a device for which Mach | ||
| 93 | ;; has an in-kernel driver, for instance with: | ||
| 94 | ;; --device rtl8139,netdev=net0 --netdev user,id=net0 | ||
| 95 | (list (network-address | ||
| 96 | (device "eth0") | ||
| 97 | (value "10.0.2.15/24")))) | ||
| 98 | (routes | ||
| 99 | (list (network-route | ||
| 100 | (destination "default") | ||
| 101 | (gateway "10.0.2.2")))) | ||
| 102 | (provision '(networking)) | ||
| 103 | (name-servers '("10.0.2.3"))))) | ||
| 87 | (syslog-service) | 104 | (syslog-service) |
| 88 | (service guix-service-type | 105 | (service guix-service-type |
| 89 | (guix-configuration | 106 | (guix-configuration |
diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 7b394184ad2..bdfe5801453 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm | |||
| @@ -408,10 +408,13 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m | |||
| 408 | 408 | ||
| 409 | ;; Loopback device, needed by OpenSSH notably. | 409 | ;; Loopback device, needed by OpenSSH notably. |
| 410 | (service static-networking-service-type | 410 | (service static-networking-service-type |
| 411 | (list (static-networking (interface "lo") | 411 | (list (static-networking |
| 412 | (ip "127.0.0.1") | 412 | (addresses |
| 413 | (requirement '()) | 413 | (list (network-address |
| 414 | (provision '(loopback))))) | 414 | (device "lo") |
| 415 | (value "127.0.0.1")))) | ||
| 416 | (requirement '()) | ||
| 417 | (provision '(loopback))))) | ||
| 415 | 418 | ||
| 416 | (service wpa-supplicant-service-type) | 419 | (service wpa-supplicant-service-type) |
| 417 | (dbus-service) | 420 | (dbus-service) |
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 131428c128b..c66af279f24 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm | |||
| @@ -337,7 +337,7 @@ port 7, and a dict service on port 2628." | |||
| 337 | (srfi srfi-1)) | 337 | (srfi srfi-1)) |
| 338 | (live-service-running | 338 | (live-service-running |
| 339 | (find (lambda (live) | 339 | (find (lambda (live) |
| 340 | (memq 'networking-ovs0 | 340 | (memq 'networking |
| 341 | (live-service-provision live))) | 341 | (live-service-provision live))) |
| 342 | (current-services)))) | 342 | (current-services)))) |
| 343 | marionette)) | 343 | marionette)) |
