;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;;
;;; This file is part of GNU Guix.
;;;
(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)
#: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)
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
network-manager-configuration
network-manager-configuration?
network-manager-configuration-dns
+ network-manager-configuration-vpn-plugins
network-manager-service-type
connman-configuration
modem-manager-configuration?
modem-manager-service-type
- <wpa-supplicant-configuration>
+ 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-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
iptables-configuration-iptables
iptables-configuration-ipv4-rules
iptables-configuration-ipv6-rules
- iptables-service-type))
+ 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:
;;;
(define valid?
(lambda (interface)
(and (arp-network-interface? interface)
- (not (loopback-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"
(with-output-to-file #$lease-file
(lambda _ (display ""))))
;; Validate the config.
- (invoke
+ (invoke/quiet
#$(file-append package "/sbin/dhcpd") "-t" "-cf"
#$config-file))))))
(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
- ;; 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.")))
\f
;;;
;;; NTP.
;;;
-;; TODO: Export.
+(define ntp-server-types (make-enumeration
+ '(pool
+ server
+ peer
+ broadcast
+ manycastclient)))
+
+(define-record-type* <ntp-server>
+ 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
+ (($ <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 <leo@famulari.name> 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>
ntp-configuration make-ntp-configuration
ntp-configuration?
(ntp ntp-configuration-ntp
(default ntp))
- (servers ntp-configuration-servers
+ (servers %ntp-configuration-servers ;list of <ntp-server> 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 <ntp-server> records instead.\n")
+ (map (lambda (addr)
+ (ntp-server
+ (type 'server)
+ (address addr)
+ (options '()))) ntp-servers))
+ ((($ <ntp-server>) ($ <ntp-server>) ...)
+ ntp-servers))))
(define ntp-shepherd-service
- (match-lambda
- (($ <ntp-configuration> 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-configuration> 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:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
-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
;;; OpenNTPD.
;;;
+(define %openntpd-servers
+ (map ntp-server-address %ntp-servers))
+
(define-record-type* <openntpd-configuration>
openntpd-configuration make-openntpd-configuration
openntpd-configuration?
(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
(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-configuration>
- (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."
(default network-manager))
(dns network-manager-configuration-dns
(default "default"))
- (vpn-plugins network-manager-
vpn-plugins ;list of <package>
+ (vpn-plugins network-manager-
configuration-vpn-plugins ;list of <package>
(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-configuration> 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 <user-account> and <user-group> 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-configuration> network-manager dns vpn-plugins)
"--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-configuration> network-manager)
- (list network-manager)))))
+ (($ <network-manager-configuration> 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,
networking."))))
\f
+;;;
+;;; USB_ModeSwitch
+;;;
+
+(define-record-type* <usb-modeswitch-configuration>
+ 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-configuration> 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).")))
+
+\f
;;;
;;; WPA supplicant
;;;
wpa-supplicant-configuration?
(wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;<package>
(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
(define wpa-supplicant-shepherd-service
(match-lambda
- (($ <wpa-supplicant-configuration> wpa-supplicant pid-file dbus? interface
- config-file extra-options)
+ (($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
+ interface config-file extra-options)
(list (shepherd-service
(documentation "Run the WPA supplicant daemon")
(provision '(wpa-supplicant))
- (requirement '(user-processes dbus-system loopback syslogd))
+ (requirement requirement)
(start #~(make-forkexec-constructor
(list (string-append #$wpa-supplicant
"/sbin/wpa_supplicant")
(default-value (wpa-supplicant-configuration)))))
\f
+;;;
+;;; Hostapd.
+;;;
+
+(define-record-type* <hostapd-configuration>
+ 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 <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> 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 <hostapd-configuration>."
+ (match-record config <hostapd-configuration>
+ (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
+ (provision '(hostapd))
+ (requirement `(user-processes ,@requirement))
+ (documentation "Run the hostapd WiFi access point daemon.")
+ (start #~(make-forkexec-constructor
+ (list #$(file-append hostapd "/sbin/hostapd")
+ #$(hostapd-configuration-file config))
+ #:log-file "/var/log/hostapd.log"))
+ (stop #~(make-kill-destructor)))))
+
+(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
+<hostapd-configuration>, 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.")))
+
+\f
;;;
;;; Open vSwitch
;;;
(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>
+ 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
+ (($ <nftables-configuration> 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))))
+
+\f
+;;;
+;;; PageKite
+;;;
+
+(define-record-type* <pagekite-configuration>
+ 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 <pagekite-configuration>
+ (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 <pagekite-configuration>
+ (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
HCoop / jackhill / guix / guix.git / blobdiff