summaryrefslogtreecommitdiff
path: root/gnu/services/networking.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/networking.scm')
-rw-r--r--gnu/services/networking.scm160
1 files changed, 1 insertions, 159 deletions
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index df67bd69c7..400b6919d2 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -24,6 +24,7 @@
(define-module (gnu services networking)
#:use-module (gnu services)
+ #:use-module (gnu services base)
#:use-module (gnu services shepherd)
#:use-module (gnu services dbus)
#:use-module (gnu system shadow)
@@ -45,17 +46,6 @@
#:use-module (srfi srfi-26)
#: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-requirement
-
- static-networking-service
- static-networking-service-type
dhcp-client-service
dhcpd-service-type
@@ -146,154 +136,6 @@ fe80::1%lo0 connect.facebook.net
fe80::1%lo0 www.connect.facebook.net
fe80::1%lo0 apps.facebook.com\n")
-
-(define-record-type* <static-networking>
- static-networking make-static-networking
- static-networking?
- (interface static-networking-interface)
- (ip static-networking-ip)
- (netmask static-networking-netmask
- (default #f))
- (gateway static-networking-gateway ;FIXME: doesn't belong here
- (default #f))
- (provision static-networking-provision
- (default #f))
- (requirement static-networking-requirement
- (default '()))
- (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
- requirement name-servers)
- (let ((loopback? (and provision (memq 'loopback provision))))
- (shepherd-service
-
- (documentation
- "Bring up the networking interface using a static IP address.")
- (requirement requirement)
- (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
- ;; 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)
- (description
- "Turn up the specified network interfaces upon startup,
-with the given IP address, gateway, netmask, and so on. The value for
-services of this type is a list of @code{static-networking} objects, one per
-network interface.")))
-
-(define* (static-networking-service interface ip
- #:key
- netmask gateway provision
- ;; Most interfaces require udev to be usable.
- (requirement '(udev))
- (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.
-
-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)
- (requirement requirement)
- (name-servers name-servers)))))
-
(define dhcp-client-service-type
(shepherd-service-type
'dhcp-client