services: Make 'static-networking' extensible.
This allows users to statically define several interfaces. * gnu/services/networking.scm (<static-networking>)[provision] [name-servers]: Add default values. (static-networking-shepherd-service) (static-networking-etc-files) (static-networking-shepherd-services): New procedures. (static-networking-service-type): Change to extend both SHEPHERD-ROOT-SERVICE-TYPE and ETC-SERVICE-TYPE. (static-networking-service): Remove default value of #:provision. Implement using 'simple-service'. * gnu/services/base.scm (%base-services): Replace 'static-networking-service' call with 'service' form. * doc/guix.texi (Networking Services): Update documentation.
This commit is contained in:
Ludovic Courtès
parent
fd05d7ecd9
commit
8de3e4b35f
3 changed files with 145 additions and 76 deletions
|
|
@ -8786,11 +8786,21 @@ Return a service that runs @var{dhcp}, a Dynamic Host Configuration
|
|||
Protocol (DHCP) client, on all the non-loopback network interfaces.
|
||||
@end deffn
|
||||
|
||||
@defvr {Scheme Variable} static-networking-service-type
|
||||
This is the type for statically-configured network interfaces.
|
||||
@c TODO Document <static-networking> data structures.
|
||||
@end defvr
|
||||
|
||||
@deffn {Scheme Procedure} static-networking-service @var{interface} @var{ip} @
|
||||
[#:netmask #f] [#:gateway #f] [#:name-servers @code{'()}]
|
||||
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.
|
||||
@end deffn
|
||||
|
||||
@cindex wicd
|
||||
|
|
|
|||
|
|
@ -1546,8 +1546,10 @@ This service is not part of @var{%base-services}."
|
|||
(mingetty-service (mingetty-configuration
|
||||
(tty "tty6")))
|
||||
|
||||
(static-networking-service "lo" "127.0.0.1"
|
||||
#:provision '(loopback))
|
||||
(service static-networking-service-type
|
||||
(list (static-networking (interface "lo")
|
||||
(ip "127.0.0.1")
|
||||
(provision '(loopback)))))
|
||||
(syslog-service)
|
||||
(urandom-seed-service)
|
||||
(guix-service)
|
||||
|
|
|
|||
|
|
@ -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,17 +128,18 @@ 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-service-type
|
||||
(shepherd-service-type
|
||||
'static-networking
|
||||
(define static-networking-shepherd-service
|
||||
(match-lambda
|
||||
(($ <static-networking> interface ip netmask gateway provision
|
||||
name-servers)
|
||||
(let ((loopback? (memq 'loopback provision)))
|
||||
(let ((loopback? (and provision (memq 'loopback provision))))
|
||||
(shepherd-service
|
||||
|
||||
;; Unless we're providing the loopback interface, wait for udev to be up
|
||||
|
|
@ -140,7 +148,10 @@ fe80::1%lo0 apps.facebook.com\n")
|
|||
|
||||
(documentation
|
||||
"Bring up the networking interface using a static IP address.")
|
||||
(provision provision)
|
||||
(provision (or provision
|
||||
(list (symbol-append 'networking-
|
||||
(string->symbol interface)))))
|
||||
|
||||
(start #~(lambda _
|
||||
;; Return #t if successfully started.
|
||||
(let* ((addr (inet-pton AF_INET #$ip))
|
||||
|
|
@ -164,20 +175,7 @@ fe80::1%lo0 apps.facebook.com\n")
|
|||
(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)))
|
||||
(close-port sock))))))
|
||||
(stop #~(lambda _
|
||||
;; Return #f is successfully stopped.
|
||||
(let ((sock (socket AF_INET SOCK_STREAM 0)))
|
||||
|
|
@ -188,21 +186,80 @@ fe80::1%lo0 apps.facebook.com\n")
|
|||
(set-network-interface-flags sock #$interface 0)
|
||||
(close-port sock)
|
||||
#f)))
|
||||
(respawn? #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)))
|
||||
|
||||
(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)
|
||||
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))))
|
||||
(name-servers name-servers)))))
|
||||
|
||||
(define dhcp-client-service-type
|
||||
(shepherd-service-type
|
||||
|
|
|
|||
Reference in a new issue