[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
08/08: services: networking: Avoid 'match' on records.
|
From: |
guix-commits |
|
Subject: |
08/08: services: networking: Avoid 'match' on records. |
|
Date: |
Thu, 1 Dec 2022 18:05:50 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 00ddf185e6d1640e014284465373f4d25c6aafd2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Nov 19 22:34:13 2022 +0100
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.
---
gnu/services/networking.scm | 683 ++++++++++++++++++++++----------------------
1 file changed, 338 insertions(+), 345 deletions(-)
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index a2ead9ef11..702404bc6c 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -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,46 +362,46 @@ 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
- lease-file pid-file interfaces)
- (unless config-file
- (error "Must supply a config-file"))
- (list (shepherd-service
- ;; Allow users to easily run multiple versions simultaneously.
- (provision (list (string->symbol
- (string-append "dhcpv" version "-daemon"))))
- (documentation (string-append "Run the DHCPv" version " daemon"))
- (requirement '(networking))
- (start #~(make-forkexec-constructor
- '(#$(file-append package "/sbin/dhcpd")
- #$(string-append "-" version)
- "-lf" #$lease-file
- "-pf" #$pid-file
- "-cf" #$config-file
- #$@interfaces)
- #:pid-file #$pid-file))
- (stop #~(make-kill-destructor)))))))
-
-(define dhcpd-activation
- (match-lambda
- (($ <dhcpd-configuration> package config-file version run-directory
- lease-file pid-file interfaces)
- (with-imported-modules '((guix build utils))
- #~(begin
- (unless (file-exists? #$run-directory)
- (mkdir #$run-directory))
- ;; According to the DHCP manual (man dhcpd.leases), the lease
- ;; database must be present for dhcpd to start successfully.
- (unless (file-exists? #$lease-file)
- (with-output-to-file #$lease-file
- (lambda _ (display ""))))
- ;; Validate the config.
- (invoke/quiet
- #$(file-append package "/sbin/dhcpd")
- #$(string-append "-" version)
- "-t" "-cf" #$config-file))))))
+(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"))
+ (list (shepherd-service
+ ;; Allow users to easily run multiple versions simultaneously.
+ (provision (list (string->symbol
+ (string-append "dhcpv" version "-daemon"))))
+ (documentation (string-append "Run the DHCPv" version " daemon"))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ '(#$(file-append package "/sbin/dhcpd")
+ #$(string-append "-" version)
+ "-lf" #$lease-file
+ "-pf" #$pid-file
+ "-cf" #$config-file
+ #$@interfaces)
+ #:pid-file #$pid-file))
+ (stop #~(make-kill-destructor))))))
+
+(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
+ (unless (file-exists? #$run-directory)
+ (mkdir #$run-directory))
+ ;; According to the DHCP manual (man dhcpd.leases), the lease
+ ;; database must be present for dhcpd to start successfully.
+ (unless (file-exists? #$lease-file)
+ (with-output-to-file #$lease-file
+ (lambda _ (display ""))))
+ ;; Validate the config.
+ (invoke/quiet
+ #$(file-append package "/sbin/dhcpd")
+ #$(string-append "-" version)
+ "-t" "-cf" #$config-file)))))
(define dhcpd-service-type
(service-type
@@ -450,16 +452,16 @@ 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)
- ;; 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))))))
+ (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?
+ (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.
@@ -498,17 +500,16 @@ 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?)
- (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")
- "
+(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
+ (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
@@ -522,21 +523,21 @@ restrict -6 ::1
# option by default, as documented in the 'ntp.conf' manual.
restrict source notrap nomodify noquery\n"))
- (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")
- '()))
- #:log-file "/var/log/ntpd.log"))
- (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")
+ '()))
+ #:log-file "/var/log/ntpd.log"))
+ (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
- (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)))))))
+(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))))))))
(define-public inetd-service-type
(service-type
@@ -939,97 +940,94 @@ 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?)
- (computed-file
- "torrc"
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 match))
-
- (call-with-output-file #$output
- (lambda (port)
- (display "\
+ (match-record config <tor-configuration>
+ (tor config-file hidden-services socks-socket-type control-socket?)
+ (computed-file
+ "torrc"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (call-with-output-file #$output
+ (lambda (port)
+ (display "\
### These lines were generated from your system configuration:
DataDirectory /var/lib/tor
Log notice syslog\n" port)
- (when (eq? 'unix '#$socks-socket-type)
- (display "\
+ (when (eq? 'unix '#$socks-socket-type)
+ (display "\
SocksPort unix:/var/run/tor/socks-sock
UnixSocksGroupWritable 1\n" port))
- (when #$control-socket?
- (display "\
+ (when #$control-socket?
+ (display "\
ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
ControlSocketsGroupWritable 1\n"
- port))
+ port))
- (for-each (match-lambda
- ((service (ports hosts) ...)
- (format port "\
+ (for-each (match-lambda
+ ((service (ports hosts) ...)
+ (format port "\
HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
- service)
- (for-each (lambda (tcp-port host)
- (format port "\
+ service)
+ (for-each (lambda (tcp-port host)
+ (format port "\
HiddenServicePort ~a ~a~%"
- tcp-port host))
- ports hosts)))
- '#$(map (match-lambda
- (($ <hidden-service> name mapping)
- (cons name mapping)))
- services))
-
- (display "\
+ tcp-port host))
+ ports hosts)))
+ '#$(map (match-lambda
+ (($ <hidden-service> name mapping)
+ (cons name mapping)))
+ hidden-services))
+
+ (display "\
### End of automatically generated lines.\n\n" port)
- ;; Append the user's config file.
- (call-with-input-file #$config-file
- (lambda (input)
- (dump-port input port)))
- #t))))))))
+ ;; Append the user's config file.
+ (call-with-input-file #$config-file
+ (lambda (input)
+ (dump-port input port)))
+ #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")
- #:name "tor"
- #:mappings (list (file-system-mapping
- (source "/var/lib/tor")
- (target source)
- (writable? #t))
- (file-system-mapping
- (source "/dev/log") ;for syslog
- (target source))
- (file-system-mapping
- (source "/var/run/tor")
- (target source)
- (writable? #t))
- (file-system-mapping
- (source torrc)
- (target source)))
- #:namespaces (delq 'net %namespaces))))
- (list (shepherd-service
- (provision '(tor))
-
- ;; Tor needs at least one network interface to be up, hence the
- ;; dependency on 'loopback'.
- (requirement '(user-processes loopback syslogd))
-
- ;; XXX: #:pid-file won't work because the wrapped 'tor'
- ;; program would print its PID within the user namespace
- ;; instead of its actual PID outside. There's no inetd or
- ;; systemd socket activation support either (there's
- ;; 'sd_notify' though), so we're stuck with that.
- (start #~(make-forkexec-constructor
- (list #$tor "-f" #$torrc)
- #:user "tor" #:group "tor"))
- (stop #~(make-kill-destructor))
- (actions (list (shepherd-configuration-action torrc)))
- (documentation "Run the Tor anonymous network overlay.")))))))
+ (let* ((torrc (tor-configuration->torrc config))
+ (tor (least-authority-wrapper
+ (file-append (tor-configuration-tor config) "/bin/tor")
+ #:name "tor"
+ #:mappings (list (file-system-mapping
+ (source "/var/lib/tor")
+ (target source)
+ (writable? #t))
+ (file-system-mapping
+ (source "/dev/log") ;for syslog
+ (target source))
+ (file-system-mapping
+ (source "/var/run/tor")
+ (target source)
+ (writable? #t))
+ (file-system-mapping
+ (source torrc)
+ (target source)))
+ #:namespaces (delq 'net %namespaces))))
+ (list (shepherd-service
+ (provision '(tor))
+
+ ;; Tor needs at least one network interface to be up, hence the
+ ;; dependency on 'loopback'.
+ (requirement '(user-processes loopback syslogd))
+
+ ;; XXX: #:pid-file won't work because the wrapped 'tor'
+ ;; program would print its PID within the user namespace
+ ;; instead of its actual PID outside. There's no inetd or
+ ;; systemd socket activation support either (there's
+ ;; 'sd_notify' though), so we're stuck with that.
+ (start #~(make-forkexec-constructor
+ (list #$tor "-f" #$torrc)
+ #:user "tor" #:group "tor"))
+ (stop #~(make-kill-destructor))
+ (actions (list (shepherd-configuration-action torrc)))
+ (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)
- #~(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"))
- '())))))
+ (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,47 +1188,47 @@ 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 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"))))))
-
-(define network-manager-shepherd-service
- (match-lambda
- (($ <network-manager-configuration> network-manager dns vpn-plugins iwd?)
- (let ((conf (plain-file "NetworkManager.conf"
- (string-append
- "[main]\ndns=" dns "\n"
- (if iwd? "[device]\nwifi.backend=iwd\n" ""))))
- (vpn (vpn-plugin-directory vpn-plugins)))
- (list (shepherd-service
- (documentation "Run the NetworkManager.")
- (provision '(networking))
- (requirement (append '(user-processes dbus-system loopback)
- (if iwd? '(iwd) '(wpa-supplicant))))
- (start #~(make-forkexec-constructor
- (list (string-append #$network-manager
- "/sbin/NetworkManager")
- (string-append "--config=" #$conf)
- "--no-daemon")
- #:environment-variables
- (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
- "/lib/NetworkManager/VPN")
- ;; Override non-existent default users
- "NM_OPENVPN_USER="
- "NM_OPENVPN_GROUP=")))
- (stop #~(make-kill-destructor))))))))
+(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")))))
+
+(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"
+ (if iwd? "[device]\nwifi.backend=iwd\n" ""))))
+ (vpn (vpn-plugin-directory vpn-plugins)))
+ (list (shepherd-service
+ (documentation "Run the NetworkManager.")
+ (provision '(networking))
+ (requirement (append '(user-processes dbus-system loopback)
+ (if iwd? '(iwd) '(wpa-supplicant))))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$network-manager
+ "/sbin/NetworkManager")
+ (string-append "--config=" #$conf)
+ "--no-daemon")
+ #:environment-variables
+ (list (string-append "NM_VPN_PLUGIN_DIR=" #$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->packages
- (match-lambda
- (($ <network-manager-configuration> network-manager _ vpn-plugins)
- `(,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
(name 'network-manager)
@@ -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,24 +1407,25 @@ 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)
- (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"))))))))))
+ (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 #$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)
+ (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
@@ -1471,40 +1469,39 @@ 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?
- interface config-file extra-options)
- (list (shepherd-service
- (documentation "Run the WPA supplicant daemon")
- (provision '(wpa-supplicant))
- (requirement (if dbus?
- (cons 'dbus-system requirement)
- requirement))
- (start #~(make-forkexec-constructor
- (list (string-append #$wpa-supplicant
- "/sbin/wpa_supplicant")
- (string-append "-P" #$pid-file)
- "-B" ;run in background
- "-s" ;log to syslogd
- #$@(if dbus?
- #~("-u")
- #~())
- #$@(if interface
- #~((string-append "-i" #$interface))
- #~())
- #$@(if config-file
- #~((string-append "-c" #$config-file))
- #~())
- #$@extra-options)
- #:pid-file #$pid-file))
- (stop #~(make-kill-destructor)))))))
+(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")
+ (provision '(wpa-supplicant))
+ (requirement (if dbus?
+ (cons 'dbus-system requirement)
+ requirement))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$wpa-supplicant
+ "/sbin/wpa_supplicant")
+ (string-append "-P" #$pid-file)
+ "-B" ;run in background
+ "-s" ;log to syslogd
+ #$@(if dbus?
+ #~("-u")
+ #~())
+ #$@(if interface
+ #~((string-append "-i" #$interface))
+ #~())
+ #$@(if config-file
+ #~((string-append "-c" #$config-file))
+ #~())
+ #$@extra-options)
+ #:pid-file #$pid-file))
+ (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,41 +1623,38 @@ simulation."
(package openvswitch-configuration-package
(default openvswitch)))
-(define openvswitch-activation
- (match-lambda
- (($ <openvswitch-configuration> package)
- (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir-p "/var/run/openvswitch")
- (mkdir-p "/var/lib/openvswitch")
- (let ((conf.db "/var/lib/openvswitch/conf.db"))
- (unless (file-exists? 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"))
- (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
- (list
- (shepherd-service
- (provision '(ovsdb))
- (documentation "Run the Open vSwitch database server.")
- (start #~(make-forkexec-constructor
- (list #$ovsdb-server "--pidfile"
- "--remote=punix:/var/run/openvswitch/db.sock")
- #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
- (stop #~(make-kill-destructor)))
- (shepherd-service
- (provision '(vswitchd))
- (requirement '(ovsdb))
- (documentation "Run the Open vSwitch daemon.")
- (start #~(make-forkexec-constructor
- (list #$ovs-vswitchd "--pidfile")
- #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
- (stop #~(make-kill-destructor))))))))
+(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))
+ (mkdir-p "/var/run/openvswitch")
+ (mkdir-p "/var/lib/openvswitch")
+ (let ((conf.db "/var/lib/openvswitch/conf.db"))
+ (unless (file-exists? conf.db)
+ (system* #$ovsdb-tool "create" conf.db)))))))
+
+(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
+ (provision '(ovsdb))
+ (documentation "Run the Open vSwitch database server.")
+ (start #~(make-forkexec-constructor
+ (list #$ovsdb-server "--pidfile"
+ "--remote=punix:/var/run/openvswitch/db.sock")
+ #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
+ (stop #~(make-kill-destructor)))
+ (shepherd-service
+ (provision '(vswitchd))
+ (requirement '(ovsdb))
+ (documentation "Run the Open vSwitch daemon.")
+ (start #~(make-forkexec-constructor
+ (list #$ovs-vswitchd "--pidfile")
+ #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
+ (stop #~(make-kill-destructor))))))
(define openvswitch-service-type
(service-type
@@ -1700,20 +1694,20 @@ 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)
- (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
- (ip6tables-restore (file-append iptables
"/sbin/ip6tables-restore")))
- (shepherd-service
- (documentation "Packet filtering framework")
- (provision '(iptables))
- (start #~(lambda _
- (invoke #$iptables-restore #$ipv4-rules)
- (invoke #$ip6tables-restore #$ipv6-rules)))
- (stop #~(lambda _
- (invoke #$iptables-restore #$%iptables-accept-all-rules)
- (invoke #$ip6tables-restore
#$%iptables-accept-all-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
+ (documentation "Packet filtering framework")
+ (provision '(iptables))
+ (start #~(lambda _
+ (invoke #$iptables-restore #$ipv4-rules)
+ (invoke #$ip6tables-restore #$ipv6-rules)))
+ (stop #~(lambda _
+ (invoke #$iptables-restore #$%iptables-accept-all-rules)
+ (invoke #$ip6tables-restore
#$%iptables-accept-all-rules)))))))
(define iptables-service-type
(service-type
@@ -1772,17 +1766,17 @@ table inet filter {
(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-shepherd-service config)
+ (match-record config <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
@@ -2155,23 +2149,22 @@ 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
- (provision '(keepalived))
- (documentation "Run keepalived.")
- (requirement '(loopback))
- (start #~(make-forkexec-constructor
- (list (string-append #$keepalived "/sbin/keepalived")
- "--dont-fork" "--log-console" "--log-detail"
- "--pid=/var/run/keepalived.pid"
- (string-append "--use-file=" #$config-file))
- #:pid-file "/var/run/keepalived.pid"
- #:log-file "/var/log/keepalived.log"))
- (respawn? #f)
- (stop #~(make-kill-destructor)))))))
+(define (keepalived-shepherd-service config)
+ (match-record config <keepalived-configuration>
+ (keepalived config-file)
+ (list (shepherd-service
+ (provision '(keepalived))
+ (documentation "Run keepalived.")
+ (requirement '(loopback))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$keepalived "/sbin/keepalived")
+ "--dont-fork" "--log-console" "--log-detail"
+ "--pid=/var/run/keepalived.pid"
+ (string-append "--use-file=" #$config-file))
+ #:pid-file "/var/run/keepalived.pid"
+ #:log-file "/var/log/keepalived.log"))
+ (respawn? #f)
+ (stop #~(make-kill-destructor))))))
(define %keepalived-log-rotation
(list (log-rotation
- branch master updated (c7793b82ef -> 00ddf185e6), guix-commits, 2022/12/01
- 04/08: records: 'match-record' checks fields at macro-expansion time., guix-commits, 2022/12/01
- 02/08: etc: teams: Add chez.scm to Racket team's scope., guix-commits, 2022/12/01
- 05/08: doc: Recommend 'match-record'., guix-commits, 2022/12/01
- 01/08: gnu: guile-gcrypt: Update to 0.4.0., guix-commits, 2022/12/01
- 06/08: home: services: Use 'match-record' instead of 'match'., guix-commits, 2022/12/01
- 07/08: services: base: Use 'match-record' instead of 'match'., guix-commits, 2022/12/01
- 03/08: gnu: Add alfa., guix-commits, 2022/12/01
- 08/08: services: networking: Avoid 'match' on records.,
guix-commits <=