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.scm205
1 files changed, 131 insertions, 74 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index f7412ff29e..766d979f3e 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -42,6 +42,13 @@
#:use-module (ice-9 match)
#:export (%facebook-host-aliases
static-networking
+
+ static-networking?
+ static-networking-interface
+ static-networking-ip
+ static-networking-netmask
+ static-networking-gateway
+
static-networking-service
static-networking-service-type
dhcp-client-service
@@ -121,88 +128,138 @@ fe80::1%lo0 apps.facebook.com\n")
(ip static-networking-ip)
(netmask static-networking-netmask
(default #f))
- (gateway static-networking-gateway)
- (provision static-networking-provision)
- (name-servers static-networking-name-servers))
+ (gateway static-networking-gateway ;FIXME: doesn't belong here
+ (default #f))
+ (provision static-networking-provision
+ (default #f))
+ (name-servers static-networking-name-servers ;FIXME: doesn't belong here
+ (default '())))
+
+(define static-networking-shepherd-service
+ (match-lambda
+ (($ <static-networking> interface ip netmask gateway provision
+ name-servers)
+ (let ((loopback? (and provision (memq 'loopback provision))))
+ (shepherd-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 (or provision
+ (list (symbol-append 'networking-
+ (string->symbol interface)))))
+
+ (start #~(lambda _
+ ;; Return #t if successfully started.
+ (let* ((addr (inet-pton AF_INET #$ip))
+ (sockaddr (make-socket-address AF_INET addr 0))
+ (mask (and #$netmask
+ (inet-pton AF_INET #$netmask)))
+ (maskaddr (and mask
+ (make-socket-address AF_INET
+ mask 0)))
+ (gateway (and #$gateway
+ (inet-pton AF_INET #$gateway)))
+ (gatewayaddr (and gateway
+ (make-socket-address AF_INET
+ gateway 0))))
+ (configure-network-interface #$interface sockaddr
+ (logior IFF_UP
+ #$(if loopback?
+ #~IFF_LOOPBACK
+ 0))
+ #:netmask maskaddr)
+ (when gateway
+ (let ((sock (socket AF_INET SOCK_DGRAM 0)))
+ (add-network-route/gateway sock gatewayaddr)
+ (close-port sock))))))
+ (stop #~(lambda _
+ ;; Return #f is successfully stopped.
+ (let ((sock (socket AF_INET SOCK_STREAM 0)))
+ (when #$gateway
+ (delete-network-route sock
+ (make-socket-address
+ AF_INET INADDR_ANY 0)))
+ (set-network-interface-flags sock #$interface 0)
+ (close-port sock)
+ #f)))
+ (respawn? #f))))))
+
+(define (static-networking-etc-files interfaces)
+ "Return a /etc/resolv.conf entry for INTERFACES or the empty list."
+ (match (delete-duplicates
+ (append-map static-networking-name-servers
+ interfaces))
+ (()
+ '())
+ ((name-servers ...)
+ (let ((content (string-join
+ (map (cut string-append "nameserver " <>)
+ name-servers)
+ "\n" 'suffix)))
+ `(("resolv.conf"
+ ,(plain-file "resolv.conf"
+ (string-append "\
+# Generated by 'static-networking-service'.\n"
+ content))))))))
+
+(define (static-networking-shepherd-services interfaces)
+ "Return the list of Shepherd services to bring up INTERFACES, a list of
+<static-networking> objects."
+ (define (loopback? service)
+ (memq 'loopback (shepherd-service-provision service)))
+
+ (let ((services (map static-networking-shepherd-service interfaces)))
+ (match (remove loopback? services)
+ (()
+ ;; There's no interface other than 'loopback', so we assume that the
+ ;; 'networking' service will be provided by dhclient or similar.
+ services)
+ ((non-loopback ...)
+ ;; Assume we're providing all the interfaces, and thus, provide a
+ ;; 'networking' service.
+ (cons (shepherd-service
+ (provision '(networking))
+ (requirement (append-map shepherd-service-provision
+ services))
+ (start #~(const #t))
+ (stop #~(const #f))
+ (documentation "Bring up all the networking interfaces."))
+ services)))))
(define static-networking-service-type
- (shepherd-service-type
- 'static-networking
- (match-lambda
- (($ <static-networking> interface ip netmask gateway provision
- name-servers)
- (let ((loopback? (memq 'loopback provision)))
- (shepherd-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))
- (mask (and #$netmask
- (inet-pton AF_INET #$netmask)))
- (maskaddr (and mask
- (make-socket-address AF_INET
- mask 0)))
- (gateway (and #$gateway
- (inet-pton AF_INET #$gateway)))
- (gatewayaddr (and gateway
- (make-socket-address AF_INET
- gateway 0))))
- (configure-network-interface #$interface sockaddr
- (logior IFF_UP
- #$(if loopback?
- #~IFF_LOOPBACK
- 0))
- #:netmask maskaddr)
- (when gateway
- (let ((sock (socket AF_INET SOCK_DGRAM 0)))
- (add-network-route/gateway sock gatewayaddr)
- (close-port sock))))
-
- #$(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))
- #t)))
- (stop #~(lambda _
- ;; Return #f is successfully stopped.
- (let ((sock (socket AF_INET SOCK_STREAM 0)))
- (when #$gateway
- (delete-network-route sock
- (make-socket-address
- AF_INET INADDR_ANY 0)))
- (set-network-interface-flags sock #$interface 0)
- (close-port sock)
- #f)))
- (respawn? #f)))))))
+ ;; The service type for statically-defined network interfaces.
+ (service-type (name 'static-networking)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ static-networking-shepherd-services)
+ (service-extension etc-service-type
+ static-networking-etc-files)))
+ (compose concatenate)
+ (extend append)))
(define* (static-networking-service interface ip
#:key
- netmask gateway
- (provision '(networking))
+ netmask gateway provision
(name-servers '()))
"Return a service that starts @var{interface} with address @var{ip}. If
@var{netmask} is true, use it as the network mask. If @var{gateway} is true,
-it must be a string specifying the default network gateway."
- (service static-networking-service-type
- (static-networking (interface interface) (ip ip)
- (netmask netmask) (gateway gateway)
- (provision provision)
- (name-servers name-servers))))
+it must be a string specifying the default network gateway.
+
+This procedure can be called several times, one for each network
+interface of interest. Behind the scenes what it does is extend
+@code{static-networking-service-type} with additional network interfaces
+to handle."
+ (simple-service 'static-network-interface
+ static-networking-service-type
+ (list (static-networking (interface interface) (ip ip)
+ (netmask netmask) (gateway gateway)
+ (provision provision)
+ (name-servers name-servers)))))
(define dhcp-client-service-type
(shepherd-service-type
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-06 00:44:49 +0000