From 0cc742b2616dff7359b548c58fc7d9b478a3e72d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 6 Oct 2021 23:06:47 +0200 Subject: services: static-networking: Use Guile-Netlink on GNU/Linux. * gnu/services/base.scm (static-networking-shepherd-service): Define 'set-up-via-ioctl', 'tear-down-via-ioctl', 'set-up-via-netlink', 'tear-down-via-netlink', and 'helpers' and use them in 'start' and 'stop'. Add (ip *) modules to 'modules'. --- gnu/services/base.scm | 102 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 72 insertions(+), 30 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 2631478b9e..7008ab137c 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -53,6 +53,7 @@ #:use-module (gnu packages bash) #:use-module ((gnu packages base) #:select (coreutils glibc glibc-utf8-locales)) + #:autoload (gnu packages guile-xyz) (guile-netlink) #:use-module (gnu packages package-management) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module (gnu packages linux) @@ -2375,6 +2376,66 @@ Linux @dfn{kernel mode setting} (KMS)."))) (($ interface ip netmask gateway 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 @@ -2386,38 +2447,19 @@ Linux @dfn{kernel mode setting} (KMS)."))) (start #~(lambda _ ;; Return #t if successfully started. - (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)))))) + #$helpers + (if (string-contains %host-type "-linux") + #$set-up-via-netlink + #$set-up-via-ioctl))) (stop #~(lambda _ ;; Return #f is successfully stopped. - (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))) + (if (string-contains %host-type "-linux") + #$tear-down-via-netlink + #$tear-down-via-ioctl))) + (modules `((ip addr) + (ip link) + (ip route) + ,@%default-modules)) (respawn? #f)))))) (define (static-networking-etc-files interfaces) -- cgit 1.4.1 From 39e3b4b7cee175a3c1f37329744c582528d55f5d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 25 Oct 2021 08:33:04 +0200 Subject: services: secret-service: Turn into a Shepherd service. * gnu/services/virtualization.scm (secret-service-activation): Remove. (secret-service-shepherd-services): New procedure. (secret-service-type)[extensions]: Remove ACTIVATION-SERVICE-TYPE extension. Add SHEPHERD-ROOT-SERVICE-TYPE and USER-PROCESSES-SERVICE-TYPE extensions. * gnu/build/secret-service.scm (delete-file*): New procedure. (secret-service-receive-secrets): Use it. --- gnu/build/secret-service.scm | 17 +++++++++++++++- gnu/services/virtualization.scm | 45 ++++++++++++++++++++++++++++++----------- 2 files changed, 49 insertions(+), 13 deletions(-) (limited to 'gnu/services') diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm index 46dcf1b9c3..4e183e11e8 100644 --- a/gnu/build/secret-service.scm +++ b/gnu/build/secret-service.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020, 2021 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. @@ -111,6 +111,15 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return (close-port sock) #f)))) +(define (delete-file* file) + "Ensure FILE does not exist." + (catch 'system-error + (lambda () + (delete-file file)) + (lambda args + (unless (= ENOENT (system-error-errno args)) + (apply throw args))))) + (define (secret-service-receive-secrets port) "Listen to local PORT and wait for a secret service client to send secrets. Write them to the file system. Return the list of files installed on success, @@ -170,6 +179,12 @@ and #f otherwise." (log "installing file '~a' (~a bytes)...~%" file size) (mkdir-p (dirname file)) + + ;; It could be that FILE already exists, for instance + ;; because it has been created by a service's activation + ;; snippet (e.g., SSH host keys). Delete it. + (delete-file* file) + (call-with-output-file file (lambda (output) (dump port output size) diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index 4222bb4353..66ae1a1565 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -898,23 +898,44 @@ specified, the QEMU default path is used.")) ;;; Secrets for guest VMs. ;;; -(define (secret-service-activation port) - "Return an activation snippet that fetches sensitive material at local PORT, +(define (secret-service-shepherd-services port) + "Return a Shepherd service that fetches sensitive material at local PORT, over TCP. Reboot upon failure." - (with-imported-modules '((gnu build secret-service) - (guix build utils)) - #~(begin - (use-modules (gnu build secret-service)) - (let ((sent (secret-service-receive-secrets #$port))) - (unless sent - (sleep 3) - (reboot)))))) + ;; This is a Shepherd service, rather than an activation snippet, to make + ;; sure it is started once 'networking' is up so it can accept incoming + ;; connections. + (list + (shepherd-service + (documentation "Fetch secrets from the host at startup time.") + (provision '(secret-service-client)) + (requirement '(loopback networking)) + (modules '((gnu build secret-service) + (guix build utils))) + (start (with-imported-modules '((gnu build secret-service) + (guix build utils)) + #~(lambda () + ;; Since shepherd's output port goes to /dev/log, write this + ;; message to stderr so it's visible on the Mach console. + (format (current-error-port) + "receiving secrets from the host...~%") + (force-output (current-error-port)) + + (let ((sent (secret-service-receive-secrets #$port))) + (unless sent + (sleep 3) + (reboot)))))) + (stop #~(const #f))))) (define secret-service-type (service-type (name 'secret-service) - (extensions (list (service-extension activation-service-type - secret-service-activation))) + (extensions (list (service-extension shepherd-root-service-type + secret-service-shepherd-services) + + ;; Make every Shepherd service depend on + ;; 'secret-service-client'. + (service-extension user-processes-service-type + (const '(secret-service-client))))) (description "This service fetches secret key and other sensitive material over TCP at boot time. This service is meant to be used by virtual machines (VMs) that -- cgit 1.4.1 From 223f1b1eb3707f1d3ef91200dd616ee6c8b77db0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Oct 2021 23:43:52 +0200 Subject: services: static-networking: Change interface to mimic netlink. * 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 | 190 ++++++++++++++++++--- gnu/build/hurd-boot.scm | 10 +- gnu/services/base.scm | 425 +++++++++++++++++++++++++++++++++-------------- gnu/system/hurd.scm | 27 ++- gnu/system/install.scm | 11 +- gnu/tests/networking.scm | 2 +- 6 files changed, 494 insertions(+), 171 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 1535fb9f93..73ad818cb6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16852,32 +16852,165 @@ 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. - -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. +@deftp {Data Type} static-networking +This is the data type representing a static network configuration. -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/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 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 @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")) %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 @@ set." ("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 7008ab137c..d93ea6f063 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 @@ #: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) @@ -84,14 +87,32 @@ 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 @@ -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 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)) + (default '(networking))) (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 #$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 "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 + (($ 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 + (($ 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 provision) (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)) + (load #$(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 @@ -2480,30 +2655,6 @@ Linux @dfn{kernel mode setting} (KMS)."))) # 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) @@ -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 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. @@ -2537,11 +2689,24 @@ interface of interest. Behind the scenes what it does is extend 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 (or provision '(networking))) + (name-servers name-servers))))) (define %base-services @@ -2573,10 +2738,12 @@ to handle." (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 @@ (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 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m ;; 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 @@ port 7, and a dict service on port 2628." (srfi srfi-1)) (live-service-running (find (lambda (live) - (memq 'networking-ovs0 + (memq 'networking (live-service-provision live))) (current-services)))) marionette)) -- cgit 1.4.1 From 1644f4f1f8957f3f3a88037aed80d501fdceaae7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Oct 2021 12:20:49 +0200 Subject: services: Define '%qemu-static-networking'. * gnu/services/base.scm (%qemu-static-networking): New variable. * gnu/system/hurd.scm (%base-services/hurd): Use it. * doc/guix.texi (Networking Setup): Document it. --- doc/guix.texi | 8 ++++++++ gnu/services/base.scm | 16 ++++++++++++++++ gnu/system/hurd.scm | 21 ++++++--------------- 3 files changed, 30 insertions(+), 15 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 73ad818cb6..22f710d0c1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17012,6 +17012,14 @@ List of arguments for this type of link. @end table @end deftp +@cindex networking, with QEMU +@cindex QEMU, networking +@defvr {Scheme Variable} %qemu-static-networking +This is the @code{static-networking} record representing network setup +when using QEMU's user-mode network stack on @code{eth0} (@pxref{Using +the user mode network stack,,, QEMU, QEMU Documentation}). +@end defvr + @cindex DHCP, networking service @defvr {Scheme Variable} dhcp-client-service-type This is the type of services that run @var{dhcp}, a Dynamic Host Configuration diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d93ea6f063..31b418dabf 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -116,6 +116,8 @@ static-networking-service static-networking-service-type + %qemu-static-networking + udev-configuration udev-configuration? udev-configuration-rules @@ -2708,6 +2710,20 @@ to handle." (provision (or provision '(networking))) (name-servers name-servers))))) +(define %qemu-static-networking + ;; Networking configuration for QEMU's user-mode network stack (info "(QEMU) + ;; Using the user mode network stack"). + (static-networking + (addresses (list (network-address + (device "eth0") + (value "10.0.2.15/24")))) + (routes (list (network-route + (destination "default") + (gateway "10.0.2.2")))) + (requirement '()) + (provision '(networking)) + (name-servers '("10.0.2.3")))) + (define %base-services ;; Convenience variable holding the basic services. diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index 0e73ca0d99..ec8484d746 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -86,21 +86,12 @@ (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"))))) + + ;; QEMU user-mode networking. 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 + %qemu-static-networking)) (syslog-service) (service guix-service-type (guix-configuration -- cgit 1.4.1 From 5967aee398c26a4814da1d8dba3f2dba84b06a4b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Oct 2021 12:26:31 +0200 Subject: services: Define '%loopback-static-networking'. * gnu/services/base.scm (%loopback-static-networking): New variable. (%base-services): Use it. * gnu/system/hurd.scm (%base-services/hurd): Use it. * gnu/system/install.scm (%installation-services): Use it. * doc/guix.texi (Networking Setup): Document it. --- doc/guix.texi | 7 +++++++ gnu/services/base.scm | 17 +++++++++++------ gnu/system/hurd.scm | 8 +------- gnu/system/install.scm | 8 +------- 4 files changed, 20 insertions(+), 20 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 22f710d0c1..c00ec81e44 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17012,6 +17012,13 @@ List of arguments for this type of link. @end table @end deftp +@cindex loopback device +@defvr {Scheme Variable} %loopback-static-networking +This is the @code{static-networking} record representing the ``loopback +device'', @code{lo}, for IP addresses 127.0.0.1 and ::1, and providing +the @code{loopback} Shepherd service. +@end defvr + @cindex networking, with QEMU @cindex QEMU, networking @defvr {Scheme Variable} %qemu-static-networking diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 31b418dabf..5f93483dda 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -116,6 +116,7 @@ static-networking-service static-networking-service-type + %loopback-static-networking %qemu-static-networking udev-configuration @@ -2710,6 +2711,15 @@ to handle." (provision (or provision '(networking))) (name-servers name-servers))))) +(define %loopback-static-networking + ;; The loopback device. + (static-networking + (addresses (list (network-address + (device "lo") + (value "127.0.0.1")))) + (requirement '()) + (provision '(loopback)))) + (define %qemu-static-networking ;; Networking configuration for QEMU's user-mode network stack (info "(QEMU) ;; Using the user mode network stack"). @@ -2754,12 +2764,7 @@ to handle." (tty "tty6"))) (service static-networking-service-type - (list (static-networking - (addresses (list (network-address - (device "lo") - (value "127.0.0.1")))) - (requirement '()) - (provision '(loopback))))) + (list %loopback-static-networking)) (syslog-service) (service urandom-seed-service-type) (service guix-service-type) diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm index ec8484d746..2acc7b7e11 100644 --- a/gnu/system/hurd.scm +++ b/gnu/system/hurd.scm @@ -79,13 +79,7 @@ (service hurd-getty-service-type (hurd-getty-configuration (tty "tty2"))) (service static-networking-service-type - (list (static-networking - (addresses - (list (network-address - (device "lo") - (value "127.0.0.1")))) - (requirement '()) - (provision '(loopback))) + (list %loopback-static-networking ;; QEMU user-mode networking. To get "eth0", you need ;; QEMU to emulate a device for which Mach has an diff --git a/gnu/system/install.scm b/gnu/system/install.scm index bdfe580145..073d7df1db 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -408,13 +408,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m ;; Loopback device, needed by OpenSSH notably. (service static-networking-service-type - (list (static-networking - (addresses - (list (network-address - (device "lo") - (value "127.0.0.1")))) - (requirement '()) - (provision '(loopback))))) + (list %loopback-static-networking)) (service wpa-supplicant-service-type) (dbus-service) -- cgit 1.4.1