me
/
guix
Archived
1
0
Fork 0
Code

services: networking: Avoid 'match' on records. 

* gnu/services/networking.scm (dhcp-client-shepherd-service): Use
accessors instead of 'match'.
(inetd-shepherd-service): Likewise.
(tor-shepherd-service): Likewise.
(network-manager-service-type): Likewise.
(modem-manager-service-type): Likewise.
(wpa-supplicant-service-type): Likewise.
(openvswitch-activation): Likewise.
(openvswitch-shepherd-service): Likewise.
(dhcpd-shepherd-service): Use 'match-record' instead of 'match'.
(dhcpd-activation): Likewise.
(ntp-server->string): Likewise.
(ntp-shepherd-service): Likewise.
(tor-configuration->torrc): Likewise.
(network-manager-activation): Likewise.
(network-manager-environment): Likewise.
(network-manager-shepherd-service): Likewise.
(usb-modeswitch-configuration->udev-rules): Likewise.
(wpa-supplicant-shepherd-service): Likewise.
(iptables-shepherd-service): Likewise.
(nftables-shepherd-service): Likewise.
(keepalived-shepherd-service): Likewise.
master
Ludovic Courtès 2022-11-19 22:34:13 +01:00
parent adfe1064c8
commit 00ddf185e6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 330 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

173
gnu/services/networking.scm
View File

@ -278,8 +278,10 @@ fe80::1%lo0 apps.facebook.com\n")
(define dhcp-client-shepherd-service
(match-lambda
(($ <dhcp-client-configuration> package interfaces)
(let ((pid-file "/var/run/dhclient.pid"))
((? dhcp-client-configuration? config)
(let ((package (dhcp-client-configuration-package config))
(interfaces (dhcp-client-configuration-interfaces config))
(pid-file "/var/run/dhclient.pid"))
(list (shepherd-service
(documentation "Set up networking via DHCP.")
(requirement '(user-processes udev))
@ -360,9 +362,9 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
(interfaces dhcpd-configuration-interfaces
(default '())))
(define dhcpd-shepherd-service
(match-lambda
(($ <dhcpd-configuration> package config-file version run-directory
(define (dhcpd-shepherd-service config)
(match-record config <dhcpd-configuration>
(package config-file version run-directory
lease-file pid-file interfaces)
(unless config-file
(error "Must supply a config-file"))
@ -380,11 +382,11 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
"-cf" #$config-file
#$@interfaces)
#:pid-file #$pid-file))
(stop #~(make-kill-destructor)))))))
(stop #~(make-kill-destructor))))))
(define dhcpd-activation
(match-lambda
(($ <dhcpd-configuration> package config-file version run-directory
(define (dhcpd-activation config)
(match-record config <dhcpd-configuration>
(package config-file version run-directory
lease-file pid-file interfaces)
(with-imported-modules '((guix build utils))
#~(begin
@ -399,7 +401,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces.")))
(invoke/quiet
#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version)
"-t" "-cf" #$config-file))))))
"-t" "-cf" #$config-file)))))
(define dhcpd-service-type
(service-type
@ -450,8 +452,8 @@ daemon is responsible for allocating IP addresses to its client.")))
(fold loop res x)
(cons (format #f "~a" x) res)))))
(match ntp-server
(($ <ntp-server> type address options)
(match-record 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?
@ -459,7 +461,7 @@ daemon is responsible for allocating IP addresses to its client.")))
(error "Invalid NTP server type" type))
(string-join (cons* (symbol->string type)
address
(flatten options))))))
(flatten options)))))
(define %ntp-servers
;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
@ -498,10 +500,9 @@ deprecated. Please use <ntp-server> records instead.\n")
((($ <ntp-server>) ($ <ntp-server>) ...)
ntp-servers))))
(define ntp-shepherd-service
(lambda (config)
(match config
(($ <ntp-configuration> ntp servers allow-large-adjustment?)
(define (ntp-shepherd-service config)
(match-record config <ntp-configuration>
(ntp servers allow-large-adjustment?)
(let ((servers (ntp-configuration-servers config)))
;; TODO: Add authentication support.
(define config
@ -536,7 +537,7 @@ restrict source notrap nomodify noquery\n"))
'("-g")
'()))
#:log-file "/var/log/ntpd.log"))
(stop #~(make-kill-destructor)))))))))
(stop #~(make-kill-destructor)))))))
(define %ntp-accounts
(list (user-account
@ -743,19 +744,19 @@ daemon will keep the system clock synchronized with that of the given servers.")
" ") "\n")))
entries)))
(define inetd-shepherd-service
(match-lambda
(($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
(($ <inetd-configuration> program entries)
(list
(shepherd-service
(define (inetd-shepherd-service config)
(let ((entries (inetd-configuration-entries config)))
(if (null? entries)
'() ;do nothing
(let ((program (inetd-configuration-program config)))
(list (shepherd-service
(documentation "Run inetd.")
(provision '(inetd))
(requirement '(user-processes networking syslogd))
(start #~(make-forkexec-constructor
(list #$program #$(inetd-config-file entries))
#:pid-file "/var/run/inetd.pid"))
(stop #~(make-kill-destructor)))))))
(stop #~(make-kill-destructor))))))))
(define-public inetd-service-type
(service-type
@ -939,9 +940,8 @@ applications in communication. It is used by Jami, for example.")))
(define (tor-configuration->torrc config)
"Return a 'torrc' file for CONFIG."
(match config
(($ <tor-configuration> tor config-file services
socks-socket-type control-socket?)
(match-record config <tor-configuration>
(tor config-file hidden-services socks-socket-type control-socket?)
(computed-file
"torrc"
(with-imported-modules '((guix build utils))
@ -978,7 +978,7 @@ HiddenServicePort ~a ~a~%"
'#$(map (match-lambda
(($ <hidden-service> name mapping)
(cons name mapping)))
services))
hidden-services))
(display "\
### End of automatically generated lines.\n\n" port)
@ -987,15 +987,13 @@ HiddenServicePort ~a ~a~%"
(call-with-input-file #$config-file
(lambda (input)
(dump-port input port)))
#t))))))))
#t)))))))
(define (tor-shepherd-service config)
"Return a <shepherd-service> running Tor."
(match config
(($ <tor-configuration> tor)
(let* ((torrc (tor-configuration->torrc config))
(tor (least-authority-wrapper
(file-append tor "/bin/tor")
(file-append (tor-configuration-tor config) "/bin/tor")
#:name "tor"
#:mappings (list (file-system-mapping
(source "/var/lib/tor")
@ -1029,7 +1027,7 @@ HiddenServicePort ~a ~a~%"
#:user "tor" #:group "tor"))
(stop #~(make-kill-destructor))
(actions (list (shepherd-configuration-action torrc)))
(documentation "Run the Tor anonymous network overlay.")))))))
(documentation "Run the Tor anonymous network overlay.")))))
(define (tor-activation config)
"Set up directories for Tor and its hidden services, if any."
@ -1147,17 +1145,17 @@ project's documentation} for more information."
(default '()))
(iwd? network-manager-configuration-iwd? (default #f)))
(define network-manager-activation
(define (network-manager-activation config)
;; Activation gexp for NetworkManager
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins)
(match-record config <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."
@ -1190,18 +1188,18 @@ project's documentation} for more information."
(cons (user-group (name "network-manager") (system? #t))
accounts))))
(define network-manager-environment
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins)
(define (network-manager-environment config)
(match-record config <network-manager-configuration>
(network-manager dns vpn-plugins)
;; Define this variable in the global environment such that
;; "nmcli connection import type openvpn file foo.ovpn" works.
`(("NM_VPN_PLUGIN_DIR"
. ,(file-append (vpn-plugin-directory vpn-plugins)
"/lib/NetworkManager/VPN"))))))
"/lib/NetworkManager/VPN")))))
(define network-manager-shepherd-service
(match-lambda
(($ <network-manager-configuration> network-manager dns vpn-plugins iwd?)
(define (network-manager-shepherd-service config)
(match-record config <network-manager-configuration>
(network-manager dns vpn-plugins iwd?)
(let ((conf (plain-file "NetworkManager.conf"
(string-append
"[main]\ndns=" dns "\n"
@ -1223,13 +1221,13 @@ project's documentation} for more information."
;; Override non-existent default users
"NM_OPENVPN_USER="
"NM_OPENVPN_GROUP=")))
(stop #~(make-kill-destructor))))))))
(stop #~(make-kill-destructor)))))))
(define network-manager-service-type
(let
((config->packages
(match-lambda
(($ <network-manager-configuration> network-manager _ vpn-plugins)
(let ((config->packages
(lambda (config)
(match-record config <network-manager-configuration>
(network-manager vpn-plugins)
`(,network-manager ,@vpn-plugins)))))
(service-type
@ -1337,9 +1335,8 @@ a network connection manager."))))
(define modem-manager-service-type
(let ((config->package
(match-lambda
(($ <modem-manager-configuration> modem-manager)
(list modem-manager)))))
(lambda (config)
(list (modem-manager-configuration-modem-manager config)))))
(service-type (name 'modem-manager)
(extensions
(list (service-extension dbus-root-service-type
@ -1410,14 +1407,15 @@ device is detected."
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)
(match-record config <usb-modeswitch-configuration>
(usb-modeswitch 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"))
(let ((in (string-append #$usb-modeswitch-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)
@ -1427,7 +1425,7 @@ config file."
(("PROGRAM=\"usb_modeswitch")
(string-append "PROGRAM=\"" script "/usb_modeswitch"))
(("RUN\\+=\"usb_modeswitch")
(string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))
(define usb-modeswitch-service-type
(service-type
@ -1471,9 +1469,9 @@ whatever the thing is supposed to do).")))
(extra-options wpa-supplicant-configuration-extra-options ;list of strings
(default '())))
(define wpa-supplicant-shepherd-service
(match-lambda
(($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
(define (wpa-supplicant-shepherd-service config)
(match-record config <wpa-supplicant-configuration>
(wpa-supplicant requirement pid-file dbus?
interface config-file extra-options)
(list (shepherd-service
(documentation "Run the WPA supplicant daemon")
@ -1498,13 +1496,12 @@ whatever the thing is supposed to do).")))
#~())
#$@extra-options)
#:pid-file #$pid-file))
(stop #~(make-kill-destructor)))))))
(stop #~(make-kill-destructor))))))
(define wpa-supplicant-service-type
(let ((config->package
(match-lambda
(($ <wpa-supplicant-configuration> wpa-supplicant)
(list wpa-supplicant)))))
(lambda (config)
(list (wpa-supplicant-configuration-wpa-supplicant config)))))
(service-type (name 'wpa-supplicant)
(extensions
(list (service-extension shepherd-root-service-type
@ -1626,10 +1623,9 @@ simulation."
(package openvswitch-configuration-package
(default openvswitch)))
(define openvswitch-activation
(match-lambda
(($ <openvswitch-configuration> package)
(let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
(define (openvswitch-activation config)
(let ((ovsdb-tool (file-append (openvswitch-configuration-package config)
"/bin/ovsdb-tool")))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@ -1637,15 +1633,13 @@ simulation."
(mkdir-p "/var/lib/openvswitch")
(let ((conf.db "/var/lib/openvswitch/conf.db"))
(unless (file-exists? conf.db)
(system* #$ovsdb-tool "create" conf.db)))))))))
(system* #$ovsdb-tool "create" conf.db)))))))
(define openvswitch-shepherd-service
(match-lambda
(($ <openvswitch-configuration> package)
(let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
(define (openvswitch-shepherd-service config)
(let* ((package (openvswitch-configuration-package config))
(ovsdb-server (file-append package "/sbin/ovsdb-server"))
(ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
(list
(shepherd-service
(list (shepherd-service
(provision '(ovsdb))
(documentation "Run the Open vSwitch database server.")
(start #~(make-forkexec-constructor
@ -1660,7 +1654,7 @@ simulation."
(start #~(make-forkexec-constructor
(list #$ovs-vswitchd "--pidfile")
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(stop #~(make-kill-destructor))))))))
(stop #~(make-kill-destructor))))))
(define openvswitch-service-type
(service-type
@ -1700,9 +1694,9 @@ COMMIT
(ipv6-rules iptables-configuration-ipv6-rules
(default %iptables-accept-all-rules)))
(define iptables-shepherd-service
(match-lambda
(($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
(define (iptables-shepherd-service config)
(match-record config <iptables-configuration>
(iptables ipv4-rules ipv6-rules)
(let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
(ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
(shepherd-service
@ -1713,7 +1707,7 @@ COMMIT
(invoke #$ip6tables-restore #$ipv6-rules)))
(stop #~(lambda _
(invoke #$iptables-restore #$%iptables-accept-all-rules)
(invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
(invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))
(define iptables-service-type
(service-type
@ -1772,9 +1766,9 @@ table inet filter {
(ruleset nftables-configuration-ruleset ; file-like object
(default %default-nftables-ruleset)))
(define nftables-shepherd-service
(match-lambda
(($ <nftables-configuration> package ruleset)
(define (nftables-shepherd-service config)
(match-record config <nftables-configuration>
(package ruleset)
(let ((nft (file-append package "/sbin/nft")))
(shepherd-service
(documentation "Packet filtering and classification")
@ -1782,7 +1776,7 @@ table inet filter {
(start #~(lambda _
(invoke #$nft "--file" #$ruleset)))
(stop #~(lambda _
(invoke #$nft "flush" "ruleset"))))))))
(invoke #$nft "flush" "ruleset")))))))
(define nftables-service-type
(service-type
@ -2155,11 +2149,10 @@ of the IPFS peer-to-peer storage network.")))
(config-file keepalived-configuration-config-file ;file-like
(default #f)))
(define keepalived-shepherd-service
(match-lambda
(($ <keepalived-configuration> keepalived config-file)
(list
(shepherd-service
(define (keepalived-shepherd-service config)
(match-record config <keepalived-configuration>
(keepalived config-file)
(list (shepherd-service
(provision '(keepalived))
(documentation "Run keepalived.")
(requirement '(loopback))
@ -2171,7 +2164,7 @@ of the IPFS peer-to-peer storage network.")))
#:pid-file "/var/run/keepalived.pid"
#:log-file "/var/log/keepalived.log"))
(respawn? #f)
(stop #~(make-kill-destructor)))))))
(stop #~(make-kill-destructor))))))
(define %keepalived-log-rotation
(list (log-rotation