diff options
| -rw-r--r-- | gnu/services/base.scm | 160 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 160 |
2 files changed, 160 insertions, 160 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index be1bfce578..694aab882e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -26,7 +26,6 @@ #:use-module (guix store) #:use-module (gnu services) #:use-module (gnu services shepherd) - #:use-module (gnu services networking) #:use-module (gnu system pam) #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system uuid) @@ -64,6 +63,18 @@ console-font-service virtual-terminal-service-type + 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 + udev-configuration udev-configuration? udev-configuration-rules @@ -2045,6 +2056,153 @@ This service is not part of @var{%base-services}." (start #~(make-forkexec-constructor #$kmscon-command)) (stop #~(make-kill-destructor))))))) +(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 %base-services ;; Convenience variable holding the basic services. 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 |