diff options
Diffstat (limited to 'gnu/services/base.scm')
| -rw-r--r-- | gnu/services/base.scm | 160 |
1 files changed, 159 insertions, 1 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. |