1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (gnu services networking)
21 #:use-module (gnu services)
22 #:use-module (gnu system shadow)
23 #:use-module (gnu packages admin)
24 #:use-module (gnu packages linux)
25 #:use-module (gnu packages tor)
26 #:use-module (gnu packages messaging)
27 #:use-module (gnu packages ntp)
28 #:use-module (gnu packages wicd)
29 #:use-module (guix gexp)
30 #:use-module (guix store)
31 #:use-module (guix monads)
32 #:use-module (srfi srfi-26)
33 #:export (%facebook-host-aliases
34 static-networking-service
44 ;;; Networking services.
48 (define %facebook-host-aliases
49 ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
52 # Block Facebook IPv4.
53 127.0.0.1 www.facebook.com
54 127.0.0.1 facebook.com
55 127.0.0.1 login.facebook.com
56 127.0.0.1 www.login.facebook.com
58 127.0.0.1 www.fbcdn.net
60 127.0.0.1 www.fbcdn.com
61 127.0.0.1 static.ak.fbcdn.net
62 127.0.0.1 static.ak.connect.facebook.com
63 127.0.0.1 connect.facebook.net
64 127.0.0.1 www.connect.facebook.net
65 127.0.0.1 apps.facebook.com
67 # Block Facebook IPv6.
68 fe80::1%lo0 facebook.com
69 fe80::1%lo0 login.facebook.com
70 fe80::1%lo0 www.login.facebook.com
72 fe80::1%lo0 www.fbcdn.net
74 fe80::1%lo0 www.fbcdn.com
75 fe80::1%lo0 static.ak.fbcdn.net
76 fe80::1%lo0 static.ak.connect.facebook.com
77 fe80::1%lo0 connect.facebook.net
78 fe80::1%lo0 www.connect.facebook.net
79 fe80::1%lo0 apps.facebook.com\n")
82 (define* (static-networking-service interface ip
85 (provision '(networking))
87 (net-tools net-tools))
88 "Return a service that starts @var{interface} with address @var{ip}. If
89 @var{gateway} is true, it must be a string specifying the default network
92 (memq 'loopback provision))
94 ;; TODO: Eventually replace 'route' with bindings for the appropriate
96 (with-monad %store-monad
100 ;; Unless we're providing the loopback interface, wait for udev to be up
101 ;; and running so that INTERFACE is actually usable.
102 (requirement (if loopback? '() '(udev)))
105 "Bring up the networking interface using a static IP address.")
106 (provision provision)
108 ;; Return #t if successfully started.
109 (let* ((addr (inet-pton AF_INET #$ip))
110 (sockaddr (make-socket-address AF_INET addr 0)))
111 (configure-network-interface #$interface sockaddr
117 #~(zero? (system* (string-append #$net-tools
119 "add" "-net" "default"
122 #$(if (pair? name-servers)
123 #~(call-with-output-file "/etc/resolv.conf"
126 "# Generated by 'static-networking-service'.\n"
128 (for-each (lambda (server)
129 (format port "nameserver ~a~%"
134 ;; Return #f is successfully stopped.
135 (let ((sock (socket AF_INET SOCK_STREAM 0)))
136 (set-network-interface-flags sock #$interface 0)
139 #~(system* (string-append #$net-tools
141 "del" "-net" "default")
145 (define* (dhcp-client-service #:key (dhcp isc-dhcp))
146 "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
147 Protocol (DHCP) client, on all the non-loopback network interfaces."
150 #~(string-append #$dhcp "/sbin/dhclient"))
153 "/var/run/dhclient.pid")
155 (with-monad %store-monad
157 (documentation "Set up networking via DHCP.")
158 (requirement '(user-processes udev))
160 ;; XXX: Running with '-nw' ("no wait") avoids blocking for a
161 ;; minute when networking is unavailable, but also means that the
162 ;; interface is not up yet when 'start' completes. To wait for
163 ;; the interface to be ready, one should instead monitor udev
165 (provision '(networking))
168 ;; When invoked without any arguments, 'dhclient'
169 ;; discovers all non-loopback interfaces *that are
170 ;; up*. However, the relevant interfaces are
171 ;; typically down at this point. Thus we perform our
172 ;; own interface discovery here.
174 (negate loopback-network-interface?))
176 (filter valid? (all-network-interfaces)))
178 ;; XXX: Make sure the interfaces are up so that
179 ;; 'dhclient' can actually send/receive over them.
180 (for-each set-network-interface-up ifaces)
182 (false-if-exception (delete-file #$pid-file))
183 (let ((pid (fork+exec-command
184 (cons* #$dhclient "-nw"
185 "-pf" #$pid-file ifaces))))
186 (and (zero? (cdr (waitpid pid)))
190 (call-with-input-file #$pid-file read))
192 ;; 'dhclient' returned before PID-FILE
193 ;; was created, so try again.
194 (let ((errno (system-error-errno args)))
199 (apply throw args))))))))))
200 (stop #~(make-kill-destructor))))))
203 ;; Default set of NTP servers.
208 (define* (ntp-service #:key (ntp ntp)
209 (servers %ntp-servers))
210 "Return a service that runs the daemon from @var{ntp}, the
211 @uref{http://www.ntp.org, Network Time Protocol package}. The daemon will
212 keep the system clock synchronized with that of @var{servers}."
213 ;; TODO: Add authentication support.
216 (string-append "driftfile /var/run/ntp.drift\n"
217 (string-join (map (cut string-append "server " <>)
221 # Disable status queries as a workaround for CVE-2013-5211:
222 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
223 restrict default kod nomodify notrap nopeer noquery
224 restrict -6 default kod nomodify notrap nopeer noquery
226 # Yet, allow use of the local 'ntpq'.
230 (mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config)))
234 (documentation "Run the Network Time Protocol (NTP) daemon.")
235 (requirement '(user-processes networking))
236 (start #~(make-forkexec-constructor
237 (list (string-append #$ntp "/bin/ntpd") "-n"
240 (stop #~(make-kill-destructor))
241 (user-accounts (list (user-account
245 (comment "NTP daemon user")
246 (home-directory "/var/empty")
248 #~(string-append #$shadow "/sbin/nologin")))))))))
250 (define* (tor-service #:key (tor tor))
251 "Return a service to run the @uref{https://torproject.org,Tor} daemon.
253 The daemon runs with the default settings (in particular the default exit
254 policy) as the @code{tor} unprivileged user."
255 (mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
260 ;; Tor needs at least one network interface to be up, hence the
261 ;; dependency on 'loopback'.
262 (requirement '(user-processes loopback))
264 (start #~(make-forkexec-constructor
265 (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
266 (stop #~(make-kill-destructor))
268 (user-groups (list (user-group
271 (user-accounts (list (user-account
275 (comment "Tor daemon user")
276 (home-directory "/var/empty")
278 #~(string-append #$shadow "/sbin/nologin")))))
280 (documentation "Run the Tor anonymous network overlay.")))))
282 (define* (bitlbee-service #:key (bitlbee bitlbee)
283 (interface "127.0.0.1") (port 6667)
285 "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
286 acts as a gateway between IRC and chat networks.
288 The daemon will listen to the interface corresponding to the IP address
289 specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only
290 local clients can connect, whereas @code{0.0.0.0} means that connections can
291 come from any networking interface.
293 In addition, @var{extra-settings} specifies a string to append to the
295 (mlet %store-monad ((conf (text-file "bitlbee.conf"
299 ConfigDir = /var/lib/bitlbee
300 DaemonInterface = " interface "
301 DaemonPort = " (number->string port) "
305 (provision '(bitlbee))
306 (requirement '(user-processes loopback))
308 (use-modules (guix build utils))
310 ;; This directory is used to store OTR data.
311 (mkdir-p "/var/lib/bitlbee")
312 (let ((user (getpwnam "bitlbee")))
313 (chown "/var/lib/bitlbee"
314 (passwd:uid user) (passwd:gid user)))))
315 (start #~(make-forkexec-constructor
316 (list (string-append #$bitlbee "/sbin/bitlbee")
317 "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
318 (stop #~(make-kill-destructor))
319 (user-groups (list (user-group (name "bitlbee") (system? #t))))
320 (user-accounts (list (user-account
324 (comment "BitlBee daemon user")
325 (home-directory "/var/empty")
326 (shell #~(string-append #$shadow
327 "/sbin/nologin")))))))))
329 (define* (wicd-service #:key (wicd wicd))
330 "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
331 manager that aims to simplify wired and wireless networking."
332 (with-monad %store-monad
335 (documentation "Run the Wicd network manager.")
336 (provision '(networking))
337 (requirement '(user-processes dbus-system loopback))
338 (start #~(make-forkexec-constructor
339 (list (string-append #$wicd "/sbin/wicd")
341 (stop #~(make-kill-destructor))
344 (use-modules (guix build utils))
345 (mkdir-p "/etc/wicd")
346 (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
347 (unless (file-exists? file-name)
348 (copy-file (string-append #$wicd file-name)
351 ;;; networking.scm ends here