[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#30991] [PATCH v2 1/3] services: Move static-networking to (gnu serv
|
From: |
Danny Milosavljevic |
|
Subject: |
[bug#30991] [PATCH v2 1/3] services: Move static-networking to (gnu services base). |
|
Date: |
Fri, 30 Mar 2018 00:21:38 +0200 |
* 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.
---
gnu/services/base.scm | 160 +++++++++++++++++++++++++++++++++++++++++++-
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 be1bfce57..694aab882 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
address@hidden 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
address@hidden 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 6ac440fd2..da96bbeb5 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
%ntp-servers
@@ -134,154 +124,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
address@hidden 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
address@hidden 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