Commit | Line | Data |
---|---|---|
db4fdc04 | 1 | ;;; GNU Guix --- Functional package management for GNU |
e87f0591 | 2 | ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> |
b7d0c494 | 3 | ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> |
db4fdc04 LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
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. | |
11 | ;;; | |
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. | |
16 | ;;; | |
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/>. | |
19 | ||
20 | (define-module (gnu services networking) | |
21 | #:use-module (gnu services) | |
927097ef | 22 | #:use-module (gnu system shadow) |
db4fdc04 LC |
23 | #:use-module (gnu packages admin) |
24 | #:use-module (gnu packages linux) | |
927097ef | 25 | #:use-module (gnu packages tor) |
4627a464 | 26 | #:use-module (gnu packages messaging) |
63854bcb | 27 | #:use-module (gnu packages ntp) |
b7d0c494 | 28 | #:use-module (gnu packages wicd) |
b5f4e686 | 29 | #:use-module (guix gexp) |
e87f0591 | 30 | #:use-module (guix store) |
db4fdc04 | 31 | #:use-module (guix monads) |
63854bcb | 32 | #:use-module (srfi srfi-26) |
fa0c1d61 LC |
33 | #:export (%facebook-host-aliases |
34 | static-networking-service | |
a023cca8 | 35 | dhcp-client-service |
63854bcb LC |
36 | %ntp-servers |
37 | ntp-service | |
4627a464 | 38 | tor-service |
b7d0c494 MW |
39 | bitlbee-service |
40 | wicd-service)) | |
db4fdc04 LC |
41 | |
42 | ;;; Commentary: | |
43 | ;;; | |
44 | ;;; Networking services. | |
45 | ;;; | |
46 | ;;; Code: | |
47 | ||
fa0c1d61 LC |
48 | (define %facebook-host-aliases |
49 | ;; This is the list of known Facebook hosts to be added to /etc/hosts if you | |
50 | ;; are to block it. | |
51 | "\ | |
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 | |
57 | 127.0.0.1 fbcdn.net | |
58 | 127.0.0.1 www.fbcdn.net | |
59 | 127.0.0.1 fbcdn.com | |
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 | |
66 | ||
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 | |
71 | fe80::1%lo0 fbcdn.net | |
72 | fe80::1%lo0 www.fbcdn.net | |
73 | fe80::1%lo0 fbcdn.com | |
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") | |
80 | ||
81 | ||
db4fdc04 LC |
82 | (define* (static-networking-service interface ip |
83 | #:key | |
84 | gateway | |
4a3b3b07 | 85 | (provision '(networking)) |
db4fdc04 | 86 | (name-servers '()) |
db4fdc04 | 87 | (net-tools net-tools)) |
51da7ca0 LC |
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 | |
90 | gateway." | |
7f5c2a9c LC |
91 | (define loopback? |
92 | (memq 'loopback provision)) | |
db4fdc04 | 93 | |
7f5c2a9c LC |
94 | ;; TODO: Eventually replace 'route' with bindings for the appropriate |
95 | ;; ioctls. | |
b5f4e686 | 96 | (with-monad %store-monad |
db4fdc04 LC |
97 | (return |
98 | (service | |
150d8e64 LC |
99 | |
100 | ;; Unless we're providing the loopback interface, wait for udev to be up | |
101 | ;; and running so that INTERFACE is actually usable. | |
7f5c2a9c | 102 | (requirement (if loopback? '() '(udev))) |
150d8e64 | 103 | |
db4fdc04 | 104 | (documentation |
150d8e64 | 105 | "Bring up the networking interface using a static IP address.") |
4a3b3b07 | 106 | (provision provision) |
b5f4e686 LC |
107 | (start #~(lambda _ |
108 | ;; Return #t if successfully started. | |
7f5c2a9c LC |
109 | (let* ((addr (inet-pton AF_INET #$ip)) |
110 | (sockaddr (make-socket-address AF_INET addr 0))) | |
111 | (configure-network-interface #$interface sockaddr | |
112 | (logior IFF_UP | |
113 | #$(if loopback? | |
114 | #~IFF_LOOPBACK | |
115 | 0)))) | |
116 | #$(if gateway | |
117 | #~(zero? (system* (string-append #$net-tools | |
118 | "/sbin/route") | |
119 | "add" "-net" "default" | |
120 | "gw" #$gateway)) | |
121 | #t) | |
122 | #$(if (pair? name-servers) | |
123 | #~(call-with-output-file "/etc/resolv.conf" | |
124 | (lambda (port) | |
125 | (display | |
126 | "# Generated by 'static-networking-service'.\n" | |
127 | port) | |
128 | (for-each (lambda (server) | |
129 | (format port "nameserver ~a~%" | |
130 | server)) | |
131 | '#$name-servers))) | |
132 | #t))) | |
b5f4e686 | 133 | (stop #~(lambda _ |
db4fdc04 | 134 | ;; Return #f is successfully stopped. |
7f5c2a9c LC |
135 | (let ((sock (socket AF_INET SOCK_STREAM 0))) |
136 | (set-network-interface-flags sock #$interface 0) | |
137 | (close-port sock)) | |
138 | (not #$(if gateway | |
139 | #~(system* (string-append #$net-tools | |
140 | "/sbin/route") | |
141 | "del" "-net" "default") | |
142 | #t)))) | |
b5f4e686 | 143 | (respawn? #f))))) |
db4fdc04 | 144 | |
a023cca8 LC |
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." | |
148 | ||
149 | (define dhclient | |
150 | #~(string-append #$dhcp "/sbin/dhclient")) | |
151 | ||
152 | (define pid-file | |
153 | "/var/run/dhclient.pid") | |
154 | ||
155 | (with-monad %store-monad | |
156 | (return (service | |
f02f65ef | 157 | (documentation "Set up networking via DHCP.") |
a023cca8 | 158 | (requirement '(user-processes udev)) |
f02f65ef LC |
159 | |
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 | |
164 | ;; events. | |
a023cca8 | 165 | (provision '(networking)) |
f02f65ef | 166 | |
a023cca8 LC |
167 | (start #~(lambda _ |
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. | |
9bb34f9c LC |
173 | (define valid? |
174 | (negate loopback-network-interface?)) | |
175 | (define ifaces | |
176 | (filter valid? (all-network-interfaces))) | |
177 | ||
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) | |
181 | ||
182 | (false-if-exception (delete-file #$pid-file)) | |
183 | (let ((pid (fork+exec-command | |
184 | (cons* #$dhclient "-nw" | |
185 | "-pf" #$pid-file ifaces)))) | |
a023cca8 | 186 | (and (zero? (cdr (waitpid pid))) |
c217cbd8 LC |
187 | (let loop () |
188 | (catch 'system-error | |
189 | (lambda () | |
190 | (call-with-input-file #$pid-file read)) | |
191 | (lambda args | |
192 | ;; 'dhclient' returned before PID-FILE | |
193 | ;; was created, so try again. | |
194 | (let ((errno (system-error-errno args))) | |
195 | (if (= ENOENT errno) | |
196 | (begin | |
197 | (sleep 1) | |
198 | (loop)) | |
199 | (apply throw args)))))))))) | |
a023cca8 LC |
200 | (stop #~(make-kill-destructor)))))) |
201 | ||
63854bcb LC |
202 | (define %ntp-servers |
203 | ;; Default set of NTP servers. | |
204 | '("0.pool.ntp.org" | |
205 | "1.pool.ntp.org" | |
206 | "2.pool.ntp.org")) | |
207 | ||
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. | |
214 | ||
215 | (define config | |
216 | (string-append "driftfile /var/run/ntp.drift\n" | |
217 | (string-join (map (cut string-append "server " <>) | |
218 | servers) | |
219 | "\n") | |
220 | " | |
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 | |
225 | ||
226 | # Yet, allow use of the local 'ntpq'. | |
227 | restrict 127.0.0.1 | |
228 | restrict -6 ::1\n")) | |
229 | ||
230 | (mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config))) | |
231 | (return | |
232 | (service | |
233 | (provision '(ntpd)) | |
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" | |
238 | "-c" #$ntpd.conf | |
239 | "-u" "ntpd"))) | |
240 | (stop #~(make-kill-destructor)) | |
241 | (user-accounts (list (user-account | |
242 | (name "ntpd") | |
243 | (group "nogroup") | |
244 | (system? #t) | |
245 | (comment "NTP daemon user") | |
246 | (home-directory "/var/empty") | |
247 | (shell | |
5e25ebe2 | 248 | #~(string-append #$shadow "/sbin/nologin"))))))))) |
63854bcb | 249 | |
927097ef LC |
250 | (define* (tor-service #:key (tor tor)) |
251 | "Return a service to run the @uref{https://torproject.org,Tor} daemon. | |
252 | ||
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"))) | |
256 | (return | |
257 | (service | |
258 | (provision '(tor)) | |
259 | ||
260 | ;; Tor needs at least one network interface to be up, hence the | |
261 | ;; dependency on 'loopback'. | |
262 | (requirement '(user-processes loopback)) | |
263 | ||
264 | (start #~(make-forkexec-constructor | |
265 | (list (string-append #$tor "/bin/tor") "-f" #$torrc))) | |
266 | (stop #~(make-kill-destructor)) | |
267 | ||
268 | (user-groups (list (user-group | |
41717509 LC |
269 | (name "tor") |
270 | (system? #t)))) | |
927097ef LC |
271 | (user-accounts (list (user-account |
272 | (name "tor") | |
273 | (group "tor") | |
274 | (system? #t) | |
275 | (comment "Tor daemon user") | |
276 | (home-directory "/var/empty") | |
277 | (shell | |
5e25ebe2 | 278 | #~(string-append #$shadow "/sbin/nologin"))))) |
927097ef LC |
279 | |
280 | (documentation "Run the Tor anonymous network overlay."))))) | |
281 | ||
4627a464 LC |
282 | (define* (bitlbee-service #:key (bitlbee bitlbee) |
283 | (interface "127.0.0.1") (port 6667) | |
284 | (extra-settings "")) | |
285 | "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that | |
286 | acts as a gateway between IRC and chat networks. | |
287 | ||
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. | |
292 | ||
293 | In addition, @var{extra-settings} specifies a string to append to the | |
294 | configuration file." | |
295 | (mlet %store-monad ((conf (text-file "bitlbee.conf" | |
296 | (string-append " | |
297 | [settings] | |
298 | User = bitlbee | |
299 | ConfigDir = /var/lib/bitlbee | |
300 | DaemonInterface = " interface " | |
301 | DaemonPort = " (number->string port) " | |
302 | " extra-settings)))) | |
303 | (return | |
304 | (service | |
305 | (provision '(bitlbee)) | |
306 | (requirement '(user-processes loopback)) | |
9751c39a LC |
307 | (activate #~(begin |
308 | (use-modules (guix build utils)) | |
309 | ||
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))))) | |
4627a464 LC |
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 | |
321 | (name "bitlbee") | |
322 | (group "bitlbee") | |
323 | (system? #t) | |
324 | (comment "BitlBee daemon user") | |
325 | (home-directory "/var/empty") | |
326 | (shell #~(string-append #$shadow | |
327 | "/sbin/nologin"))))))))) | |
328 | ||
b7d0c494 MW |
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 | |
333 | (return | |
334 | (service | |
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") | |
340 | "--no-daemon"))) | |
341 | (stop #~(make-kill-destructor)) | |
342 | (activate | |
343 | #~(begin | |
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) | |
349 | file-name))))))))) | |
350 | ||
db4fdc04 | 351 | ;;; networking.scm ends here |