me/guix
Archived
1
0
Fork 0
Code Activity

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
Show stats Download patch file Download diff file Expand all files Collapse all files

667
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,46 +362,46 @@ 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"))
(list (shepherd-service (list (shepherd-service
;; Allow users to easily run multiple versions simultaneously. ;; Allow users to easily run multiple versions simultaneously.
(provision (list (string->symbol (provision (list (string->symbol
(string-append "dhcpv" version "-daemon")))) (string-append "dhcpv" version "-daemon"))))
(documentation (string-append "Run the DHCPv" version " daemon")) (documentation (string-append "Run the DHCPv" version " daemon"))
(requirement '(networking)) (requirement '(networking))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
'(#$(file-append package "/sbin/dhcpd") '(#$(file-append package "/sbin/dhcpd")
#$(string-append "-" version) #$(string-append "-" version)
"-lf" #$lease-file "-lf" #$lease-file
"-pf" #$pid-file "-pf" #$pid-file
"-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
(unless (file-exists? #$run-directory) (unless (file-exists? #$run-directory)
(mkdir #$run-directory)) (mkdir #$run-directory))
;; According to the DHCP manual (man dhcpd.leases), the lease ;; According to the DHCP manual (man dhcpd.leases), the lease
;; database must be present for dhcpd to start successfully. ;; database must be present for dhcpd to start successfully.
(unless (file-exists? #$lease-file) (unless (file-exists? #$lease-file)
(with-output-to-file #$lease-file (with-output-to-file #$lease-file
(lambda _ (display "")))) (lambda _ (display ""))))
;; Validate the config. ;; Validate the config.
(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,16 +452,16 @@ 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?
(unless (enum-set-member? type ntp-server-types) (unless (enum-set-member? type ntp-server-types)
(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,17 +500,16 @@ 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 (string-append "driftfile /var/run/ntpd/ntp.drift\n"
(string-append "driftfile /var/run/ntpd/ntp.drift\n" (string-join (map ntp-server->string servers)
(string-join (map ntp-server->string servers) "\n")
"\n") "
"
# Disable status queries as a workaround for CVE-2013-5211: # Disable status queries as a workaround for CVE-2013-5211:
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>. # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
restrict default kod nomodify notrap nopeer noquery limited restrict default kod nomodify notrap nopeer noquery limited
@ -522,21 +523,21 @@ restrict -6 ::1
# option by default, as documented in the 'ntp.conf' manual. # option by default, as documented in the 'ntp.conf' manual.
restrict source notrap nomodify noquery\n")) restrict source notrap nomodify noquery\n"))
(define ntpd.conf (define ntpd.conf
(plain-file "ntpd.conf" config)) (plain-file "ntpd.conf" config))
(list (shepherd-service (list (shepherd-service
(provision '(ntpd)) (provision '(ntpd))
(documentation "Run the Network Time Protocol (NTP) daemon.") (documentation "Run the Network Time Protocol (NTP) daemon.")
(requirement '(user-processes networking)) (requirement '(user-processes networking))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$ntp "/bin/ntpd") "-n" (list (string-append #$ntp "/bin/ntpd") "-n"
"-c" #$ntpd.conf "-u" "ntpd" "-c" #$ntpd.conf "-u" "ntpd"
#$@(if allow-large-adjustment? #$@(if allow-large-adjustment?
'("-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,97 +940,94 @@ 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)) #~(begin
#~(begin (use-modules (guix build utils)
(use-modules (guix build utils) (ice-9 match))
(ice-9 match))
(call-with-output-file #$output (call-with-output-file #$output
(lambda (port) (lambda (port)
(display "\ (display "\
### These lines were generated from your system configuration: ### These lines were generated from your system configuration:
DataDirectory /var/lib/tor DataDirectory /var/lib/tor
Log notice syslog\n" port) Log notice syslog\n" port)
(when (eq? 'unix '#$socks-socket-type) (when (eq? 'unix '#$socks-socket-type)
(display "\ (display "\
SocksPort unix:/var/run/tor/socks-sock SocksPort unix:/var/run/tor/socks-sock
UnixSocksGroupWritable 1\n" port)) UnixSocksGroupWritable 1\n" port))
(when #$control-socket? (when #$control-socket?
(display "\ (display "\
ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
ControlSocketsGroupWritable 1\n" ControlSocketsGroupWritable 1\n"
port)) port))
(for-each (match-lambda (for-each (match-lambda
((service (ports hosts) ...) ((service (ports hosts) ...)
(format port "\ (format port "\
HiddenServiceDir /var/lib/tor/hidden-services/~a~%" HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
service) service)
(for-each (lambda (tcp-port host) (for-each (lambda (tcp-port host)
(format port "\ (format port "\
HiddenServicePort ~a ~a~%" HiddenServicePort ~a ~a~%"
tcp-port host)) tcp-port host))
ports hosts))) ports hosts)))
'#$(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)
;; Append the user's config file. ;; Append the user's config file.
(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 (let* ((torrc (tor-configuration->torrc config))
(($ <tor-configuration> tor) (tor (least-authority-wrapper
(let* ((torrc (tor-configuration->torrc config)) (file-append (tor-configuration-tor config) "/bin/tor")
(tor (least-authority-wrapper #:name "tor"
(file-append tor "/bin/tor") #:mappings (list (file-system-mapping
#:name "tor" (source "/var/lib/tor")
#:mappings (list (file-system-mapping (target source)
(source "/var/lib/tor") (writable? #t))
(target source) (file-system-mapping
(writable? #t)) (source "/dev/log") ;for syslog
(file-system-mapping (target source))
(source "/dev/log") ;for syslog (file-system-mapping
(target source)) (source "/var/run/tor")
(file-system-mapping (target source)
(source "/var/run/tor") (writable? #t))
(target source) (file-system-mapping
(writable? #t)) (source torrc)
(file-system-mapping (target source)))
(source torrc) #:namespaces (delq 'net %namespaces))))
(target source))) (list (shepherd-service
#:namespaces (delq 'net %namespaces)))) (provision '(tor))
(list (shepherd-service
(provision '(tor))
;; Tor needs at least one network interface to be up, hence the ;; Tor needs at least one network interface to be up, hence the
;; dependency on 'loopback'. ;; dependency on 'loopback'.
(requirement '(user-processes loopback syslogd)) (requirement '(user-processes loopback syslogd))
;; XXX: #:pid-file won't work because the wrapped 'tor' ;; XXX: #:pid-file won't work because the wrapped 'tor'
;; program would print its PID within the user namespace ;; program would print its PID within the user namespace
;; instead of its actual PID outside. There's no inetd or ;; instead of its actual PID outside. There's no inetd or
;; systemd socket activation support either (there's ;; systemd socket activation support either (there's
;; 'sd_notify' though), so we're stuck with that. ;; 'sd_notify' though), so we're stuck with that.
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$tor "-f" #$torrc) (list #$tor "-f" #$torrc)
#: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,47 +1188,47 @@ 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"
(if iwd? "[device]\nwifi.backend=iwd\n" "")))) (if iwd? "[device]\nwifi.backend=iwd\n" ""))))
(vpn (vpn-plugin-directory vpn-plugins))) (vpn (vpn-plugin-directory vpn-plugins)))
(list (shepherd-service (list (shepherd-service
(documentation "Run the NetworkManager.") (documentation "Run the NetworkManager.")
(provision '(networking)) (provision '(networking))
(requirement (append '(user-processes dbus-system loopback) (requirement (append '(user-processes dbus-system loopback)
(if iwd? '(iwd) '(wpa-supplicant)))) (if iwd? '(iwd) '(wpa-supplicant))))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$network-manager (list (string-append #$network-manager
"/sbin/NetworkManager") "/sbin/NetworkManager")
(string-append "--config=" #$conf) (string-append "--config=" #$conf)
"--no-daemon") "--no-daemon")
#:environment-variables #:environment-variables
(list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
"/lib/NetworkManager/VPN") "/lib/NetworkManager/VPN")
;; 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
(name 'network-manager) (name 'network-manager)
@ -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,24 +1407,25 @@ 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
(out (string-append #$output "/lib/udev/rules.d")) "/udev/40-usb_modeswitch.rules"))
(script #$(usb-modeswitch-sh usb-modeswitch config-file))) (out (string-append #$output "/lib/udev/rules.d"))
(mkdir-p out) (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
(chdir out) (mkdir-p out)
(install-file in out) (chdir out)
(substitute* "40-usb_modeswitch.rules" (install-file in out)
(("PROGRAM=\"usb_modeswitch") (substitute* "40-usb_modeswitch.rules"
(string-append "PROGRAM=\"" script "/usb_modeswitch")) (("PROGRAM=\"usb_modeswitch")
(("RUN\\+=\"usb_modeswitch") (string-append "PROGRAM=\"" script "/usb_modeswitch"))
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))) (("RUN\\+=\"usb_modeswitch")
(string-append "RUN+=\"" script "/usb_modeswitch")))))))))
(define usb-modeswitch-service-type (define usb-modeswitch-service-type
(service-type (service-type
@ -1471,40 +1469,39 @@ 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")
(provision '(wpa-supplicant)) (provision '(wpa-supplicant))
(requirement (if dbus? (requirement (if dbus?
(cons 'dbus-system requirement) (cons 'dbus-system requirement)
requirement)) requirement))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list (string-append #$wpa-supplicant (list (string-append #$wpa-supplicant
"/sbin/wpa_supplicant") "/sbin/wpa_supplicant")
(string-append "-P" #$pid-file) (string-append "-P" #$pid-file)
"-B" ;run in background "-B" ;run in background
"-s" ;log to syslogd "-s" ;log to syslogd
#$@(if dbus? #$@(if dbus?
#~("-u") #~("-u")
#~()) #~())
#$@(if interface #$@(if interface
#~((string-append "-i" #$interface)) #~((string-append "-i" #$interface))
#~()) #~())
#$@(if config-file #$@(if config-file
#~((string-append "-c" #$config-file)) #~((string-append "-c" #$config-file))
#~()) #~())
#$@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,41 +1623,38 @@ 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)) (mkdir-p "/var/run/openvswitch")
(mkdir-p "/var/run/openvswitch") (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 (shepherd-service
(list (provision '(ovsdb))
(shepherd-service (documentation "Run the Open vSwitch database server.")
(provision '(ovsdb)) (start #~(make-forkexec-constructor
(documentation "Run the Open vSwitch database server.") (list #$ovsdb-server "--pidfile"
(start #~(make-forkexec-constructor "--remote=punix:/var/run/openvswitch/db.sock")
(list #$ovsdb-server "--pidfile" #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
"--remote=punix:/var/run/openvswitch/db.sock") (stop #~(make-kill-destructor)))
#:pid-file "/var/run/openvswitch/ovsdb-server.pid")) (shepherd-service
(stop #~(make-kill-destructor))) (provision '(vswitchd))
(shepherd-service (requirement '(ovsdb))
(provision '(vswitchd)) (documentation "Run the Open vSwitch daemon.")
(requirement '(ovsdb)) (start #~(make-forkexec-constructor
(documentation "Run the Open vSwitch daemon.") (list #$ovs-vswitchd "--pidfile")
(start #~(make-forkexec-constructor #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(list #$ovs-vswitchd "--pidfile") (stop #~(make-kill-destructor))))))
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
(stop #~(make-kill-destructor))))))))
(define openvswitch-service-type (define openvswitch-service-type
(service-type (service-type
@ -1700,20 +1694,20 @@ 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
(documentation "Packet filtering framework") (documentation "Packet filtering framework")
(provision '(iptables)) (provision '(iptables))
(start #~(lambda _ (start #~(lambda _
(invoke #$iptables-restore #$ipv4-rules) (invoke #$iptables-restore #$ipv4-rules)
(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,17 +1766,17 @@ 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")
(provision '(nftables)) (provision '(nftables))
(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,23 +2149,22 @@ 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)) (start #~(make-forkexec-constructor
(start #~(make-forkexec-constructor (list (string-append #$keepalived "/sbin/keepalived")
(list (string-append #$keepalived "/sbin/keepalived") "--dont-fork" "--log-console" "--log-detail"
"--dont-fork" "--log-console" "--log-detail" "--pid=/var/run/keepalived.pid"
"--pid=/var/run/keepalived.pid" (string-append "--use-file=" #$config-file))
(string-append "--use-file=" #$config-file)) #: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