;;; 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 © 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 (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)
usb-modeswitch-configuration-usb-modeswitch-data
usb-modeswitch-service-type
- <wpa-supplicant-configuration>
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
nftables-configuration?
nftables-configuration-package
nftables-configuration-ruleset
- %default-nftables-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)))))
+ (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
;;;
(res '()))
(if (list? x)
(fold loop res x)
- (cons (format #f "~s" x) res)))))
+ (cons (format #f "~a" x) res)))))
(match ntp-server
(($ <ntp-server> type address options)
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 ntp-server->string 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 limited
# option by default, as documented in the 'ntp.conf' manual.
restrict source notrap nomodify noquery\n"))
- (define ntpd.conf
- (plain-file "ntpd.conf" config))
+ (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))))))))
+ (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
"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)
(compose
list
network-manager-configuration-network-manager))
+ (service-extension account-service-type
+ network-manager-accounts)
(service-extension activation-service-type
network-manager-activation)
(service-extension session-environment-service-type
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
;;;
(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