services: Move static-networking to (gnu services base).
* gnu/services/networking.scm (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): Move to... * gnu/services/base.scm: ...here.
This commit is contained in:
Danny Milosavljevic
parent
f1f4a4f016
commit
c9436025a9
2 changed files with 160 additions and 160 deletions
|
|
@ -26,7 +26,6 @@
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu services networking)
|
|
||||||
#:use-module (gnu system pam)
|
#:use-module (gnu system pam)
|
||||||
#:use-module (gnu system shadow) ; 'user-account', etc.
|
#:use-module (gnu system shadow) ; 'user-account', etc.
|
||||||
#:use-module (gnu system uuid)
|
#:use-module (gnu system uuid)
|
||||||
|
|
@ -64,6 +63,18 @@
|
||||||
console-font-service
|
console-font-service
|
||||||
virtual-terminal-service-type
|
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?
|
udev-configuration?
|
||||||
udev-configuration-rules
|
udev-configuration-rules
|
||||||
|
|
@ -2045,6 +2056,153 @@ This service is not part of @var{%base-services}."
|
||||||
(start #~(make-forkexec-constructor #$kmscon-command))
|
(start #~(make-forkexec-constructor #$kmscon-command))
|
||||||
(stop #~(make-kill-destructor)))))))
|
(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
|
(define %base-services
|
||||||
;; Convenience variable holding the basic services.
|
;; Convenience variable holding the basic services.
|
||||||
|
|
|
||||||
|
|
@ -24,6 +24,7 @@
|
||||||
|
|
||||||
(define-module (gnu services networking)
|
(define-module (gnu services networking)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
|
#:use-module (gnu services base)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu services dbus)
|
#:use-module (gnu services dbus)
|
||||||
#:use-module (gnu system shadow)
|
#:use-module (gnu system shadow)
|
||||||
|
|
@ -45,17 +46,6 @@
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (%facebook-host-aliases
|
#: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
|
dhcp-client-service
|
||||||
|
|
||||||
dhcpd-service-type
|
dhcpd-service-type
|
||||||
|
|
@ -146,154 +136,6 @@ fe80::1%lo0 connect.facebook.net
|
||||||
fe80::1%lo0 www.connect.facebook.net
|
fe80::1%lo0 www.connect.facebook.net
|
||||||
fe80::1%lo0 apps.facebook.com\n")
|
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
|
(define dhcp-client-service-type
|
||||||
(shepherd-service-type
|
(shepherd-service-type
|
||||||
'dhcp-client
|
'dhcp-client
|
||||||
|
|
|
||||||
Reference in a new issue