;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016, 2018 Efraim Flashner ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2017 Thomas Danckaert ;;; Copyright © 2017 Marius Bakke ;;; ;;; 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 . (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) #: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 dhcp-client-service dhcpd-service-type dhcpd-configuration dhcpd-configuration? dhcpd-configuration-package dhcpd-configuration-config-file dhcpd-configuration-version dhcpd-configuration-run-directory dhcpd-configuration-lease-file dhcpd-configuration-pid-file dhcpd-configuration-interfaces %ntp-servers ntp-configuration ntp-configuration? ntp-service ntp-service-type openntpd-configuration openntpd-configuration? openntpd-service-type inetd-configuration inetd-entry inetd-service-type tor-configuration tor-configuration? tor-hidden-service tor-service tor-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 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-record-type* dhcpd-configuration make-dhcpd-configuration dhcpd-configuration? (package dhcpd-configuration-package ; (default isc-dhcp)) (config-file dhcpd-configuration-config-file ;file-like (default #f)) (version dhcpd-configuration-version ;"4", "6", or "4o6" (default "4")) (run-directory dhcpd-configuration-run-directory (default "/run/dhcpd")) (lease-file dhcpd-configuration-lease-file (default "/var/db/dhcpd.leases")) (pid-file dhcpd-configuration-pid-file (default "/run/dhcpd/dhcpd.pid")) ;; list of strings, e.g. (list "enp0s25") (interfaces dhcpd-configuration-interfaces (default '()))) (define dhcpd-shepherd-service (match-lambda (($ package config-file version run-directory lease-file pid-file interfaces) (unless config-file (error "Must supply a config-file")) (list (shepherd-service ;; Allow users to easily run multiple versions simultaneously. (provision (list (string->symbol (string-append "dhcpv" version "-daemon")))) (documentation (string-append "Run the DHCPv" version " daemon")) (requirement '(networking)) (start #~(make-forkexec-constructor '(#$(file-append package "/sbin/dhcpd") #$(string-append "-" version) "-lf" #$lease-file "-pf" #$pid-file "-cf" #$config-file #$@interfaces) #:pid-file #$pid-file)) (stop #~(make-kill-destructor))))))) (define dhcpd-activation (match-lambda (($ package config-file version run-directory lease-file pid-file interfaces) (with-imported-modules '((guix build utils)) #~(begin (unless (file-exists? #$run-directory) (mkdir #$run-directory)) ;; According to the DHCP manual (man dhcpd.leases), the lease ;; database must be present for dhcpd to start successfully. (unless (file-exists? #$lease-file) (with-output-to-file #$lease-file (lambda _ (display "")))) ;; Validate the config. (invoke #$(file-append package "/sbin/dhcpd") "-t" "-cf" #$config-file)))))) (define dhcpd-service-type (service-type (name 'dhcpd) (extensions (list (service-extension shepherd-root-service-type dhcpd-shepherd-service) (service-extension activation-service-type dhcpd-activation))))) (define %ntp-servers ;; Default set of NTP servers. These URLs are managed by the NTP Pool project. ;; Within Guix, Leo Famulari is the administrative contact ;; for this NTP pool "zone". '("0.guix.pool.ntp.org" "1.guix.pool.ntp.org" "2.guix.pool.ntp.org" "3.guix.pool.ntp.org")) ;;; ;;; NTP. ;;; ;; TODO: Export. (define-record-type* 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 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: # . 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))) (description "Run the @command{ntpd}, the Network Time Protocol (NTP) daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon will keep the system clock synchronized with that of the given servers."))) (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?)))) ;;; ;;; OpenNTPD. ;;; (define-record-type* openntpd-configuration make-openntpd-configuration openntpd-configuration? (openntpd openntpd-configuration-openntpd (default openntpd)) (listen-on openntpd-listen-on (default '("127.0.0.1" "::1"))) (query-from openntpd-query-from (default '())) (sensor openntpd-sensor (default '())) (server openntpd-server (default %ntp-servers)) (servers openntpd-servers (default '())) (constraint-from openntpd-constraint-from (default '())) (constraints-from openntpd-constraints-from (default '())) (allow-large-adjustment? openntpd-allow-large-adjustment? (default #f))) ; upstream default (define (openntpd-shepherd-service config) (match-record config (openntpd listen-on query-from sensor server servers constraint-from constraints-from allow-large-adjustment?) (let () (define config (string-join (filter-map (lambda (field value) (string-join (map (cut string-append field <> "\n") value))) '("listen on " "query from " "sensor " "server " "servers " "constraint from ") (list listen-on query-from sensor server servers constraint-from)) ;; The 'constraints from' field needs to be enclosed in double quotes. (string-join (map (cut string-append "constraints from \"" <> "\"\n") constraints-from)))) (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 #$openntpd "/sbin/ntpd") "-f" #$ntpd.conf "-d" ;; don't daemonize #$@(if allow-large-adjustment? '("-s") '())) ;; When ntpd is daemonized it repeatedly tries to respawn ;; while running, leading shepherd to disable it. To ;; prevent spamming stderr, redirect output to logfile. #:log-file "/var/log/ntpd")) (stop #~(make-kill-destructor))))))) (define (openntpd-service-activation config) "Return the activation gexp for CONFIG." (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) (mkdir-p "/var/db") (mkdir-p "/var/run") (unless (file-exists? "/var/db/ntpd.drift") (with-output-to-file "/var/db/ntpd.drift" (lambda _ (format #t "0.0"))))))) (define openntpd-service-type (service-type (name 'openntpd) (extensions (list (service-extension shepherd-root-service-type openntpd-shepherd-service) (service-extension account-service-type (const %ntp-accounts)) (service-extension activation-service-type openntpd-service-activation))) (default-value (openntpd-configuration)) (description "Run the @command{ntpd}, the Network Time Protocol (NTP) daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The daemon will keep the system clock synchronized with that of the given servers."))) ;;; ;;; Inetd. ;;; (define-record-type* 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 (default '()))) (define-record-type* 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 (($ program ()) '()) ; empty list of entries -> do nothing (($ 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))))) (description "Start @command{inetd}, the @dfn{Internet superserver}. It is responsible for listening on Internet sockets and spawning the corresponding services on demand."))) ;;; ;;; Tor. ;;; (define-record-type* 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 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 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 (($ 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 running TOR." (match config (($ 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)) (description "Run the @uref{https://torproject.org, Tor} anonymous networking daemon."))) (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))) (description "Define a new Tor @dfn{hidden service}."))) (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))) ;;; ;;; 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))) (description "Run @url{https://launchpad.net/wicd,Wicd}, a network management daemon that aims to simplify wired and wireless networking."))) (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 make-network-manager-configuration network-manager-configuration? (network-manager network-manager-configuration-network-manager (default network-manager)) (dns network-manager-configuration-dns (default "default")) (vpn-plugins network-manager-vpn-plugins ;list of (default '()))) (define %network-manager-activation ;; Activation gexp for NetworkManager. #~(begin (use-modules (guix build utils)) (mkdir-p "/etc/NetworkManager/system-connections"))) (define (vpn-plugin-directory plugins) "Return a directory containing PLUGINS, the NM VPN plugins." (directory-union "network-manager-vpn-plugins" plugins)) (define network-manager-environment (match-lambda (($ network-manager dns vpn-plugins) ;; Define this variable in the global environment such that ;; "nmcli connection import type openvpn file foo.ovpn" works. `(("NM_VPN_PLUGIN_DIR" . ,(file-append (vpn-plugin-directory vpn-plugins) "/lib/NetworkManager/VPN")))))) (define network-manager-shepherd-service (match-lambda (($ network-manager dns vpn-plugins) (let ((conf (plain-file "NetworkManager.conf" (string-append "[main]\ndns=" dns "\n"))) (vpn (vpn-plugin-directory vpn-plugins))) (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") #:environment-variables (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn "/lib/NetworkManager/VPN")))) (stop #~(make-kill-destructor)))))))) (define network-manager-service-type (let ((config->package (match-lambda (($ 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)) (service-extension session-environment-service-type network-manager-environment) ;; Add network-manager to the system profile. (service-extension profile-service-type config->package))) (default-value (network-manager-configuration)) (description "Run @uref{https://wiki.gnome.org/Projects/NetworkManager, NetworkManager}, a network management daemon that aims to simplify wired and wireless networking.")))) ;;; ;;; Connman ;;; (define-record-type* 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))) (description "Run @url{https://01.org/connman,Connman}, a network connection manager.")))) ;;; ;;; 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 make-openvswitch-configuration openvswitch-configuration? (package openvswitch-configuration-package (default openvswitch))) (define openvswitch-activation (match-lambda (($ 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 (($ 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))) (description "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual switch designed to enable massive network automation through programmatic extension."))) ;;; networking.scm ends here