X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/c9436025a90b86047ba2203d58bbf238f8f9b2f9..4d06076714f03da55d09efede055f0c40da3403e:/gnu/services/networking.scm diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 400b6919d2..348dc369d8 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,11 +1,18 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016, 2018 Efraim Flashner ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2017 Thomas Danckaert -;;; Copyright © 2017 Marius Bakke +;;; Copyright © 2017, 2018 Marius Bakke +;;; Copyright © 2018 Tobias Geerinckx-Rice +;;; Copyright © 2018 Chris Marusich +;;; Copyright © 2018 Arun Isaac +;;; Copyright © 2019 Florian Pelz +;;; Copyright © 2019 Maxim Cournoyer +;;; Copyright © 2019 Sou Bunnbu +;;; Copyright © 2019 Alex Griffin ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,14 +32,19 @@ (define-module (gnu services networking) #:use-module (gnu services) #:use-module (gnu services base) + #:use-module (gnu services configuration) #: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 base) + #:use-module (gnu packages bash) #:use-module (gnu packages connman) + #:use-module (gnu packages freedesktop) #:use-module (gnu packages linux) #:use-module (gnu packages tor) + #:use-module (gnu packages usb-modeswitch) #:use-module (gnu packages messaging) #:use-module (gnu packages networking) #:use-module (gnu packages ntp) @@ -41,12 +53,18 @@ #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix modules) + #:use-module (guix packages) + #:use-module (guix deprecation) + #:use-module (rnrs enums) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (ice-9 match) + #:re-export (static-networking-service + static-networking-service-type) #:export (%facebook-host-aliases dhcp-client-service + dhcp-client-service-type dhcpd-service-type dhcpd-configuration @@ -59,13 +77,22 @@ dhcpd-configuration-pid-file dhcpd-configuration-interfaces - %ntp-servers - ntp-configuration ntp-configuration? + ntp-configuration-ntp + ntp-configuration-servers + ntp-allow-large-adjustment? + + %ntp-servers + ntp-server + ntp-server-type + ntp-server-address + ntp-server-options + ntp-service ntp-service-type + %openntpd-servers openntpd-configuration openntpd-configuration? openntpd-service-type @@ -86,16 +113,72 @@ network-manager-configuration network-manager-configuration? network-manager-configuration-dns + network-manager-configuration-vpn-plugins network-manager-service-type connman-configuration connman-configuration? connman-service-type + modem-manager-configuration + modem-manager-configuration? + modem-manager-service-type + + usb-modeswitch-configuration + usb-modeswitch-configuration? + usb-modeswitch-configuration-usb-modeswitch + usb-modeswitch-configuration-usb-modeswitch-data + usb-modeswitch-service-type + + wpa-supplicant-configuration + wpa-supplicant-configuration? + wpa-supplicant-configuration-wpa-supplicant + wpa-supplicant-configuration-requirement + wpa-supplicant-configuration-pid-file + wpa-supplicant-configuration-dbus? + wpa-supplicant-configuration-interface + wpa-supplicant-configuration-config-file + wpa-supplicant-configuration-extra-options wpa-supplicant-service-type + hostapd-configuration + hostapd-configuration? + hostapd-configuration-package + hostapd-configuration-interface + hostapd-configuration-ssid + hostapd-configuration-broadcast-ssid? + hostapd-configuration-channel + hostapd-configuration-driver + hostapd-service-type + + simulated-wifi-service-type + openvswitch-service-type - openvswitch-configuration)) + openvswitch-configuration + + iptables-configuration + iptables-configuration? + iptables-configuration-iptables + iptables-configuration-ipv4-rules + iptables-configuration-ipv6-rules + iptables-service-type + + nftables-service-type + nftables-configuration + nftables-configuration? + nftables-configuration-package + nftables-configuration-ruleset + %default-nftables-ruleset + + pagekite-service-type + pagekite-configuration + pagekite-configuration? + pagekite-configuration-package + pagekite-configuration-kitename + pagekite-configuration-kitesecret + pagekite-configuration-frontend + pagekite-configuration-kites + pagekite-configuration-extra-file)) ;;; Commentary: ;;; @@ -162,35 +245,28 @@ fe80::1%lo0 apps.facebook.com\n") ;; interfaces are typically down at this point. Thus we perform ;; our own interface discovery here. (define valid? - (negate loopback-network-interface?)) + (lambda (interface) + (and (arp-network-interface? interface) + (not (loopback-network-interface? interface)) + ;; XXX: Make sure the interfaces are up so that + ;; 'dhclient' can actually send/receive over them. + ;; Ignore those that cannot be activated. + (false-if-exception + (set-network-interface-up interface))))) (define ifaces (filter valid? (all-network-interface-names))) - ;; XXX: Make sure the interfaces are up so that 'dhclient' can - ;; actually send/receive over them. - (for-each set-network-interface-up ifaces) - (false-if-exception (delete-file #$pid-file)) (let ((pid (fork+exec-command (cons* #$dhclient "-nw" "-pf" #$pid-file ifaces)))) (and (zero? (cdr (waitpid pid))) - (let loop () - (catch 'system-error - (lambda () - (call-with-input-file #$pid-file read)) - (lambda args - ;; 'dhclient' returned before PID-FILE was created, - ;; so try again. - (let ((errno (system-error-errno args))) - (if (= ENOENT errno) - (begin - (sleep 1) - (loop)) - (apply throw args)))))))))) - (stop #~(make-kill-destructor)))))) - -(define* (dhcp-client-service #:key (dhcp isc-dhcp)) + (read-pid-file #$pid-file))))) + (stop #~(make-kill-destructor)))) + isc-dhcp)) + +(define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp)) + dhcp-client-service-type "Return a service that runs @var{dhcp}, a Dynamic Host Configuration Protocol (DHCP) client, on all the non-loopback network interfaces." (service dhcp-client-service-type dhcp)) @@ -250,7 +326,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." (with-output-to-file #$lease-file (lambda _ (display "")))) ;; Validate the config. - (invoke + (invoke/quiet #$(file-append package "/sbin/dhcpd") "-t" "-cf" #$config-file)))))) @@ -259,66 +335,129 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." (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 is the administrative contact - ;; for this NTP pool "zone". - '("0.guix.pool.ntp.org" - "1.guix.pool.ntp.org" - "2.guix.pool.ntp.org" - "3.guix.pool.ntp.org")) + (service-extension activation-service-type dhcpd-activation))) + (description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The +daemon is responsible for allocating IP addresses to its client."))) ;;; ;;; NTP. ;;; -;; TODO: Export. +(define ntp-server-types (make-enumeration + '(pool + server + peer + broadcast + manycastclient))) + +(define-record-type* + ntp-server make-ntp-server + ntp-server? + ;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration. + (type ntp-server-type + (default 'server)) + (address ntp-server-address) ; a string + ;; The list of options can contain single option names or tuples in the form + ;; '(name value). + (options ntp-server-options + (default '()))) + +(define (ntp-server->string ntp-server) + ;; Serialize the NTP server object as a string, ready to use in the NTP + ;; configuration file. + (define (flatten lst) + (reverse + (let loop ((x lst) + (res '())) + (if (list? x) + (fold loop res x) + (cons (format #f "~a" x) res))))) + + (match ntp-server + (($ type address options) + ;; XXX: It'd be neater if fields were validated at the syntax level (for + ;; static ones at least). Perhaps the Guix record type could support a + ;; predicate property on a field? + (unless (enum-set-member? type ntp-server-types) + (error "Invalid NTP server type" type)) + (string-join (cons* (symbol->string type) + address + (flatten options)))))) + +(define %ntp-servers + ;; Default set of NTP servers. These URLs are managed by the NTP Pool project. + ;; Within Guix, Leo Famulari is the administrative contact + ;; for this NTP pool "zone". + (list + (ntp-server + (type 'pool) + (address "0.guix.pool.ntp.org") + (options '("iburst"))))) ;as recommended in the ntpd manual + (define-record-type* ntp-configuration make-ntp-configuration ntp-configuration? (ntp ntp-configuration-ntp (default ntp)) - (servers ntp-configuration-servers) + (servers %ntp-configuration-servers ;list of objects + (default %ntp-servers)) (allow-large-adjustment? ntp-allow-large-adjustment? - (default #f))) + (default #t))) ;as recommended in the ntpd manual + +(define (ntp-configuration-servers ntp-configuration) + ;; A wrapper to support the deprecated form of this field. + (let ((ntp-servers (%ntp-configuration-servers ntp-configuration))) + (match ntp-servers + (((? string?) (? string?) ...) + (format (current-error-port) "warning: Defining NTP servers as strings is \ +deprecated. Please use records instead.\n") + (map (lambda (addr) + (ntp-server + (type 'server) + (address addr) + (options '()))) ntp-servers)) + ((($ ) ($ ) ...) + ntp-servers)))) (define ntp-shepherd-service - (match-lambda - (($ ntp servers allow-large-adjustment?) - (let () - ;; TODO: Add authentication support. - (define config - (string-append "driftfile /var/run/ntpd/ntp.drift\n" - (string-join (map (cut string-append "server " <>) - servers) - "\n") - " + (lambda (config) + (match config + (($ ntp servers allow-large-adjustment?) + (let ((servers (ntp-configuration-servers config))) + ;; TODO: Add authentication support. + (define config + (string-append "driftfile /var/run/ntpd/ntp.drift\n" + (string-join (map ntp-server->string servers) + "\n") + " # Disable status queries as a workaround for CVE-2013-5211: # . -restrict default kod nomodify notrap nopeer noquery -restrict -6 default kod nomodify notrap nopeer noquery +restrict default kod nomodify notrap nopeer noquery limited +restrict -6 default kod nomodify notrap nopeer noquery limited # Yet, allow use of the local 'ntpq'. restrict 127.0.0.1 -restrict -6 ::1\n")) +restrict -6 ::1 - (define ntpd.conf - (plain-file "ntpd.conf" config)) +# This is required to use servers from a pool directive when using the 'nopeer' +# option by default, as documented in the 'ntp.conf' manual. +restrict source notrap nomodify noquery\n")) - (list (shepherd-service - (provision '(ntpd)) - (documentation "Run the Network Time Protocol (NTP) daemon.") - (requirement '(user-processes networking)) - (start #~(make-forkexec-constructor - (list (string-append #$ntp "/bin/ntpd") "-n" - "-c" #$ntpd.conf "-u" "ntpd" - #$@(if allow-large-adjustment? - '("-g") - '())))) - (stop #~(make-kill-destructor)))))))) + (define ntpd.conf + (plain-file "ntpd.conf" config)) + + (list (shepherd-service + (provision '(ntpd)) + (documentation "Run the Network Time Protocol (NTP) daemon.") + (requirement '(user-processes networking)) + (start #~(make-forkexec-constructor + (list (string-append #$ntp "/bin/ntpd") "-n" + "-c" #$ntpd.conf "-u" "ntpd" + #$@(if allow-large-adjustment? + '("-g") + '())))) + (stop #~(make-kill-destructor))))))))) (define %ntp-accounts (list (user-account @@ -354,11 +493,13 @@ restrict -6 ::1\n")) (description "Run the @command{ntpd}, the Network Time Protocol (NTP) daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon -will keep the system clock synchronized with that of the given servers."))) +will keep the system clock synchronized with that of the given servers.") + (default-value (ntp-configuration)))) -(define* (ntp-service #:key (ntp ntp) - (servers %ntp-servers) - allow-large-adjustment?) +(define-deprecated (ntp-service #:key (ntp ntp) + (servers %ntp-servers) + allow-large-adjustment?) + ntp-service-type "Return a service that runs the daemon from @var{ntp}, the @uref{http://www.ntp.org, Network Time Protocol package}. The daemon will keep the system clock synchronized with that of @var{servers}. @@ -375,6 +516,9 @@ make an initial adjustment of more than 1,000 seconds." ;;; OpenNTPD. ;;; +(define %openntpd-servers + (map ntp-server-address %ntp-servers)) + (define-record-type* openntpd-configuration make-openntpd-configuration openntpd-configuration? @@ -388,9 +532,9 @@ make an initial adjustment of more than 1,000 seconds." (sensor openntpd-sensor (default '())) (server openntpd-server - (default %ntp-servers)) - (servers openntpd-servers (default '())) + (servers openntpd-servers + (default %openntpd-servers)) (constraint-from openntpd-constraint-from (default '())) (constraints-from openntpd-constraints-from @@ -398,45 +542,58 @@ make an initial adjustment of more than 1,000 seconds." (allow-large-adjustment? openntpd-allow-large-adjustment? (default #f))) ; upstream default -(define (openntpd-shepherd-service config) +(define (openntpd-configuration->string config) + + (define (quote-field? name) + (member name '("constraints from"))) + (match-record config - (openntpd listen-on query-from sensor server servers constraint-from - constraints-from allow-large-adjustment?) - (let () - (define config - (string-join - (filter-map - (lambda (field value) - (string-join - (map (cut string-append field <> "\n") - value))) - '("listen on " "query from " "sensor " "server " "servers " - "constraint from ") - (list listen-on query-from sensor server servers constraint-from)) - ;; The 'constraints from' field needs to be enclosed in double quotes. - (string-join - (map (cut string-append "constraints from \"" <> "\"\n") - constraints-from)))) - - (define ntpd.conf - (plain-file "ntpd.conf" config)) - - (list (shepherd-service - (provision '(ntpd)) - (documentation "Run the Network Time Protocol (NTP) daemon.") - (requirement '(user-processes networking)) - (start #~(make-forkexec-constructor - (list (string-append #$openntpd "/sbin/ntpd") - "-f" #$ntpd.conf - "-d" ;; don't daemonize - #$@(if allow-large-adjustment? - '("-s") - '())) - ;; When ntpd is daemonized it repeatedly tries to respawn - ;; while running, leading shepherd to disable it. To - ;; prevent spamming stderr, redirect output to logfile. - #:log-file "/var/log/ntpd")) - (stop #~(make-kill-destructor))))))) + (listen-on query-from sensor server servers constraint-from + constraints-from) + (string-append + (string-join + (concatenate + (filter-map (lambda (field values) + (match values + (() #f) ;discard entry with filter-map + ((val ...) ;validate value type + (map (lambda (value) + (if (quote-field? field) + (format #f "~a \"~a\"" field value) + (format #f "~a ~a" field value))) + values)))) + ;; The entry names. + '("listen on" "query from" "sensor" "server" "servers" + "constraint from" "constraints from") + ;; The corresponding entry values. + (list listen-on query-from sensor server servers + constraint-from constraints-from))) + "\n") + "\n"))) ;add a trailing newline + +(define (openntpd-shepherd-service config) + (let ((openntpd (openntpd-configuration-openntpd config)) + (allow-large-adjustment? (openntpd-allow-large-adjustment? config))) + + (define ntpd.conf + (plain-file "ntpd.conf" (openntpd-configuration->string config))) + + (list (shepherd-service + (provision '(ntpd)) + (documentation "Run the Network Time Protocol (NTP) daemon.") + (requirement '(user-processes networking)) + (start #~(make-forkexec-constructor + (list (string-append #$openntpd "/sbin/ntpd") + "-f" #$ntpd.conf + "-d" ;; don't daemonize + #$@(if allow-large-adjustment? + '("-s") + '())) + ;; When ntpd is daemonized it repeatedly tries to respawn + ;; while running, leading shepherd to disable it. To + ;; prevent spamming stderr, redirect output to logfile. + #:log-file "/var/log/ntpd")) + (stop #~(make-kill-destructor)))))) (define (openntpd-service-activation config) "Return the activation gexp for CONFIG." @@ -458,6 +615,8 @@ make an initial adjustment of more than 1,000 seconds." openntpd-shepherd-service) (service-extension account-service-type (const %ntp-accounts)) + (service-extension profile-service-type + (compose list openntpd-configuration-openntpd)) (service-extension activation-service-type openntpd-service-activation))) (default-value (openntpd-configuration)) @@ -567,7 +726,9 @@ demand."))) (config-file tor-configuration-config-file (default (plain-file "empty" ""))) (hidden-services tor-configuration-hidden-services - (default '()))) + (default '())) + (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix + (default 'tcp))) (define %tor-accounts ;; User account and groups for Tor. @@ -589,7 +750,7 @@ demand."))) (define (tor-configuration->torrc config) "Return a 'torrc' file for CONFIG." (match config - (($ tor config-file services) + (($ tor config-file services socks-socket-type) (computed-file "torrc" (with-imported-modules '((guix build utils)) @@ -600,10 +761,15 @@ demand."))) (call-with-output-file #$output (lambda (port) (display "\ -# The beginning was automatically added. +### These lines were generated from your system configuration: User tor DataDirectory /var/lib/tor +PidFile /var/run/tor/tor.pid Log notice syslog\n" port) + (when (eq? 'unix '#$socks-socket-type) + (display "\ +SocksPort unix:/var/run/tor/socks-sock +UnixSocksGroupWritable 1\n" port)) (for-each (match-lambda ((service (ports hosts) ...) @@ -620,6 +786,9 @@ HiddenServicePort ~a ~a~%" (cons name mapping))) services)) + (display "\ +### End of automatically generated lines.\n\n" port) + ;; Append the user's config file. (call-with-input-file #$config-file (lambda (input) @@ -627,7 +796,7 @@ HiddenServicePort ~a ~a~%" #t)))))))) (define (tor-shepherd-service config) - "Return a running TOR." + "Return a running Tor." (match config (($ tor) (let ((torrc (tor-configuration->torrc config))) @@ -653,12 +822,17 @@ HiddenServicePort ~a ~a~%" (writable? #t)) (file-system-mapping (source "/dev/log") ;for syslog - (target source))))) + (target source)) + (file-system-mapping + (source "/var/run/tor") + (target source) + (writable? #t))) + #:pid-file "/var/run/tor/tor.pid")) (stop #~(make-kill-destructor)) (documentation "Run the Tor anonymous network overlay.")))))))) -(define (tor-hidden-service-activation config) - "Return the activation gexp for SERVICES, a list of hidden services." +(define (tor-activation config) + "Set up directories for Tor and its hidden services, if any." #~(begin (use-modules (guix build utils)) @@ -674,6 +848,15 @@ HiddenServicePort ~a ~a~%" ;; The daemon bails out if we give wider permissions. (chmod directory #o700))) + ;; Allow Tor to write its PID file. + (mkdir-p "/var/run/tor") + (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user)) + ;; Set the group permissions to rw so that if the system administrator + ;; has specified UnixSocksGroupWritable=1 in their torrc file, members + ;; of the "tor" group will be able to use the SOCKS socket. + (chmod "/var/run/tor" #o750) + + ;; Allow Tor to access the hidden services' directories. (mkdir-p "/var/lib/tor") (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user)) (chmod "/var/lib/tor" #o700) @@ -693,7 +876,7 @@ HiddenServicePort ~a ~a~%" (service-extension account-service-type (const %tor-accounts)) (service-extension activation-service-type - tor-hidden-service-activation))) + tor-activation))) ;; This can be extended with hidden services. (compose concatenate) @@ -708,9 +891,10 @@ HiddenServicePort ~a ~a~%" "Run the @uref{https://torproject.org, Tor} anonymous networking daemon."))) -(define* (tor-service #:optional - (config-file (plain-file "empty" "")) - #:key (tor tor)) +(define-deprecated (tor-service #:optional + (config-file (plain-file "empty" "")) + #:key (tor tor)) + tor-service-type "Return a service to run the @uref{https://torproject.org, Tor} anonymous networking daemon. @@ -810,6 +994,17 @@ and @command{wicd-curses} user interfaces." (service wicd-service-type wicd)) +;;; +;;; ModemManager +;;; + +(define-record-type* + modem-manager-configuration make-modem-manager-configuration + modem-manager-configuration? + (modem-manager modem-manager-configuration-modem-manager + (default modem-manager))) + + ;;; ;;; NetworkManager ;;; @@ -821,19 +1016,52 @@ and @command{wicd-curses} user interfaces." (default network-manager)) (dns network-manager-configuration-dns (default "default")) - (vpn-plugins network-manager-vpn-plugins ;list of + (vpn-plugins network-manager-configuration-vpn-plugins ;list of (default '()))) -(define %network-manager-activation - ;; Activation gexp for NetworkManager. - #~(begin - (use-modules (guix build utils)) - (mkdir-p "/etc/NetworkManager/system-connections"))) +(define network-manager-activation + ;; Activation gexp for NetworkManager + (match-lambda + (($ network-manager dns vpn-plugins) + #~(begin + (use-modules (guix build utils)) + (mkdir-p "/etc/NetworkManager/system-connections") + #$@(if (equal? dns "dnsmasq") + ;; create directory to store dnsmasq lease file + '((mkdir-p "/var/lib/misc")) + '()))))) (define (vpn-plugin-directory plugins) "Return a directory containing PLUGINS, the NM VPN plugins." (directory-union "network-manager-vpn-plugins" plugins)) +(define (network-manager-accounts config) + "Return the list of and for CONFIG." + (define nologin + (file-append shadow "/sbin/nologin")) + + (define accounts + (append-map (lambda (package) + (map (lambda (name) + (user-account (system? #t) + (name name) + (group "network-manager") + (comment "NetworkManager helper") + (home-directory "/var/empty") + (create-home-directory? #f) + (shell nologin))) + (or (assoc-ref (package-properties package) + 'user-accounts) + '()))) + (network-manager-configuration-vpn-plugins config))) + + (match accounts + (() + '()) + (_ + (cons (user-group (name "network-manager") (system? #t)) + accounts)))) + (define network-manager-environment (match-lambda (($ network-manager dns vpn-plugins) @@ -860,29 +1088,37 @@ and @command{wicd-curses} user interfaces." "--no-daemon") #:environment-variables (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn - "/lib/NetworkManager/VPN")))) + "/lib/NetworkManager/VPN") + ;; Override non-existent default users + "NM_OPENVPN_USER=" + "NM_OPENVPN_GROUP="))) (stop #~(make-kill-destructor)))))))) (define network-manager-service-type (let - ((config->package + ((config->packages (match-lambda - (($ network-manager) - (list network-manager))))) + (($ network-manager _ vpn-plugins) + `(,network-manager ,@vpn-plugins))))) (service-type (name 'network-manager) (extensions (list (service-extension shepherd-root-service-type network-manager-shepherd-service) - (service-extension dbus-root-service-type config->package) - (service-extension polkit-service-type config->package) + (service-extension dbus-root-service-type config->packages) + (service-extension polkit-service-type + (compose + list + network-manager-configuration-network-manager)) + (service-extension account-service-type + network-manager-accounts) (service-extension activation-service-type - (const %network-manager-activation)) + network-manager-activation) (service-extension session-environment-service-type network-manager-environment) ;; Add network-manager to the system profile. - (service-extension profile-service-type config->package))) + (service-extension profile-service-type config->packages))) (default-value (network-manager-configuration)) (description "Run @uref{https://wiki.gnome.org/Projects/NetworkManager, @@ -926,7 +1162,14 @@ wireless networking.")))) (list (string-append #$connman "/sbin/connmand") "-n" "-r" - #$@(if disable-vpn? '("--noplugin=vpn") '())))) + #$@(if disable-vpn? '("--noplugin=vpn") '())) + + ;; As connman(8) notes, when passing '-n', connman + ;; "directs log output to the controlling terminal in + ;; addition to syslog." Redirect stdout and stderr + ;; to avoid spamming the console (XXX: for some reason + ;; redirecting to /dev/null doesn't work.) + #:log-file "/var/log/connman.log")) (stop #~(make-kill-destructor))))))) (define connman-service-type @@ -935,6 +1178,8 @@ wireless networking.")))) (extensions (list (service-extension shepherd-root-service-type connman-shepherd-service) + (service-extension polkit-service-type + connman-package) (service-extension dbus-root-service-type connman-package) (service-extension activation-service-type @@ -942,37 +1187,299 @@ wireless networking.")))) ;; Add connman to the system profile. (service-extension profile-service-type connman-package))) + (default-value (connman-configuration)) (description "Run @url{https://01.org/connman,Connman}, a network connection manager.")))) +;;; +;;; Modem manager +;;; + +(define modem-manager-service-type + (let ((config->package + (match-lambda + (($ 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.")))) + + +;;; +;;; USB_ModeSwitch +;;; + +(define-record-type* + usb-modeswitch-configuration make-usb-modeswitch-configuration + usb-modeswitch-configuration? + (usb-modeswitch usb-modeswitch-configuration-usb-modeswitch + (default usb-modeswitch)) + (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data + (default usb-modeswitch-data)) + (config-file usb-modeswitch-configuration-config-file + (default #~(string-append #$usb-modeswitch:dispatcher + "/etc/usb_modeswitch.conf")))) + +(define (usb-modeswitch-sh usb-modeswitch config-file) + "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH, +modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher, +and wrap it to actually find the dispatcher in USB-MODESWITCH. The script +will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB +device is detected." + (computed-file + "usb_modeswitch-sh" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (let ((cfg-param + #$(if config-file + #~(string-append " --config-file=" #$config-file) + ""))) + (mkdir #$output) + (install-file (string-append #$usb-modeswitch:dispatcher + "/lib/udev/usb_modeswitch") + #$output) + + ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines + (substitute* (string-append #$output "/usb_modeswitch") + (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right) + (string-append left cfg-param right)) + (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right) + (string-append left cfg-param right))) + + ;; wrap-program needs bash in PATH: + (putenv (string-append "PATH=" #$bash "/bin")) + (wrap-program (string-append #$output "/usb_modeswitch") + `("PATH" ":" = (,(string-append #$coreutils "/bin") + ,(string-append + #$usb-modeswitch:dispatcher + "/bin"))))))))) + +(define (usb-modeswitch-configuration->udev-rules config) + "Build a rules file for extending udev-service-type from the rules in the +usb-modeswitch package specified in CONFIG. The rules file will invoke +usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right +config file." + (match config + (($ usb-modeswitch data config-file) + (computed-file + "usb_modeswitch.rules" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (let ((in (string-append #$data "/udev/40-usb_modeswitch.rules")) + (out (string-append #$output "/lib/udev/rules.d")) + (script #$(usb-modeswitch-sh usb-modeswitch config-file))) + (mkdir-p out) + (chdir out) + (install-file in out) + (substitute* "40-usb_modeswitch.rules" + (("PROGRAM=\"usb_modeswitch") + (string-append "PROGRAM=\"" script "/usb_modeswitch")) + (("RUN\\+=\"usb_modeswitch") + (string-append "RUN+=\"" script "/usb_modeswitch")))))))))) + +(define usb-modeswitch-service-type + (service-type + (name 'usb-modeswitch) + (extensions + (list + (service-extension + udev-service-type + (lambda (config) + (let ((rules (usb-modeswitch-configuration->udev-rules config))) + (list rules)))))) + (default-value (usb-modeswitch-configuration)) + (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/, +USB_ModeSwitch}, a mode switching tool for controlling USB devices with +multiple @dfn{modes}. When plugged in for the first time many USB +devices (primarily high-speed WAN modems) act like a flash storage containing +installers for Windows drivers. USB_ModeSwitch replays the sequence the +Windows drivers would send to switch their mode from storage to modem (or +whatever the thing is supposed to do)."))) + + ;;; ;;; WPA supplicant ;;; +(define-record-type* + wpa-supplicant-configuration make-wpa-supplicant-configuration + wpa-supplicant-configuration? + (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ; + (default wpa-supplicant)) + (requirement wpa-supplicant-configuration-requirement ;list of symbols + (default '(user-processes dbus-system loopback syslogd))) + (pid-file wpa-supplicant-configuration-pid-file ;string + (default "/var/run/wpa_supplicant.pid")) + (dbus? wpa-supplicant-configuration-dbus? ;Boolean + (default #t)) + (interface wpa-supplicant-configuration-interface ;#f | string + (default #f)) + (config-file wpa-supplicant-configuration-config-file ;#f | + (default #f)) + (extra-options wpa-supplicant-configuration-extra-options ;list of strings + (default '()))) + +(define wpa-supplicant-shepherd-service + (match-lambda + (($ wpa-supplicant requirement pid-file dbus? + interface config-file extra-options) + (list (shepherd-service + (documentation "Run the WPA supplicant daemon") + (provision '(wpa-supplicant)) + (requirement requirement) + (start #~(make-forkexec-constructor + (list (string-append #$wpa-supplicant + "/sbin/wpa_supplicant") + (string-append "-P" #$pid-file) + "-B" ;run in background + "-s" ;log to syslogd + #$@(if dbus? + #~("-u") + #~()) + #$@(if interface + #~((string-append "-i" #$interface)) + #~()) + #$@(if config-file + #~((string-append "-c" #$config-file)) + #~()) + #$@extra-options) + #:pid-file #$pid-file)) + (stop #~(make-kill-destructor))))))) + +(define wpa-supplicant-service-type + (let ((config->package + (match-lambda + (($ wpa-supplicant) + (list wpa-supplicant))))) + (service-type (name 'wpa-supplicant) + (extensions + (list (service-extension shepherd-root-service-type + wpa-supplicant-shepherd-service) + (service-extension dbus-root-service-type config->package) + (service-extension profile-service-type config->package))) + (description "Run the WPA Supplicant daemon, a service that +implements authentication, key negotiation and more for wireless networks.") + (default-value (wpa-supplicant-configuration))))) + + +;;; +;;; Hostapd. +;;; -(define (wpa-supplicant-shepherd-service wpa-supplicant) - "Return a shepherd service for wpa_supplicant" +(define-record-type* + hostapd-configuration make-hostapd-configuration + hostapd-configuration? + (package hostapd-configuration-package + (default hostapd)) + (interface hostapd-configuration-interface ;string + (default "wlan0")) + (ssid hostapd-configuration-ssid) ;string + (broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean + (default #t)) + (channel hostapd-configuration-channel ;integer + (default 1)) + (driver hostapd-configuration-driver ;string + (default "nl80211")) + ;; See for a list of + ;; additional options we could add. + (extra-settings hostapd-configuration-extra-settings ;string + (default ""))) + +(define (hostapd-configuration-file config) + "Return the configuration file for CONFIG, a ." + (match-record config + (interface ssid broadcast-ssid? channel driver extra-settings) + (plain-file "hostapd.conf" + (string-append "\ +# Generated from your Guix configuration. + +interface=" interface " +ssid=" ssid " +ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") " +channel=" (number->string channel) "\n" +extra-settings "\n")))) + +(define* (hostapd-shepherd-services config #:key (requirement '())) + "Return Shepherd services for hostapd." (list (shepherd-service - (documentation "Run WPA supplicant with dbus interface") - (provision '(wpa-supplicant)) - (requirement '(user-processes dbus-system loopback)) + (provision '(hostapd)) + (requirement `(user-processes ,@requirement)) + (documentation "Run the hostapd WiFi access point daemon.") (start #~(make-forkexec-constructor - (list (string-append #$wpa-supplicant - "/sbin/wpa_supplicant") - "-u" "-B" "-P/var/run/wpa_supplicant.pid") - #:pid-file "/var/run/wpa_supplicant.pid")) + (list #$(file-append hostapd "/sbin/hostapd") + #$(hostapd-configuration-file config)) + #:log-file "/var/log/hostapd.log")) (stop #~(make-kill-destructor))))) -(define wpa-supplicant-service-type - (service-type (name 'wpa-supplicant) - (extensions - (list (service-extension shepherd-root-service-type - wpa-supplicant-shepherd-service) - (service-extension dbus-root-service-type list) - (service-extension profile-service-type list))) - (default-value wpa-supplicant))) +(define hostapd-service-type + (service-type + (name 'hostapd) + (extensions + (list (service-extension shepherd-root-service-type + hostapd-shepherd-services))) + (description + "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access +points and authentication servers."))) + +(define (simulated-wifi-shepherd-services config) + "Return Shepherd services to run hostapd with CONFIG, a +, as well as services to set up WiFi hardware +simulation." + (append (hostapd-shepherd-services config + #:requirement + '(unblocked-wifi + mac-simulation-module)) + (list (shepherd-service + (provision '(unblocked-wifi)) + (requirement '(file-systems mac-simulation-module)) + (documentation + "Unblock WiFi devices for use by mac80211_hwsim.") + (start #~(lambda _ + (invoke #$(file-append util-linux "/sbin/rfkill") + "unblock" "0") + (invoke #$(file-append util-linux "/sbin/rfkill") + "unblock" "1"))) + (one-shot? #t)) + (shepherd-service + (provision '(mac-simulation-module)) + (requirement '(file-systems)) + (modules '((guix build utils))) + (documentation + "Load the mac80211_hwsim Linux kernel module.") + (start (with-imported-modules '((guix build utils)) + #~(lambda _ + ;; XXX: We can't use 'load-linux-module*' here because it + ;; expects a flat module directory. + (setenv "LINUX_MODULE_DIRECTORY" + "/run/booted-system/kernel/lib/modules") + (invoke #$(file-append kmod "/bin/modprobe") + "mac80211_hwsim")))) + (one-shot? #t))))) + +(define simulated-wifi-service-type + (service-type + (name 'simulated-wifi) + (extensions + (list (service-extension shepherd-root-service-type + simulated-wifi-shepherd-services))) + (default-value (hostapd-configuration + (interface "wlan1") + (ssid "Test Network"))) + (description "Run hostapd to simulate WiFi connectivity."))) ;;; @@ -1034,6 +1541,221 @@ a network connection manager.")))) (description "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual switch designed to enable massive network automation through programmatic -extension."))) +extension.") + (default-value (openvswitch-configuration)))) + +;;; +;;; iptables +;;; + +(define %iptables-accept-all-rules + (plain-file "iptables-accept-all.rules" + "*filter +:INPUT ACCEPT +:FORWARD ACCEPT +:OUTPUT ACCEPT +COMMIT +")) + +(define-record-type* + iptables-configuration make-iptables-configuration iptables-configuration? + (iptables iptables-configuration-iptables + (default iptables)) + (ipv4-rules iptables-configuration-ipv4-rules + (default %iptables-accept-all-rules)) + (ipv6-rules iptables-configuration-ipv6-rules + (default %iptables-accept-all-rules))) + +(define iptables-shepherd-service + (match-lambda + (($ iptables ipv4-rules ipv6-rules) + (let ((iptables-restore (file-append iptables "/sbin/iptables-restore")) + (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore"))) + (shepherd-service + (documentation "Packet filtering framework") + (provision '(iptables)) + (start #~(lambda _ + (invoke #$iptables-restore #$ipv4-rules) + (invoke #$ip6tables-restore #$ipv6-rules))) + (stop #~(lambda _ + (invoke #$iptables-restore #$%iptables-accept-all-rules) + (invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))) + +(define iptables-service-type + (service-type + (name 'iptables) + (description + "Run @command{iptables-restore}, setting up the specified rules.") + (extensions + (list (service-extension shepherd-root-service-type + (compose list iptables-shepherd-service)))))) + +;;; +;;; nftables +;;; + +(define %default-nftables-ruleset + (plain-file "nftables.conf" + "# A simple and safe firewall +table inet filter { + chain input { + type filter hook input priority 0; policy drop; + + # early drop of invalid connections + ct state invalid drop + + # allow established/related connections + ct state { established, related } accept + + # allow from loopback + iifname lo accept + + # allow icmp + ip protocol icmp accept + ip6 nexthdr icmpv6 accept + + # allow ssh + tcp dport ssh accept + + # reject everything else + reject with icmpx type port-unreachable + } + chain forward { + type filter hook forward priority 0; policy drop; + } + chain output { + type filter hook output priority 0; policy accept; + } +} +")) + +(define-record-type* + nftables-configuration + make-nftables-configuration + nftables-configuration? + (package nftables-configuration-package + (default nftables)) + (ruleset nftables-configuration-ruleset ; file-like object + (default %default-nftables-ruleset))) + +(define nftables-shepherd-service + (match-lambda + (($ package ruleset) + (let ((nft (file-append package "/sbin/nft"))) + (shepherd-service + (documentation "Packet filtering and classification") + (provision '(nftables)) + (start #~(lambda _ + (invoke #$nft "--file" #$ruleset))) + (stop #~(lambda _ + (invoke #$nft "flush" "ruleset")))))))) + +(define nftables-service-type + (service-type + (name 'nftables) + (description + "Run @command{nft}, setting up the specified ruleset.") + (extensions + (list (service-extension shepherd-root-service-type + (compose list nftables-shepherd-service)) + (service-extension profile-service-type + (compose list nftables-configuration-package)))) + (default-value (nftables-configuration)))) + + +;;; +;;; PageKite +;;; + +(define-record-type* + pagekite-configuration + make-pagekite-configuration + pagekite-configuration? + (package pagekite-configuration-package + (default pagekite)) + (kitename pagekite-configuration-kitename + (default #f)) + (kitesecret pagekite-configuration-kitesecret + (default #f)) + (frontend pagekite-configuration-frontend + (default #f)) + (kites pagekite-configuration-kites + (default '("http:@kitename:localhost:80:@kitesecret"))) + (extra-file pagekite-configuration-extra-file + (default #f))) + +(define (pagekite-configuration-file config) + (match-record config + (package kitename kitesecret frontend kites extra-file) + (mixed-text-file "pagekite.rc" + (if extra-file + (string-append "optfile = " extra-file "\n") + "") + (if kitename + (string-append "kitename = " kitename "\n") + "") + (if kitesecret + (string-append "kitesecret = " kitesecret "\n") + "") + (if frontend + (string-append "frontend = " frontend "\n") + "defaults\n") + (string-join (map (lambda (kite) + (string-append "service_on = " kite)) + kites) + "\n" + 'suffix)))) + +(define (pagekite-shepherd-service config) + (match-record config + (package kitename kitesecret frontend kites extra-file) + (with-imported-modules (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + (shepherd-service + (documentation "Run the PageKite service.") + (provision '(pagekite)) + (requirement '(networking)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start #~(make-forkexec-constructor/container + (list #$(file-append package "/bin/pagekite") + "--clean" + "--nullui" + "--nocrashreport" + "--runas=pagekite:pagekite" + (string-append "--optfile=" + #$(pagekite-configuration-file config))) + #:log-file "/var/log/pagekite.log" + #:mappings #$(if extra-file + #~(list (file-system-mapping + (source #$extra-file) + (target source))) + #~'()))) + ;; SIGTERM doesn't always work for some reason. + (stop #~(make-kill-destructor SIGINT)))))) + +(define %pagekite-accounts + (list (user-group (name "pagekite") (system? #t)) + (user-account + (name "pagekite") + (group "pagekite") + (system? #t) + (comment "PageKite user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define pagekite-service-type + (service-type + (name 'pagekite) + (default-value (pagekite-configuration)) + (extensions + (list (service-extension shepherd-root-service-type + (compose list pagekite-shepherd-service)) + (service-extension account-service-type + (const %pagekite-accounts)))) + (description + "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make +local servers publicly accessible on the web, even behind NATs and firewalls."))) ;;; networking.scm ends here