1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (gnu services networking)
20 #:use-module (gnu services)
21 #:use-module (gnu system shadow)
22 #:use-module (gnu packages admin)
23 #:use-module (gnu packages linux)
24 #:use-module (gnu packages tor)
25 #:use-module (gnu packages messaging)
26 #:use-module (gnu packages ntp)
27 #:use-module (guix gexp)
28 #:use-module (guix store)
29 #:use-module (guix monads)
30 #:use-module (srfi srfi-26)
31 #:export (%facebook-host-aliases
32 static-networking-service
41 ;;; Networking services.
45 (define %facebook-host-aliases
46 ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
49 # Block Facebook IPv4.
50 127.0.0.1 www.facebook.com
51 127.0.0.1 facebook.com
52 127.0.0.1 login.facebook.com
53 127.0.0.1 www.login.facebook.com
55 127.0.0.1 www.fbcdn.net
57 127.0.0.1 www.fbcdn.com
58 127.0.0.1 static.ak.fbcdn.net
59 127.0.0.1 static.ak.connect.facebook.com
60 127.0.0.1 connect.facebook.net
61 127.0.0.1 www.connect.facebook.net
62 127.0.0.1 apps.facebook.com
64 # Block Facebook IPv6.
65 fe80::1%lo0 facebook.com
66 fe80::1%lo0 login.facebook.com
67 fe80::1%lo0 www.login.facebook.com
69 fe80::1%lo0 www.fbcdn.net
71 fe80::1%lo0 www.fbcdn.com
72 fe80::1%lo0 static.ak.fbcdn.net
73 fe80::1%lo0 static.ak.connect.facebook.com
74 fe80::1%lo0 connect.facebook.net
75 fe80::1%lo0 www.connect.facebook.net
76 fe80::1%lo0 apps.facebook.com\n")
79 (define* (static-networking-service interface ip
82 (provision '(networking))
84 (net-tools net-tools))
85 "Return a service that starts @var{interface} with address @var{ip}. If
86 @var{gateway} is true, it must be a string specifying the default network
89 (memq 'loopback provision))
91 ;; TODO: Eventually replace 'route' with bindings for the appropriate
93 (with-monad %store-monad
97 ;; Unless we're providing the loopback interface, wait for udev to be up
98 ;; and running so that INTERFACE is actually usable.
99 (requirement (if loopback? '() '(udev)))
102 "Bring up the networking interface using a static IP address.")
103 (provision provision)
105 ;; Return #t if successfully started.
106 (let* ((addr (inet-pton AF_INET #$ip))
107 (sockaddr (make-socket-address AF_INET addr 0)))
108 (configure-network-interface #$interface sockaddr
114 #~(zero? (system* (string-append #$net-tools
116 "add" "-net" "default"
119 #$(if (pair? name-servers)
120 #~(call-with-output-file "/etc/resolv.conf"
123 "# Generated by 'static-networking-service'.\n"
125 (for-each (lambda (server)
126 (format port "nameserver ~a~%"
131 ;; Return #f is successfully stopped.
132 (let ((sock (socket AF_INET SOCK_STREAM 0)))
133 (set-network-interface-flags sock #$interface 0)
136 #~(system* (string-append #$net-tools
138 "del" "-net" "default")
142 (define* (dhcp-client-service #:key (dhcp isc-dhcp))
143 "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
144 Protocol (DHCP) client, on all the non-loopback network interfaces."
147 #~(string-append #$dhcp "/sbin/dhclient"))
150 "/var/run/dhclient.pid")
152 (with-monad %store-monad
154 (documentation "Set up networking via DHCP.")
155 (requirement '(user-processes udev))
157 ;; XXX: Running with '-nw' ("no wait") avoids blocking for a
158 ;; minute when networking is unavailable, but also means that the
159 ;; interface is not up yet when 'start' completes. To wait for
160 ;; the interface to be ready, one should instead monitor udev
162 (provision '(networking))
165 ;; When invoked without any arguments, 'dhclient'
166 ;; discovers all non-loopback interfaces *that are
167 ;; up*. However, the relevant interfaces are
168 ;; typically down at this point. Thus we perform our
169 ;; own interface discovery here.
170 (let* ((valid? (negate loopback-network-interface?))
171 (ifaces (filter valid?
172 (all-network-interfaces)))
173 (pid (fork+exec-command
174 (cons* #$dhclient "-nw"
177 (and (zero? (cdr (waitpid pid)))
178 (call-with-input-file #$pid-file read)))))
179 (stop #~(make-kill-destructor))))))
182 ;; Default set of NTP servers.
187 (define* (ntp-service #:key (ntp ntp)
188 (servers %ntp-servers))
189 "Return a service that runs the daemon from @var{ntp}, the
190 @uref{http://www.ntp.org, Network Time Protocol package}. The daemon will
191 keep the system clock synchronized with that of @var{servers}."
192 ;; TODO: Add authentication support.
195 (string-append "driftfile /var/run/ntp.drift\n"
196 (string-join (map (cut string-append "server " <>)
200 # Disable status queries as a workaround for CVE-2013-5211:
201 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
202 restrict default kod nomodify notrap nopeer noquery
203 restrict -6 default kod nomodify notrap nopeer noquery
205 # Yet, allow use of the local 'ntpq'.
209 (mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config)))
213 (documentation "Run the Network Time Protocol (NTP) daemon.")
214 (requirement '(user-processes networking))
215 (start #~(make-forkexec-constructor
216 (list (string-append #$ntp "/bin/ntpd") "-n"
219 (stop #~(make-kill-destructor))
220 (user-accounts (list (user-account
224 (comment "NTP daemon user")
225 (home-directory "/var/empty")
227 "/run/current-system/profile/sbin/nologin"))))))))
229 (define* (tor-service #:key (tor tor))
230 "Return a service to run the @uref{https://torproject.org,Tor} daemon.
232 The daemon runs with the default settings (in particular the default exit
233 policy) as the @code{tor} unprivileged user."
234 (mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
239 ;; Tor needs at least one network interface to be up, hence the
240 ;; dependency on 'loopback'.
241 (requirement '(user-processes loopback))
243 (start #~(make-forkexec-constructor
244 (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
245 (stop #~(make-kill-destructor))
247 (user-groups (list (user-group
250 (user-accounts (list (user-account
254 (comment "Tor daemon user")
255 (home-directory "/var/empty")
257 "/run/current-system/profile/sbin/nologin"))))
259 (documentation "Run the Tor anonymous network overlay.")))))
261 (define* (bitlbee-service #:key (bitlbee bitlbee)
262 (interface "127.0.0.1") (port 6667)
264 "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
265 acts as a gateway between IRC and chat networks.
267 The daemon will listen to the interface corresponding to the IP address
268 specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only
269 local clients can connect, whereas @code{0.0.0.0} means that connections can
270 come from any networking interface.
272 In addition, @var{extra-settings} specifies a string to append to the
274 (mlet %store-monad ((conf (text-file "bitlbee.conf"
278 ConfigDir = /var/lib/bitlbee
279 DaemonInterface = " interface "
280 DaemonPort = " (number->string port) "
284 (provision '(bitlbee))
285 (requirement '(user-processes loopback))
286 (start #~(make-forkexec-constructor
287 (list (string-append #$bitlbee "/sbin/bitlbee")
288 "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
289 (stop #~(make-kill-destructor))
290 (user-groups (list (user-group (name "bitlbee") (system? #t))))
291 (user-accounts (list (user-account
295 (comment "BitlBee daemon user")
296 (home-directory "/var/empty")
297 (shell #~(string-append #$shadow
298 "/sbin/nologin")))))))))
300 ;;; networking.scm ends here