aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/networking.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/networking.scm')
-rw-r--r--gnu/services/networking.scm357
1 files changed, 173 insertions, 184 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index c2b404503e..50ffac5796 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -28,7 +28,6 @@
#:use-module (gnu packages wicd)
#:use-module (guix gexp)
#:use-module (guix store)
- #:use-module (guix monads)
#:use-module (srfi srfi-26)
#:export (%facebook-host-aliases
static-networking-service
@@ -93,54 +92,52 @@ gateway."
;; TODO: Eventually replace 'route' with bindings for the appropriate
;; ioctls.
- (with-monad %store-monad
- (return
- (service
-
- ;; Unless we're providing the loopback interface, wait for udev to be up
- ;; and running so that INTERFACE is actually usable.
- (requirement (if loopback? '() '(udev)))
-
- (documentation
- "Bring up the networking interface using a static IP address.")
- (provision provision)
- (start #~(lambda _
- ;; Return #t if successfully started.
- (let* ((addr (inet-pton AF_INET #$ip))
- (sockaddr (make-socket-address AF_INET addr 0)))
- (configure-network-interface #$interface sockaddr
- (logior IFF_UP
- #$(if loopback?
- #~IFF_LOOPBACK
- 0))))
- #$(if gateway
- #~(zero? (system* (string-append #$net-tools
- "/sbin/route")
- "add" "-net" "default"
- "gw" #$gateway))
- #t)
- #$(if (pair? name-servers)
- #~(call-with-output-file "/etc/resolv.conf"
- (lambda (port)
- (display
- "# Generated by 'static-networking-service'.\n"
- port)
- (for-each (lambda (server)
- (format port "nameserver ~a~%"
- server))
- '#$name-servers)))
- #t)))
- (stop #~(lambda _
- ;; Return #f is successfully stopped.
- (let ((sock (socket AF_INET SOCK_STREAM 0)))
- (set-network-interface-flags sock #$interface 0)
- (close-port sock))
- (not #$(if gateway
- #~(system* (string-append #$net-tools
+ (service
+
+ ;; Unless we're providing the loopback interface, wait for udev to be up
+ ;; and running so that INTERFACE is actually usable.
+ (requirement (if loopback? '() '(udev)))
+
+ (documentation
+ "Bring up the networking interface using a static IP address.")
+ (provision provision)
+ (start #~(lambda _
+ ;; Return #t if successfully started.
+ (let* ((addr (inet-pton AF_INET #$ip))
+ (sockaddr (make-socket-address AF_INET addr 0)))
+ (configure-network-interface #$interface sockaddr
+ (logior IFF_UP
+ #$(if loopback?
+ #~IFF_LOOPBACK
+ 0))))
+ #$(if gateway
+ #~(zero? (system* (string-append #$net-tools
"/sbin/route")
- "del" "-net" "default")
- #t))))
- (respawn? #f)))))
+ "add" "-net" "default"
+ "gw" #$gateway))
+ #t)
+ #$(if (pair? name-servers)
+ #~(call-with-output-file "/etc/resolv.conf"
+ (lambda (port)
+ (display
+ "# Generated by 'static-networking-service'.\n"
+ port)
+ (for-each (lambda (server)
+ (format port "nameserver ~a~%"
+ server))
+ '#$name-servers)))
+ #t)))
+ (stop #~(lambda _
+ ;; Return #f is successfully stopped.
+ (let ((sock (socket AF_INET SOCK_STREAM 0)))
+ (set-network-interface-flags sock #$interface 0)
+ (close-port sock))
+ (not #$(if gateway
+ #~(system* (string-append #$net-tools
+ "/sbin/route")
+ "del" "-net" "default")
+ #t))))
+ (respawn? #f)))
(define* (dhcp-client-service #:key (dhcp isc-dhcp))
"Return a service that runs @var{dhcp}, a Dynamic Host Configuration
@@ -152,52 +149,49 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
(define pid-file
"/var/run/dhclient.pid")
- (with-monad %store-monad
- (return (service
- (documentation "Set up networking via DHCP.")
- (requirement '(user-processes udev))
-
- ;; XXX: Running with '-nw' ("no wait") avoids blocking for a
- ;; minute when networking is unavailable, but also means that the
- ;; interface is not up yet when 'start' completes. To wait for
- ;; the interface to be ready, one should instead monitor udev
- ;; events.
- (provision '(networking))
-
- (start #~(lambda _
- ;; When invoked without any arguments, 'dhclient'
- ;; discovers all non-loopback interfaces *that are
- ;; up*. However, the relevant interfaces are
- ;; typically down at this point. Thus we perform our
- ;; own interface discovery here.
- (define valid?
- (negate loopback-network-interface?))
- (define ifaces
- (filter valid? (all-network-interface-names)))
-
- ;; XXX: Make sure the interfaces are up so that
- ;; 'dhclient' can actually send/receive over them.
- (for-each set-network-interface-up ifaces)
-
- (false-if-exception (delete-file #$pid-file))
- (let ((pid (fork+exec-command
- (cons* #$dhclient "-nw"
- "-pf" #$pid-file ifaces))))
- (and (zero? (cdr (waitpid pid)))
- (let loop ()
- (catch 'system-error
- (lambda ()
- (call-with-input-file #$pid-file read))
- (lambda args
- ;; 'dhclient' returned before PID-FILE
- ;; was created, so try again.
- (let ((errno (system-error-errno args)))
- (if (= ENOENT errno)
- (begin
- (sleep 1)
- (loop))
- (apply throw args))))))))))
- (stop #~(make-kill-destructor))))))
+ (service
+ (documentation "Set up networking via DHCP.")
+ (requirement '(user-processes udev))
+
+ ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
+ ;; networking is unavailable, but also means that the interface is not up
+ ;; yet when 'start' completes. To wait for the interface to be ready, one
+ ;; should instead monitor udev events.
+ (provision '(networking))
+
+ (start #~(lambda _
+ ;; When invoked without any arguments, 'dhclient' discovers all
+ ;; non-loopback interfaces *that are up*. However, the relevant
+ ;; interfaces are typically down at this point. Thus we perform
+ ;; our own interface discovery here.
+ (define valid?
+ (negate loopback-network-interface?))
+ (define ifaces
+ (filter valid? (all-network-interface-names)))
+
+ ;; XXX: Make sure the interfaces are up so that 'dhclient' can
+ ;; actually send/receive over them.
+ (for-each set-network-interface-up ifaces)
+
+ (false-if-exception (delete-file #$pid-file))
+ (let ((pid (fork+exec-command
+ (cons* #$dhclient "-nw"
+ "-pf" #$pid-file ifaces))))
+ (and (zero? (cdr (waitpid pid)))
+ (let loop ()
+ (catch 'system-error
+ (lambda ()
+ (call-with-input-file #$pid-file read))
+ (lambda args
+ ;; 'dhclient' returned before PID-FILE was created,
+ ;; so try again.
+ (let ((errno (system-error-errno args)))
+ (if (= ENOENT errno)
+ (begin
+ (sleep 1)
+ (loop))
+ (apply throw args))))))))))
+ (stop #~(make-kill-destructor))))
(define %ntp-servers
;; Default set of NTP servers.
@@ -227,57 +221,55 @@ restrict -6 default kod nomodify notrap nopeer noquery
restrict 127.0.0.1
restrict -6 ::1\n"))
- (mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config)))
- (return
- (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")))
- (stop #~(make-kill-destructor))
- (user-accounts (list (user-account
- (name "ntpd")
- (group "nogroup")
- (system? #t)
- (comment "NTP daemon user")
- (home-directory "/var/empty")
- (shell
- #~(string-append #$shadow "/sbin/nologin")))))))))
+ (let ((ntpd.conf (plain-file "ntpd.conf" config)))
+ (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")))
+ (stop #~(make-kill-destructor))
+ (user-accounts (list (user-account
+ (name "ntpd")
+ (group "nogroup")
+ (system? #t)
+ (comment "NTP daemon user")
+ (home-directory "/var/empty")
+ (shell
+ #~(string-append #$shadow "/sbin/nologin"))))))))
(define* (tor-service #:key (tor tor))
"Return a service to run the @uref{https://torproject.org,Tor} daemon.
The daemon runs with the default settings (in particular the default exit
policy) as the @code{tor} unprivileged user."
- (mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
- (return
- (service
- (provision '(tor))
-
- ;; Tor needs at least one network interface to be up, hence the
- ;; dependency on 'loopback'.
- (requirement '(user-processes loopback))
-
- (start #~(make-forkexec-constructor
- (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
- (stop #~(make-kill-destructor))
-
- (user-groups (list (user-group
- (name "tor")
- (system? #t))))
- (user-accounts (list (user-account
- (name "tor")
- (group "tor")
- (system? #t)
- (comment "Tor daemon user")
- (home-directory "/var/empty")
- (shell
- #~(string-append #$shadow "/sbin/nologin")))))
-
- (documentation "Run the Tor anonymous network overlay.")))))
+ (let ((torrc (plain-file "torrc" "User tor\n")))
+ (service
+ (provision '(tor))
+
+ ;; Tor needs at least one network interface to be up, hence the
+ ;; dependency on 'loopback'.
+ (requirement '(user-processes loopback))
+
+ (start #~(make-forkexec-constructor
+ (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
+ (stop #~(make-kill-destructor))
+
+ (user-groups (list (user-group
+ (name "tor")
+ (system? #t))))
+ (user-accounts (list (user-account
+ (name "tor")
+ (group "tor")
+ (system? #t)
+ (comment "Tor daemon user")
+ (home-directory "/var/empty")
+ (shell
+ #~(string-append #$shadow "/sbin/nologin")))))
+
+ (documentation "Run the Tor anonymous network overlay."))))
(define* (bitlbee-service #:key (bitlbee bitlbee)
(interface "127.0.0.1") (port 6667)
@@ -292,60 +284,57 @@ come from any networking interface.
In addition, @var{extra-settings} specifies a string to append to the
configuration file."
- (mlet %store-monad ((conf (text-file "bitlbee.conf"
- (string-append "
+ (let ((conf (plain-file "bitlbee.conf"
+ (string-append "
[settings]
User = bitlbee
ConfigDir = /var/lib/bitlbee
DaemonInterface = " interface "
DaemonPort = " (number->string port) "
" extra-settings))))
- (return
- (service
- (provision '(bitlbee))
- (requirement '(user-processes loopback))
- (activate #~(begin
- (use-modules (guix build utils))
-
- ;; This directory is used to store OTR data.
- (mkdir-p "/var/lib/bitlbee")
- (let ((user (getpwnam "bitlbee")))
- (chown "/var/lib/bitlbee"
- (passwd:uid user) (passwd:gid user)))))
- (start #~(make-forkexec-constructor
- (list (string-append #$bitlbee "/sbin/bitlbee")
- "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
- (stop #~(make-kill-destructor))
- (user-groups (list (user-group (name "bitlbee") (system? #t))))
- (user-accounts (list (user-account
- (name "bitlbee")
- (group "bitlbee")
- (system? #t)
- (comment "BitlBee daemon user")
- (home-directory "/var/empty")
- (shell #~(string-append #$shadow
- "/sbin/nologin")))))))))
+ (service
+ (provision '(bitlbee))
+ (requirement '(user-processes loopback))
+ (activate #~(begin
+ (use-modules (guix build utils))
+
+ ;; This directory is used to store OTR data.
+ (mkdir-p "/var/lib/bitlbee")
+ (let ((user (getpwnam "bitlbee")))
+ (chown "/var/lib/bitlbee"
+ (passwd:uid user) (passwd:gid user)))))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$bitlbee "/sbin/bitlbee")
+ "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
+ (stop #~(make-kill-destructor))
+ (user-groups (list (user-group (name "bitlbee") (system? #t))))
+ (user-accounts (list (user-account
+ (name "bitlbee")
+ (group "bitlbee")
+ (system? #t)
+ (comment "BitlBee daemon user")
+ (home-directory "/var/empty")
+ (shell #~(string-append #$shadow
+ "/sbin/nologin"))))))))
(define* (wicd-service #:key (wicd wicd))
"Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
manager that aims to simplify wired and wireless networking."
- (with-monad %store-monad
- (return
- (service
- (documentation "Run the Wicd network manager.")
- (provision '(networking))
- (requirement '(user-processes dbus-system loopback))
- (start #~(make-forkexec-constructor
- (list (string-append #$wicd "/sbin/wicd")
- "--no-daemon")))
- (stop #~(make-kill-destructor))
- (activate
- #~(begin
- (use-modules (guix build utils))
- (mkdir-p "/etc/wicd")
- (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
- (unless (file-exists? file-name)
- (copy-file (string-append #$wicd file-name)
- file-name)))))))))
+ (service
+ (documentation "Run the Wicd network manager.")
+ (provision '(networking))
+ (requirement '(user-processes dbus-system loopback))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$wicd "/sbin/wicd")
+ "--no-daemon")))
+ (stop #~(make-kill-destructor))
+ (activate
+ #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p "/etc/wicd")
+ (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
+ (unless (file-exists? file-name)
+ (copy-file (string-append #$wicd file-name)
+ file-name)))))))
;;; networking.scm ends here
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-06 20:52:54 +0000