#: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)
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
"Return a service that uses @var{device} as a swap device."
(service swap-service-type device))
+(define %default-gpm-options
+ ;; Default options for GPM.
+ '("-m" "/dev/input/mice" "-t" "ps2"))
+
(define-record-type* <gpm-configuration>
gpm-configuration make-gpm-configuration gpm-configuration?
- (gpm gpm-configuration-gpm) ;package
- (options gpm-configuration-options)) ;list of strings
+ (gpm gpm-configuration-gpm ;package
+ (default gpm))
+ (options gpm-configuration-options ;list of strings
+ (default %default-gpm-options)))
(define gpm-shepherd-service
(match-lambda
(extensions
(list (service-extension shepherd-root-service-type
gpm-shepherd-service)))
+ (default-value (gpm-configuration))
(description
"Run GPM, the general-purpose mouse daemon, with the given
command-line options. GPM allows users to use the mouse in the console,
notably to select, copy, and paste text. The default options use the
@code{ps2} protocol, which works for both USB and PS/2 mice.")))
-(define* (gpm-service #:key (gpm gpm)
- (options '("-m" "/dev/input/mice" "-t" "ps2")))
+(define* (gpm-service #:key (gpm gpm) ;deprecated
+ (options %default-gpm-options))
"Run @var{gpm}, the general-purpose mouse daemon, with the given
command-line @var{options}. GPM allows users to use the mouse in the console,
notably to select, copy, and paste text. The default value of @var{options}
(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)))))
+
\f
(define %base-services
;; Convenience variable holding the basic services.
HCoop / jackhill / guix / guix.git / blobdiff