mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
3d3c565008
* gnu/services/admin.scm (rottlog-service-type)[default-value]: New field. * gnu/services/base.scm (guix-service-type)[default-value]: New field. (guix-publish-service-type)[default-value]: New field. * gnu/services/cups.scm (cups-service-type)[default-value]: New field. * gnu/services/dict.scm (dicod-service-type)[default-value]: New field. * gnu/services/mcron.scm (mcron-service-type)[default-value]: New field. * gnu/services/networking.scm (<tor-configuration>)[config-file]: Add default value. (tor-service-type)[default-value]: New field. (<bitlbee-configuration>)[interface, port, extra-settings]: Add default values. (bitlbee-service-type)[default-value]: New field. (wpa-supplicant-service-type)[default-value]: New field. (tlp-service-type)[default-value]: New field. (openssh-service-type)[default-value]: New field. * doc/guix.texi (Base Services, Log Rotation) (Networking Services, Printing Services): (Power management Services): Adjust examples accordingly.
1072 lines
40 KiB
Scheme
1072 lines
40 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
|
||
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
||
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
|
||
;;;
|
||
;;; This file is part of GNU Guix.
|
||
;;;
|
||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||
;;; under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||
;;; your option) any later version.
|
||
;;;
|
||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (gnu services networking)
|
||
#:use-module (gnu services)
|
||
#:use-module (gnu services shepherd)
|
||
#:use-module (gnu services dbus)
|
||
#:use-module (gnu system shadow)
|
||
#:use-module (gnu system pam)
|
||
#:use-module (gnu packages admin)
|
||
#:use-module (gnu packages connman)
|
||
#:use-module (gnu packages linux)
|
||
#:use-module (gnu packages tor)
|
||
#:use-module (gnu packages messaging)
|
||
#:use-module (gnu packages networking)
|
||
#:use-module (gnu packages ntp)
|
||
#:use-module (gnu packages wicd)
|
||
#:use-module (gnu packages gnome)
|
||
#:use-module (guix gexp)
|
||
#:use-module (guix records)
|
||
#:use-module (guix modules)
|
||
#:use-module (srfi srfi-1)
|
||
#:use-module (srfi srfi-9)
|
||
#: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-service
|
||
static-networking-service-type
|
||
dhcp-client-service
|
||
%ntp-servers
|
||
|
||
ntp-configuration
|
||
ntp-configuration?
|
||
ntp-service
|
||
ntp-service-type
|
||
|
||
inetd-configuration
|
||
inetd-entry
|
||
inetd-service-type
|
||
|
||
tor-configuration
|
||
tor-configuration?
|
||
tor-hidden-service
|
||
tor-service
|
||
tor-service-type
|
||
|
||
bitlbee-configuration
|
||
bitlbee-configuration?
|
||
bitlbee-service
|
||
bitlbee-service-type
|
||
|
||
wicd-service-type
|
||
wicd-service
|
||
|
||
network-manager-configuration
|
||
network-manager-configuration?
|
||
network-manager-configuration-dns
|
||
network-manager-service-type
|
||
|
||
connman-configuration
|
||
connman-configuration?
|
||
connman-service-type
|
||
|
||
wpa-supplicant-service-type
|
||
|
||
openvswitch-service-type
|
||
openvswitch-configuration))
|
||
|
||
;;; Commentary:
|
||
;;;
|
||
;;; Networking services.
|
||
;;;
|
||
;;; Code:
|
||
|
||
(define %facebook-host-aliases
|
||
;; This is the list of known Facebook hosts to be added to /etc/hosts if you
|
||
;; are to block it.
|
||
"\
|
||
# Block Facebook IPv4.
|
||
127.0.0.1 www.facebook.com
|
||
127.0.0.1 facebook.com
|
||
127.0.0.1 login.facebook.com
|
||
127.0.0.1 www.login.facebook.com
|
||
127.0.0.1 fbcdn.net
|
||
127.0.0.1 www.fbcdn.net
|
||
127.0.0.1 fbcdn.com
|
||
127.0.0.1 www.fbcdn.com
|
||
127.0.0.1 static.ak.fbcdn.net
|
||
127.0.0.1 static.ak.connect.facebook.com
|
||
127.0.0.1 connect.facebook.net
|
||
127.0.0.1 www.connect.facebook.net
|
||
127.0.0.1 apps.facebook.com
|
||
|
||
# Block Facebook IPv6.
|
||
fe80::1%lo0 facebook.com
|
||
fe80::1%lo0 login.facebook.com
|
||
fe80::1%lo0 www.login.facebook.com
|
||
fe80::1%lo0 fbcdn.net
|
||
fe80::1%lo0 www.fbcdn.net
|
||
fe80::1%lo0 fbcdn.com
|
||
fe80::1%lo0 www.fbcdn.com
|
||
fe80::1%lo0 static.ak.fbcdn.net
|
||
fe80::1%lo0 static.ak.connect.facebook.com
|
||
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))
|
||
(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
|
||
name-servers)
|
||
(let ((loopback? (and provision (memq 'loopback provision))))
|
||
(shepherd-service
|
||
|
||
;; Unless we're providing the loopback interface, wait for udev to be up
|
||
;; and running so that INTERFACE is actually usable.
|
||
(requirement (if loopback? '() '(udev)))
|
||
|
||
(documentation
|
||
"Bring up the networking interface using a static IP address.")
|
||
(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)))
|
||
|
||
(define* (static-networking-service interface ip
|
||
#:key
|
||
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.
|
||
|
||
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)))))
|
||
|
||
(define dhcp-client-service-type
|
||
(shepherd-service-type
|
||
'dhcp-client
|
||
(lambda (dhcp)
|
||
(define dhclient
|
||
(file-append dhcp "/sbin/dhclient"))
|
||
|
||
(define pid-file
|
||
"/var/run/dhclient.pid")
|
||
|
||
(shepherd-service
|
||
(documentation "Set up networking via DHCP.")
|
||
(requirement '(user-processes udev))
|
||
|
||
;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
|
||
;; networking is unavailable, but also means that the interface is not up
|
||
;; yet when 'start' completes. To wait for the interface to be ready, one
|
||
;; should instead monitor udev events.
|
||
(provision '(networking))
|
||
|
||
(start #~(lambda _
|
||
;; When invoked without any arguments, 'dhclient' discovers all
|
||
;; non-loopback interfaces *that are up*. However, the relevant
|
||
;; interfaces are typically down at this point. Thus we perform
|
||
;; our own interface discovery here.
|
||
(define valid?
|
||
(negate loopback-network-interface?))
|
||
(define ifaces
|
||
(filter valid? (all-network-interface-names)))
|
||
|
||
;; XXX: Make sure the interfaces are up so that 'dhclient' can
|
||
;; actually send/receive over them.
|
||
(for-each set-network-interface-up ifaces)
|
||
|
||
(false-if-exception (delete-file #$pid-file))
|
||
(let ((pid (fork+exec-command
|
||
(cons* #$dhclient "-nw"
|
||
"-pf" #$pid-file ifaces))))
|
||
(and (zero? (cdr (waitpid pid)))
|
||
(let loop ()
|
||
(catch 'system-error
|
||
(lambda ()
|
||
(call-with-input-file #$pid-file read))
|
||
(lambda args
|
||
;; 'dhclient' returned before PID-FILE was created,
|
||
;; so try again.
|
||
(let ((errno (system-error-errno args)))
|
||
(if (= ENOENT errno)
|
||
(begin
|
||
(sleep 1)
|
||
(loop))
|
||
(apply throw args))))))))))
|
||
(stop #~(make-kill-destructor))))))
|
||
|
||
(define* (dhcp-client-service #:key (dhcp isc-dhcp))
|
||
"Return a service that runs @var{dhcp}, a Dynamic Host Configuration
|
||
Protocol (DHCP) client, on all the non-loopback network interfaces."
|
||
(service dhcp-client-service-type dhcp))
|
||
|
||
(define %ntp-servers
|
||
;; Default set of NTP servers.
|
||
'("0.pool.ntp.org"
|
||
"1.pool.ntp.org"
|
||
"2.pool.ntp.org"))
|
||
|
||
|
||
;;;
|
||
;;; NTP.
|
||
;;;
|
||
|
||
;; TODO: Export.
|
||
(define-record-type* <ntp-configuration>
|
||
ntp-configuration make-ntp-configuration
|
||
ntp-configuration?
|
||
(ntp ntp-configuration-ntp
|
||
(default ntp))
|
||
(servers ntp-configuration-servers)
|
||
(allow-large-adjustment? ntp-allow-large-adjustment?
|
||
(default #f)))
|
||
|
||
(define ntp-shepherd-service
|
||
(match-lambda
|
||
(($ <ntp-configuration> ntp servers allow-large-adjustment?)
|
||
(let ()
|
||
;; TODO: Add authentication support.
|
||
(define config
|
||
(string-append "driftfile /var/run/ntpd/ntp.drift\n"
|
||
(string-join (map (cut string-append "server " <>)
|
||
servers)
|
||
"\n")
|
||
"
|
||
# Disable status queries as a workaround for CVE-2013-5211:
|
||
# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
|
||
restrict default kod nomodify notrap nopeer noquery
|
||
restrict -6 default kod nomodify notrap nopeer noquery
|
||
|
||
# Yet, allow use of the local 'ntpq'.
|
||
restrict 127.0.0.1
|
||
restrict -6 ::1\n"))
|
||
|
||
(define ntpd.conf
|
||
(plain-file "ntpd.conf" config))
|
||
|
||
(list (shepherd-service
|
||
(provision '(ntpd))
|
||
(documentation "Run the Network Time Protocol (NTP) daemon.")
|
||
(requirement '(user-processes networking))
|
||
(start #~(make-forkexec-constructor
|
||
(list (string-append #$ntp "/bin/ntpd") "-n"
|
||
"-c" #$ntpd.conf "-u" "ntpd"
|
||
#$@(if allow-large-adjustment?
|
||
'("-g")
|
||
'()))))
|
||
(stop #~(make-kill-destructor))))))))
|
||
|
||
(define %ntp-accounts
|
||
(list (user-account
|
||
(name "ntpd")
|
||
(group "nogroup")
|
||
(system? #t)
|
||
(comment "NTP daemon user")
|
||
(home-directory "/var/empty")
|
||
(shell (file-append shadow "/sbin/nologin")))))
|
||
|
||
|
||
(define (ntp-service-activation config)
|
||
"Return the activation gexp for CONFIG."
|
||
(with-imported-modules '((guix build utils))
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
(define %user
|
||
(getpw "ntpd"))
|
||
|
||
(let ((directory "/var/run/ntpd"))
|
||
(mkdir-p directory)
|
||
(chown directory (passwd:uid %user) (passwd:gid %user))))))
|
||
|
||
(define ntp-service-type
|
||
(service-type (name 'ntp)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
ntp-shepherd-service)
|
||
(service-extension account-service-type
|
||
(const %ntp-accounts))
|
||
(service-extension activation-service-type
|
||
ntp-service-activation)))))
|
||
|
||
(define* (ntp-service #:key (ntp ntp)
|
||
(servers %ntp-servers)
|
||
allow-large-adjustment?)
|
||
"Return a service that runs the daemon from @var{ntp}, the
|
||
@uref{http://www.ntp.org, Network Time Protocol package}. The daemon will
|
||
keep the system clock synchronized with that of @var{servers}.
|
||
@var{allow-large-adjustment?} determines whether @command{ntpd} is allowed to
|
||
make an initial adjustment of more than 1,000 seconds."
|
||
(service ntp-service-type
|
||
(ntp-configuration (ntp ntp)
|
||
(servers servers)
|
||
(allow-large-adjustment?
|
||
allow-large-adjustment?))))
|
||
|
||
|
||
;;;
|
||
;;; Inetd.
|
||
;;;
|
||
|
||
(define-record-type* <inetd-configuration> inetd-configuration
|
||
make-inetd-configuration
|
||
inetd-configuration?
|
||
(program inetd-configuration-program ;file-like
|
||
(default (file-append inetutils "/libexec/inetd")))
|
||
(entries inetd-configuration-entries ;list of <inetd-entry>
|
||
(default '())))
|
||
|
||
(define-record-type* <inetd-entry> inetd-entry make-inetd-entry
|
||
inetd-entry?
|
||
(node inetd-entry-node ;string or #f
|
||
(default #f))
|
||
(name inetd-entry-name) ;string, from /etc/services
|
||
|
||
(socket-type inetd-entry-socket-type) ;stream | dgram | raw |
|
||
;rdm | seqpacket
|
||
(protocol inetd-entry-protocol) ;string, from /etc/protocols
|
||
|
||
(wait? inetd-entry-wait? ;Boolean
|
||
(default #t))
|
||
(user inetd-entry-user) ;string
|
||
|
||
(program inetd-entry-program ;string or file-like object
|
||
(default "internal"))
|
||
(arguments inetd-entry-arguments ;list of strings or file-like objects
|
||
(default '())))
|
||
|
||
(define (inetd-config-file entries)
|
||
(apply mixed-text-file "inetd.conf"
|
||
(map
|
||
(lambda (entry)
|
||
(let* ((node (inetd-entry-node entry))
|
||
(name (inetd-entry-name entry))
|
||
(socket
|
||
(if node (string-append node ":" name) name))
|
||
(type
|
||
(match (inetd-entry-socket-type entry)
|
||
((or 'stream 'dgram 'raw 'rdm 'seqpacket)
|
||
(symbol->string (inetd-entry-socket-type entry)))))
|
||
(protocol (inetd-entry-protocol entry))
|
||
(wait (if (inetd-entry-wait? entry) "wait" "nowait"))
|
||
(user (inetd-entry-user entry))
|
||
(program (inetd-entry-program entry))
|
||
(args (inetd-entry-arguments entry)))
|
||
#~(string-append
|
||
(string-join
|
||
(list #$@(list socket type protocol wait user program) #$@args)
|
||
" ") "\n")))
|
||
entries)))
|
||
|
||
(define inetd-shepherd-service
|
||
(match-lambda
|
||
(($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
|
||
(($ <inetd-configuration> program entries)
|
||
(list
|
||
(shepherd-service
|
||
(documentation "Run inetd.")
|
||
(provision '(inetd))
|
||
(requirement '(user-processes networking syslogd))
|
||
(start #~(make-forkexec-constructor
|
||
(list #$program #$(inetd-config-file entries))
|
||
#:pid-file "/var/run/inetd.pid"))
|
||
(stop #~(make-kill-destructor)))))))
|
||
|
||
(define-public inetd-service-type
|
||
(service-type
|
||
(name 'inetd)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
inetd-shepherd-service)))
|
||
|
||
;; The service can be extended with additional lists of entries.
|
||
(compose concatenate)
|
||
(extend (lambda (config entries)
|
||
(inetd-configuration
|
||
(inherit config)
|
||
(entries (append (inetd-configuration-entries config)
|
||
entries)))))))
|
||
|
||
|
||
;;;
|
||
;;; Tor.
|
||
;;;
|
||
|
||
(define-record-type* <tor-configuration>
|
||
tor-configuration make-tor-configuration
|
||
tor-configuration?
|
||
(tor tor-configuration-tor
|
||
(default tor))
|
||
(config-file tor-configuration-config-file
|
||
(default (plain-file "empty" "")))
|
||
(hidden-services tor-configuration-hidden-services
|
||
(default '())))
|
||
|
||
(define %tor-accounts
|
||
;; User account and groups for Tor.
|
||
(list (user-group (name "tor") (system? #t))
|
||
(user-account
|
||
(name "tor")
|
||
(group "tor")
|
||
(system? #t)
|
||
(comment "Tor daemon user")
|
||
(home-directory "/var/empty")
|
||
(shell (file-append shadow "/sbin/nologin")))))
|
||
|
||
(define-record-type <hidden-service>
|
||
(hidden-service name mapping)
|
||
hidden-service?
|
||
(name hidden-service-name) ;string
|
||
(mapping hidden-service-mapping)) ;list of port/address tuples
|
||
|
||
(define (tor-configuration->torrc config)
|
||
"Return a 'torrc' file for CONFIG."
|
||
(match config
|
||
(($ <tor-configuration> tor config-file services)
|
||
(computed-file
|
||
"torrc"
|
||
(with-imported-modules '((guix build utils))
|
||
#~(begin
|
||
(use-modules (guix build utils)
|
||
(ice-9 match))
|
||
|
||
(call-with-output-file #$output
|
||
(lambda (port)
|
||
(display "\
|
||
# The beginning was automatically added.
|
||
User tor
|
||
DataDirectory /var/lib/tor
|
||
Log notice syslog\n" port)
|
||
|
||
(for-each (match-lambda
|
||
((service (ports hosts) ...)
|
||
(format port "\
|
||
HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
|
||
service)
|
||
(for-each (lambda (tcp-port host)
|
||
(format port "\
|
||
HiddenServicePort ~a ~a~%"
|
||
tcp-port host))
|
||
ports hosts)))
|
||
'#$(map (match-lambda
|
||
(($ <hidden-service> name mapping)
|
||
(cons name mapping)))
|
||
services))
|
||
|
||
;; Append the user's config file.
|
||
(call-with-input-file #$config-file
|
||
(lambda (input)
|
||
(dump-port input port)))
|
||
#t))))))))
|
||
|
||
(define (tor-shepherd-service config)
|
||
"Return a <shepherd-service> running TOR."
|
||
(match config
|
||
(($ <tor-configuration> tor)
|
||
(let ((torrc (tor-configuration->torrc config)))
|
||
(with-imported-modules (source-module-closure
|
||
'((gnu build shepherd)
|
||
(gnu system file-systems)))
|
||
(list (shepherd-service
|
||
(provision '(tor))
|
||
|
||
;; Tor needs at least one network interface to be up, hence the
|
||
;; dependency on 'loopback'.
|
||
(requirement '(user-processes loopback syslogd))
|
||
|
||
(modules '((gnu build shepherd)
|
||
(gnu system file-systems)))
|
||
|
||
(start #~(make-forkexec-constructor/container
|
||
(list #$(file-append tor "/bin/tor") "-f" #$torrc)
|
||
|
||
#:mappings (list (file-system-mapping
|
||
(source "/var/lib/tor")
|
||
(target source)
|
||
(writable? #t))
|
||
(file-system-mapping
|
||
(source "/dev/log") ;for syslog
|
||
(target source)))))
|
||
(stop #~(make-kill-destructor))
|
||
(documentation "Run the Tor anonymous network overlay."))))))))
|
||
|
||
(define (tor-hidden-service-activation config)
|
||
"Return the activation gexp for SERVICES, a list of hidden services."
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
|
||
(define %user
|
||
(getpw "tor"))
|
||
|
||
(define (initialize service)
|
||
(let ((directory (string-append "/var/lib/tor/hidden-services/"
|
||
service)))
|
||
(mkdir-p directory)
|
||
(chown directory (passwd:uid %user) (passwd:gid %user))
|
||
|
||
;; The daemon bails out if we give wider permissions.
|
||
(chmod directory #o700)))
|
||
|
||
(mkdir-p "/var/lib/tor")
|
||
(chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
|
||
(chmod "/var/lib/tor" #o700)
|
||
|
||
;; Make sure /var/lib is accessible to the 'tor' user.
|
||
(chmod "/var/lib" #o755)
|
||
|
||
(for-each initialize
|
||
'#$(map hidden-service-name
|
||
(tor-configuration-hidden-services config)))))
|
||
|
||
(define tor-service-type
|
||
(service-type (name 'tor)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
tor-shepherd-service)
|
||
(service-extension account-service-type
|
||
(const %tor-accounts))
|
||
(service-extension activation-service-type
|
||
tor-hidden-service-activation)))
|
||
|
||
;; This can be extended with hidden services.
|
||
(compose concatenate)
|
||
(extend (lambda (config services)
|
||
(tor-configuration
|
||
(inherit config)
|
||
(hidden-services
|
||
(append (tor-configuration-hidden-services config)
|
||
services)))))
|
||
(default-value (tor-configuration))))
|
||
|
||
(define* (tor-service #:optional
|
||
(config-file (plain-file "empty" ""))
|
||
#:key (tor tor))
|
||
"Return a service to run the @uref{https://torproject.org, Tor} anonymous
|
||
networking daemon.
|
||
|
||
The daemon runs as the @code{tor} unprivileged user. It is passed
|
||
@var{config-file}, a file-like object, with an additional @code{User tor} line
|
||
and lines for hidden services added via @code{tor-hidden-service}. Run
|
||
@command{man tor} for information about the configuration file."
|
||
(service tor-service-type
|
||
(tor-configuration (tor tor)
|
||
(config-file config-file))))
|
||
|
||
(define tor-hidden-service-type
|
||
;; A type that extends Tor with hidden services.
|
||
(service-type (name 'tor-hidden-service)
|
||
(extensions
|
||
(list (service-extension tor-service-type list)))))
|
||
|
||
(define (tor-hidden-service name mapping)
|
||
"Define a new Tor @dfn{hidden service} called @var{name} and implementing
|
||
@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
|
||
|
||
@example
|
||
'((22 \"127.0.0.1:22\")
|
||
(80 \"127.0.0.1:8080\"))
|
||
@end example
|
||
|
||
In this example, port 22 of the hidden service is mapped to local port 22, and
|
||
port 80 is mapped to local port 8080.
|
||
|
||
This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
|
||
the @file{hostname} file contains the @code{.onion} host name for the hidden
|
||
service.
|
||
|
||
See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
|
||
project's documentation} for more information."
|
||
(service tor-hidden-service-type
|
||
(hidden-service name mapping)))
|
||
|
||
|
||
;;;
|
||
;;; BitlBee.
|
||
;;;
|
||
|
||
(define-record-type* <bitlbee-configuration>
|
||
bitlbee-configuration make-bitlbee-configuration
|
||
bitlbee-configuration?
|
||
(bitlbee bitlbee-configuration-bitlbee
|
||
(default bitlbee))
|
||
(interface bitlbee-configuration-interface
|
||
(default "127.0.0.1"))
|
||
(port bitlbee-configuration-port
|
||
(default 6667))
|
||
(extra-settings bitlbee-configuration-extra-settings
|
||
(default "")))
|
||
|
||
(define bitlbee-shepherd-service
|
||
(match-lambda
|
||
(($ <bitlbee-configuration> bitlbee interface port extra-settings)
|
||
(let ((conf (plain-file "bitlbee.conf"
|
||
(string-append "
|
||
[settings]
|
||
User = bitlbee
|
||
ConfigDir = /var/lib/bitlbee
|
||
DaemonInterface = " interface "
|
||
DaemonPort = " (number->string port) "
|
||
" extra-settings))))
|
||
|
||
(with-imported-modules (source-module-closure
|
||
'((gnu build shepherd)
|
||
(gnu system file-systems)))
|
||
(list (shepherd-service
|
||
(provision '(bitlbee))
|
||
|
||
;; Note: If networking is not up, then /etc/resolv.conf
|
||
;; doesn't get mapped in the container, hence the dependency
|
||
;; on 'networking'.
|
||
(requirement '(user-processes networking))
|
||
|
||
(modules '((gnu build shepherd)
|
||
(gnu system file-systems)))
|
||
(start #~(make-forkexec-constructor/container
|
||
(list #$(file-append bitlbee "/sbin/bitlbee")
|
||
"-n" "-F" "-u" "bitlbee" "-c" #$conf)
|
||
|
||
#:pid-file "/var/run/bitlbee.pid"
|
||
#:mappings (list (file-system-mapping
|
||
(source "/var/lib/bitlbee")
|
||
(target source)
|
||
(writable? #t)))))
|
||
(stop #~(make-kill-destructor)))))))))
|
||
|
||
(define %bitlbee-accounts
|
||
;; User group and account to run BitlBee.
|
||
(list (user-group (name "bitlbee") (system? #t))
|
||
(user-account
|
||
(name "bitlbee")
|
||
(group "bitlbee")
|
||
(system? #t)
|
||
(comment "BitlBee daemon user")
|
||
(home-directory "/var/empty")
|
||
(shell (file-append shadow "/sbin/nologin")))))
|
||
|
||
(define %bitlbee-activation
|
||
;; Activation gexp for BitlBee.
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
|
||
;; This directory is used to store OTR data.
|
||
(mkdir-p "/var/lib/bitlbee")
|
||
(let ((user (getpwnam "bitlbee")))
|
||
(chown "/var/lib/bitlbee"
|
||
(passwd:uid user) (passwd:gid user)))))
|
||
|
||
(define bitlbee-service-type
|
||
(service-type (name 'bitlbee)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
bitlbee-shepherd-service)
|
||
(service-extension account-service-type
|
||
(const %bitlbee-accounts))
|
||
(service-extension activation-service-type
|
||
(const %bitlbee-activation))))
|
||
(default-value (bitlbee-configuration))))
|
||
|
||
(define* (bitlbee-service #:key (bitlbee bitlbee)
|
||
(interface "127.0.0.1") (port 6667)
|
||
(extra-settings ""))
|
||
"Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
|
||
acts as a gateway between IRC and chat networks.
|
||
|
||
The daemon will listen to the interface corresponding to the IP address
|
||
specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only
|
||
local clients can connect, whereas @code{0.0.0.0} means that connections can
|
||
come from any networking interface.
|
||
|
||
In addition, @var{extra-settings} specifies a string to append to the
|
||
configuration file."
|
||
(service bitlbee-service-type
|
||
(bitlbee-configuration
|
||
(bitlbee bitlbee)
|
||
(interface interface) (port port)
|
||
(extra-settings extra-settings))))
|
||
|
||
|
||
;;;
|
||
;;; Wicd.
|
||
;;;
|
||
|
||
(define %wicd-activation
|
||
;; Activation gexp for Wicd.
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
|
||
(mkdir-p "/etc/wicd")
|
||
(let ((file-name "/etc/wicd/dhclient.conf.template.default"))
|
||
(unless (file-exists? file-name)
|
||
(copy-file (string-append #$wicd file-name)
|
||
file-name)))
|
||
|
||
;; Wicd invokes 'wpa_supplicant', which needs this directory for its
|
||
;; named socket files.
|
||
(mkdir-p "/var/run/wpa_supplicant")
|
||
(chmod "/var/run/wpa_supplicant" #o750)))
|
||
|
||
(define (wicd-shepherd-service wicd)
|
||
"Return a shepherd service for WICD."
|
||
(list (shepherd-service
|
||
(documentation "Run the Wicd network manager.")
|
||
(provision '(networking))
|
||
(requirement '(user-processes dbus-system loopback))
|
||
(start #~(make-forkexec-constructor
|
||
(list (string-append #$wicd "/sbin/wicd")
|
||
"--no-daemon")))
|
||
(stop #~(make-kill-destructor)))))
|
||
|
||
(define wicd-service-type
|
||
(service-type (name 'wicd)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
wicd-shepherd-service)
|
||
(service-extension dbus-root-service-type
|
||
list)
|
||
(service-extension activation-service-type
|
||
(const %wicd-activation))
|
||
|
||
;; Add Wicd to the global profile.
|
||
(service-extension profile-service-type list)))))
|
||
|
||
(define* (wicd-service #:key (wicd wicd))
|
||
"Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
|
||
management daemon that aims to simplify wired and wireless networking.
|
||
|
||
This service adds the @var{wicd} package to the global profile, providing
|
||
several commands to interact with the daemon and configure networking:
|
||
@command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
|
||
and @command{wicd-curses} user interfaces."
|
||
(service wicd-service-type wicd))
|
||
|
||
|
||
;;;
|
||
;;; NetworkManager
|
||
;;;
|
||
|
||
(define-record-type* <network-manager-configuration>
|
||
network-manager-configuration make-network-manager-configuration
|
||
network-manager-configuration?
|
||
(network-manager network-manager-configuration-network-manager
|
||
(default network-manager))
|
||
(dns network-manager-configuration-dns
|
||
(default "default")))
|
||
|
||
(define %network-manager-activation
|
||
;; Activation gexp for NetworkManager.
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
(mkdir-p "/etc/NetworkManager/system-connections")))
|
||
|
||
(define network-manager-shepherd-service
|
||
(match-lambda
|
||
(($ <network-manager-configuration> network-manager dns)
|
||
(let
|
||
((conf (plain-file "NetworkManager.conf"
|
||
(string-append "
|
||
[main]
|
||
dns=" dns "
|
||
"))))
|
||
(list (shepherd-service
|
||
(documentation "Run the NetworkManager.")
|
||
(provision '(networking))
|
||
(requirement '(user-processes dbus-system wpa-supplicant loopback))
|
||
(start #~(make-forkexec-constructor
|
||
(list (string-append #$network-manager
|
||
"/sbin/NetworkManager")
|
||
(string-append "--config=" #$conf)
|
||
"--no-daemon")))
|
||
(stop #~(make-kill-destructor))))))))
|
||
|
||
(define network-manager-service-type
|
||
(let
|
||
((config->package
|
||
(match-lambda
|
||
(($ <network-manager-configuration> network-manager)
|
||
(list network-manager)))))
|
||
|
||
(service-type
|
||
(name 'network-manager)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
network-manager-shepherd-service)
|
||
(service-extension dbus-root-service-type config->package)
|
||
(service-extension polkit-service-type config->package)
|
||
(service-extension activation-service-type
|
||
(const %network-manager-activation))
|
||
;; Add network-manager to the system profile.
|
||
(service-extension profile-service-type config->package))))))
|
||
|
||
|
||
;;;
|
||
;;; Connman
|
||
;;;
|
||
|
||
(define-record-type* <connman-configuration>
|
||
connman-configuration make-connman-configuration
|
||
connman-configuration?
|
||
(connman connman-configuration-connman
|
||
(default connman))
|
||
(disable-vpn? connman-configuration-disable-vpn?
|
||
(default #f)))
|
||
|
||
(define (connman-activation config)
|
||
(let ((disable-vpn? (connman-configuration-disable-vpn? config)))
|
||
(with-imported-modules '((guix build utils))
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
(mkdir-p "/var/lib/connman/")
|
||
(unless #$disable-vpn?
|
||
(mkdir-p "/var/lib/connman-vpn/"))))))
|
||
|
||
(define (connman-shepherd-service config)
|
||
"Return a shepherd service for Connman"
|
||
(and
|
||
(connman-configuration? config)
|
||
(let ((connman (connman-configuration-connman config))
|
||
(disable-vpn? (connman-configuration-disable-vpn? config)))
|
||
(list (shepherd-service
|
||
(documentation "Run Connman")
|
||
(provision '(networking))
|
||
(requirement
|
||
'(user-processes dbus-system loopback wpa-supplicant))
|
||
(start #~(make-forkexec-constructor
|
||
(list (string-append #$connman
|
||
"/sbin/connmand")
|
||
"-n" "-r"
|
||
#$@(if disable-vpn? '("--noplugin=vpn") '()))))
|
||
(stop #~(make-kill-destructor)))))))
|
||
|
||
(define connman-service-type
|
||
(let ((connman-package (compose list connman-configuration-connman)))
|
||
(service-type (name 'connman)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
connman-shepherd-service)
|
||
(service-extension dbus-root-service-type
|
||
connman-package)
|
||
(service-extension activation-service-type
|
||
connman-activation)
|
||
;; Add connman to the system profile.
|
||
(service-extension profile-service-type
|
||
connman-package))))))
|
||
|
||
|
||
;;;
|
||
;;; WPA supplicant
|
||
;;;
|
||
|
||
|
||
(define (wpa-supplicant-shepherd-service wpa-supplicant)
|
||
"Return a shepherd service for wpa_supplicant"
|
||
(list (shepherd-service
|
||
(documentation "Run WPA supplicant with dbus interface")
|
||
(provision '(wpa-supplicant))
|
||
(requirement '(user-processes dbus-system loopback))
|
||
(start #~(make-forkexec-constructor
|
||
(list (string-append #$wpa-supplicant
|
||
"/sbin/wpa_supplicant")
|
||
"-u" "-B" "-P/var/run/wpa_supplicant.pid")
|
||
#:pid-file "/var/run/wpa_supplicant.pid"))
|
||
(stop #~(make-kill-destructor)))))
|
||
|
||
(define wpa-supplicant-service-type
|
||
(service-type (name 'wpa-supplicant)
|
||
(extensions
|
||
(list (service-extension shepherd-root-service-type
|
||
wpa-supplicant-shepherd-service)
|
||
(service-extension dbus-root-service-type list)
|
||
(service-extension profile-service-type list)))
|
||
(default-value wpa-supplicant)))
|
||
|
||
|
||
;;;
|
||
;;; Open vSwitch
|
||
;;;
|
||
|
||
(define-record-type* <openvswitch-configuration>
|
||
openvswitch-configuration make-openvswitch-configuration
|
||
openvswitch-configuration?
|
||
(package openvswitch-configuration-package
|
||
(default openvswitch)))
|
||
|
||
(define openvswitch-activation
|
||
(match-lambda
|
||
(($ <openvswitch-configuration> package)
|
||
(let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
|
||
(with-imported-modules '((guix build utils))
|
||
#~(begin
|
||
(use-modules (guix build utils))
|
||
(mkdir-p "/var/run/openvswitch")
|
||
(mkdir-p "/var/lib/openvswitch")
|
||
(let ((conf.db "/var/lib/openvswitch/conf.db"))
|
||
(unless (file-exists? conf.db)
|
||
(system* #$ovsdb-tool "create" conf.db)))))))))
|
||
|
||
(define openvswitch-shepherd-service
|
||
(match-lambda
|
||
(($ <openvswitch-configuration> package)
|
||
(let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
|
||
(ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
|
||
(list
|
||
(shepherd-service
|
||
(provision '(ovsdb))
|
||
(documentation "Run the Open vSwitch database server.")
|
||
(start #~(make-forkexec-constructor
|
||
(list #$ovsdb-server "--pidfile"
|
||
"--remote=punix:/var/run/openvswitch/db.sock")
|
||
#:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
|
||
(stop #~(make-kill-destructor)))
|
||
(shepherd-service
|
||
(provision '(vswitchd))
|
||
(requirement '(ovsdb))
|
||
(documentation "Run the Open vSwitch daemon.")
|
||
(start #~(make-forkexec-constructor
|
||
(list #$ovs-vswitchd "--pidfile")
|
||
#:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
|
||
(stop #~(make-kill-destructor))))))))
|
||
|
||
(define openvswitch-service-type
|
||
(service-type
|
||
(name 'openvswitch)
|
||
(extensions
|
||
(list (service-extension activation-service-type
|
||
openvswitch-activation)
|
||
(service-extension profile-service-type
|
||
(compose list openvswitch-configuration-package))
|
||
(service-extension shepherd-root-service-type
|
||
openvswitch-shepherd-service)))))
|
||
|
||
;;; networking.scm ends here
|