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. | |
173 | (let* ((valid? (negate loopback-network-interface?)) | |
174 | (ifaces (filter valid? | |
175 | (all-network-interfaces))) | |
176 | (pid (fork+exec-command | |
f02f65ef LC |
177 | (cons* #$dhclient "-nw" |
178 | "-pf" #$pid-file | |
a023cca8 LC |
179 | ifaces)))) |
180 | (and (zero? (cdr (waitpid pid))) | |
181 | (call-with-input-file #$pid-file read))))) | |
182 | (stop #~(make-kill-destructor)))))) | |
183 | ||
63854bcb LC |
184 | (define %ntp-servers |
185 | ;; Default set of NTP servers. | |
186 | '("0.pool.ntp.org" | |
187 | "1.pool.ntp.org" | |
188 | "2.pool.ntp.org")) | |
189 | ||
190 | (define* (ntp-service #:key (ntp ntp) | |
191 | (servers %ntp-servers)) | |
192 | "Return a service that runs the daemon from @var{ntp}, the | |
193 | @uref{http://www.ntp.org, Network Time Protocol package}. The daemon will | |
194 | keep the system clock synchronized with that of @var{servers}." | |
195 | ;; TODO: Add authentication support. | |
196 | ||
197 | (define config | |
198 | (string-append "driftfile /var/run/ntp.drift\n" | |
199 | (string-join (map (cut string-append "server " <>) | |
200 | servers) | |
201 | "\n") | |
202 | " | |
203 | # Disable status queries as a workaround for CVE-2013-5211: | |
204 | # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>. | |
205 | restrict default kod nomodify notrap nopeer noquery | |
206 | restrict -6 default kod nomodify notrap nopeer noquery | |
207 | ||
208 | # Yet, allow use of the local 'ntpq'. | |
209 | restrict 127.0.0.1 | |
210 | restrict -6 ::1\n")) | |
211 | ||
212 | (mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config))) | |
213 | (return | |
214 | (service | |
215 | (provision '(ntpd)) | |
216 | (documentation "Run the Network Time Protocol (NTP) daemon.") | |
217 | (requirement '(user-processes networking)) | |
218 | (start #~(make-forkexec-constructor | |
219 | (list (string-append #$ntp "/bin/ntpd") "-n" | |
220 | "-c" #$ntpd.conf | |
221 | "-u" "ntpd"))) | |
222 | (stop #~(make-kill-destructor)) | |
223 | (user-accounts (list (user-account | |
224 | (name "ntpd") | |
225 | (group "nogroup") | |
226 | (system? #t) | |
227 | (comment "NTP daemon user") | |
228 | (home-directory "/var/empty") | |
229 | (shell | |
230 | "/run/current-system/profile/sbin/nologin")))))))) | |
231 | ||
927097ef LC |
232 | (define* (tor-service #:key (tor tor)) |
233 | "Return a service to run the @uref{https://torproject.org,Tor} daemon. | |
234 | ||
235 | The daemon runs with the default settings (in particular the default exit | |
236 | policy) as the @code{tor} unprivileged user." | |
237 | (mlet %store-monad ((torrc (text-file "torrc" "User tor\n"))) | |
238 | (return | |
239 | (service | |
240 | (provision '(tor)) | |
241 | ||
242 | ;; Tor needs at least one network interface to be up, hence the | |
243 | ;; dependency on 'loopback'. | |
244 | (requirement '(user-processes loopback)) | |
245 | ||
246 | (start #~(make-forkexec-constructor | |
247 | (list (string-append #$tor "/bin/tor") "-f" #$torrc))) | |
248 | (stop #~(make-kill-destructor)) | |
249 | ||
250 | (user-groups (list (user-group | |
41717509 LC |
251 | (name "tor") |
252 | (system? #t)))) | |
927097ef LC |
253 | (user-accounts (list (user-account |
254 | (name "tor") | |
255 | (group "tor") | |
256 | (system? #t) | |
257 | (comment "Tor daemon user") | |
258 | (home-directory "/var/empty") | |
259 | (shell | |
260 | "/run/current-system/profile/sbin/nologin")))) | |
261 | ||
262 | (documentation "Run the Tor anonymous network overlay."))))) | |
263 | ||
4627a464 LC |
264 | (define* (bitlbee-service #:key (bitlbee bitlbee) |
265 | (interface "127.0.0.1") (port 6667) | |
266 | (extra-settings "")) | |
267 | "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that | |
268 | acts as a gateway between IRC and chat networks. | |
269 | ||
270 | The daemon will listen to the interface corresponding to the IP address | |
271 | specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only | |
272 | local clients can connect, whereas @code{0.0.0.0} means that connections can | |
273 | come from any networking interface. | |
274 | ||
275 | In addition, @var{extra-settings} specifies a string to append to the | |
276 | configuration file." | |
277 | (mlet %store-monad ((conf (text-file "bitlbee.conf" | |
278 | (string-append " | |
279 | [settings] | |
280 | User = bitlbee | |
281 | ConfigDir = /var/lib/bitlbee | |
282 | DaemonInterface = " interface " | |
283 | DaemonPort = " (number->string port) " | |
284 | " extra-settings)))) | |
285 | (return | |
286 | (service | |
287 | (provision '(bitlbee)) | |
288 | (requirement '(user-processes loopback)) | |
9751c39a LC |
289 | (activate #~(begin |
290 | (use-modules (guix build utils)) | |
291 | ||
292 | ;; This directory is used to store OTR data. | |
293 | (mkdir-p "/var/lib/bitlbee") | |
294 | (let ((user (getpwnam "bitlbee"))) | |
295 | (chown "/var/lib/bitlbee" | |
296 | (passwd:uid user) (passwd:gid user))))) | |
4627a464 LC |
297 | (start #~(make-forkexec-constructor |
298 | (list (string-append #$bitlbee "/sbin/bitlbee") | |
299 | "-n" "-F" "-u" "bitlbee" "-c" #$conf))) | |
300 | (stop #~(make-kill-destructor)) | |
301 | (user-groups (list (user-group (name "bitlbee") (system? #t)))) | |
302 | (user-accounts (list (user-account | |
303 | (name "bitlbee") | |
304 | (group "bitlbee") | |
305 | (system? #t) | |
306 | (comment "BitlBee daemon user") | |
307 | (home-directory "/var/empty") | |
308 | (shell #~(string-append #$shadow | |
309 | "/sbin/nologin"))))))))) | |
310 | ||
b7d0c494 MW |
311 | (define* (wicd-service #:key (wicd wicd)) |
312 | "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network | |
313 | manager that aims to simplify wired and wireless networking." | |
314 | (with-monad %store-monad | |
315 | (return | |
316 | (service | |
317 | (documentation "Run the Wicd network manager.") | |
318 | (provision '(networking)) | |
319 | (requirement '(user-processes dbus-system loopback)) | |
320 | (start #~(make-forkexec-constructor | |
321 | (list (string-append #$wicd "/sbin/wicd") | |
322 | "--no-daemon"))) | |
323 | (stop #~(make-kill-destructor)) | |
324 | (activate | |
325 | #~(begin | |
326 | (use-modules (guix build utils)) | |
327 | (mkdir-p "/etc/wicd") | |
328 | (let ((file-name "/etc/wicd/dhclient.conf.template.default")) | |
329 | (unless (file-exists? file-name) | |
330 | (copy-file (string-append #$wicd file-name) | |
331 | file-name))))))))) | |
332 | ||
db4fdc04 | 333 | ;;; networking.scm ends here |