amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: networking: Avoid 'match' on records.

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