diff options
Diffstat (limited to 'gnu/services/networking.scm')
| -rw-r--r-- | gnu/services/networking.scm | 160 |
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 |