diff options
Diffstat (limited to 'gnu/services/networking.scm')
| -rw-r--r-- | gnu/services/networking.scm | 275 |
1 files changed, 117 insertions, 158 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 6ac440fd26..67674e895e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -24,12 +24,14 @@ (define-module (gnu services networking) #:use-module (gnu services) + #:use-module (gnu services base) #:use-module (gnu services shepherd) #:use-module (gnu services dbus) #:use-module (gnu system shadow) #:use-module (gnu system pam) #:use-module (gnu packages admin) #:use-module (gnu packages connman) + #:use-module (gnu packages freedesktop) #:use-module (gnu packages linux) #:use-module (gnu packages tor) #:use-module (gnu packages messaging) @@ -45,18 +47,19 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (%facebook-host-aliases - static-networking + dhcp-client-service - static-networking? - static-networking-interface - static-networking-ip - static-networking-netmask - static-networking-gateway - static-networking-requirement + dhcpd-service-type + dhcpd-configuration + dhcpd-configuration? + dhcpd-configuration-package + dhcpd-configuration-config-file + dhcpd-configuration-version + dhcpd-configuration-run-directory + dhcpd-configuration-lease-file + dhcpd-configuration-pid-file + dhcpd-configuration-interfaces - static-networking-service - static-networking-service-type - dhcp-client-service %ntp-servers ntp-configuration @@ -90,6 +93,9 @@ connman-configuration? connman-service-type + modem-manager-configuration + modem-manager-configuration? + modem-manager-service-type wpa-supplicant-service-type openvswitch-service-type @@ -134,154 +140,6 @@ fe80::1%lo0 connect.facebook.net fe80::1%lo0 www.connect.facebook.net fe80::1%lo0 apps.facebook.com\n") - -(define-record-type* <static-networking> - 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)) - (provision static-networking-provision - (default #f)) - (requirement static-networking-requirement - (default '())) - (name-servers static-networking-name-servers ;FIXME: doesn't belong here - (default '()))) - -(define static-networking-shepherd-service - (match-lambda - (($ <static-networking> interface ip netmask gateway provision - requirement name-servers) - (let ((loopback? (and provision (memq 'loopback provision)))) - (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))))) - - (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)))))) - (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))) - (respawn? #f)))))) - -(define (static-networking-etc-files interfaces) - "Return a /etc/resolv.conf entry for INTERFACES or the empty list." - (match (delete-duplicates - (append-map static-networking-name-servers - interfaces)) - (() - '()) - ((name-servers ...) - (let ((content (string-join - (map (cut string-append "nameserver " <>) - name-servers) - "\n" 'suffix))) - `(("resolv.conf" - ,(plain-file "resolv.conf" - (string-append "\ -# 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 -<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 - ;; The service type for statically-defined network interfaces. - (service-type (name 'static-networking) - (extensions - (list - (service-extension shepherd-root-service-type - static-networking-shepherd-services) - (service-extension etc-service-type - static-networking-etc-files))) - (compose concatenate) - (extend append) - (description - "Turn up the specified network interfaces upon startup, -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 '())) - "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. - -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." - (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))))) - (define dhcp-client-service-type (shepherd-service-type 'dhcp-client @@ -341,6 +199,72 @@ to handle." Protocol (DHCP) client, on all the non-loopback network interfaces." (service dhcp-client-service-type dhcp)) +(define-record-type* <dhcpd-configuration> + dhcpd-configuration make-dhcpd-configuration + dhcpd-configuration? + (package dhcpd-configuration-package ;<package> + (default isc-dhcp)) + (config-file dhcpd-configuration-config-file ;file-like + (default #f)) + (version dhcpd-configuration-version ;"4", "6", or "4o6" + (default "4")) + (run-directory dhcpd-configuration-run-directory + (default "/run/dhcpd")) + (lease-file dhcpd-configuration-lease-file + (default "/var/db/dhcpd.leases")) + (pid-file dhcpd-configuration-pid-file + (default "/run/dhcpd/dhcpd.pid")) + ;; list of strings, e.g. (list "enp0s25") + (interfaces dhcpd-configuration-interfaces + (default '()))) + +(define dhcpd-shepherd-service + (match-lambda + (($ <dhcpd-configuration> package config-file version run-directory + lease-file pid-file interfaces) + (unless config-file + (error "Must supply a config-file")) + (list (shepherd-service + ;; Allow users to easily run multiple versions simultaneously. + (provision (list (string->symbol + (string-append "dhcpv" version "-daemon")))) + (documentation (string-append "Run the DHCPv" version " daemon")) + (requirement '(networking)) + (start #~(make-forkexec-constructor + '(#$(file-append package "/sbin/dhcpd") + #$(string-append "-" version) + "-lf" #$lease-file + "-pf" #$pid-file + "-cf" #$config-file + #$@interfaces) + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))))) + +(define dhcpd-activation + (match-lambda + (($ <dhcpd-configuration> package config-file version run-directory + lease-file pid-file interfaces) + (with-imported-modules '((guix build utils)) + #~(begin + (unless (file-exists? #$run-directory) + (mkdir #$run-directory)) + ;; According to the DHCP manual (man dhcpd.leases), the lease + ;; database must be present for dhcpd to start successfully. + (unless (file-exists? #$lease-file) + (with-output-to-file #$lease-file + (lambda _ (display "")))) + ;; Validate the config. + (invoke + #$(file-append package "/sbin/dhcpd") "-t" "-cf" + #$config-file)))))) + +(define dhcpd-service-type + (service-type + (name 'dhcpd) + (extensions + (list (service-extension shepherd-root-service-type dhcpd-shepherd-service) + (service-extension activation-service-type dhcpd-activation))))) + (define %ntp-servers ;; Default set of NTP servers. These URLs are managed by the NTP Pool project. ;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact @@ -891,6 +815,17 @@ and @command{wicd-curses} user interfaces." ;;; +;;; ModemManager +;;; + +(define-record-type* <modem-manager-configuration> + modem-manager-configuration make-modem-manager-configuration + modem-manager-configuration? + (modem-manager modem-manager-configuration-modem-manager + (default modem-manager))) + + +;;; ;;; NetworkManager ;;; @@ -1028,6 +963,30 @@ a network connection manager.")))) ;;; +;;; Modem manager +;;; + +(define modem-manager-service-type + (let ((config->package + (match-lambda + (($ <modem-manager-configuration> modem-manager) + (list modem-manager))))) + (service-type (name 'modem-manager) + (extensions + (list (service-extension dbus-root-service-type + config->package) + (service-extension udev-service-type + config->package) + (service-extension polkit-service-type + config->package))) + (default-value (modem-manager-configuration)) + (description + "Run @uref{https://wiki.gnome.org/Projects/ModemManager, +ModemManager}, a modem management daemon that aims to simplify dialup +networking.")))) + + +;;; ;;; WPA supplicant ;;; |