HCoop / jackhill / guix / guix.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
gnu: Add tlf.
[jackhill/guix/guix.git] / gnu / services / networking.scm
CommitLineData
db4fdc04 1;;; GNU Guix --- Functional package management for GNU
0d22fc8d 2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
b7d0c494 3;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
0ba3a38b 4;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
1c6c0ad0 5;;; Copyright © 2016 John Darrington <jmd@gnu.org>
e57bd0be 6;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
9260b9d1 7;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
acce0a47 8;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
0975ca3f 9;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
5dfd80e1 10;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
9926b8f8 11;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
f5be5104 12;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
fd449608 13;;; Copyright © 2019, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
3c4f5ad7 14;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
a2161c86 15;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
ef20acae 16;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
4e511fcf 17;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
b309a286 18;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org>
2978832b 19;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
db4fdc04
LC		 20;;;
21;;; This file is part of GNU Guix.
22;;;
23;;; GNU Guix is free software; you can redistribute it and/or modify it
24;;; under the terms of the GNU General Public License as published by
25;;; the Free Software Foundation; either version 3 of the License, or (at
26;;; your option) any later version.
27;;;
28;;; GNU Guix is distributed in the hope that it will be useful, but
29;;; WITHOUT ANY WARRANTY; without even the implied warranty of
30;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
31;;; GNU General Public License for more details.
32;;;
33;;; You should have received a copy of the GNU General Public License
34;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
35
36(define-module (gnu services networking)
37 #:use-module (gnu services)
c9436025 38 #:use-module (gnu services base)
a03943ec 39 #:use-module (gnu services configuration)
ef20acae 40 #:use-module (gnu services linux)
0190c1c0 41 #:use-module (gnu services shepherd)
0adfe95a 42 #:use-module (gnu services dbus)
927097ef 43 #:use-module (gnu system shadow)
6e828634 44 #:use-module (gnu system pam)
db4fdc04 45 #:use-module (gnu packages admin)
f5be5104
FP		 46 #:use-module (gnu packages base)
47 #:use-module (gnu packages bash)
4e511fcf 48 #:use-module (gnu packages cluster)
76192896 49 #:use-module (gnu packages connman)
d94e81db 50 #:use-module (gnu packages freedesktop)
db4fdc04 51 #:use-module (gnu packages linux)
927097ef 52 #:use-module (gnu packages tor)
f5be5104 53 #:use-module (gnu packages usb-modeswitch)
4627a464 54 #:use-module (gnu packages messaging)
c32d02fe 55 #:use-module (gnu packages networking)
63854bcb 56 #:use-module (gnu packages ntp)
b7d0c494 57 #:use-module (gnu packages wicd)
7234ad4f 58 #:use-module (gnu packages gnome)
2978832b
MD		 59 #:use-module (gnu packages ipfs)
60 #:use-module (gnu build linux-container)
b5f4e686 61 #:use-module (guix gexp)
0adfe95a 62 #:use-module (guix records)
a062b6ca 63 #:use-module (guix modules)
e52b9534 64 #:use-module (guix packages)
65a67bf7 65 #:use-module (guix deprecation)
5658ae8a 66 #:use-module (rnrs enums)
6331bde7
LC		 67 #:use-module (srfi srfi-1)
68 #:use-module (srfi srfi-9)
63854bcb 69 #:use-module (srfi srfi-26)
fe1cd098 70 #:use-module (srfi srfi-43)
0adfe95a 71 #:use-module (ice-9 match)
fe1cd098 72 #:use-module (json)
70ab130a
DM		 73 #:re-export (static-networking-service
74 static-networking-service-type)
fa0c1d61 75 #:export (%facebook-host-aliases
39d7fdce 76 dhcp-client-service-type
f1104d90
CM		 77
78 dhcpd-service-type
79 dhcpd-configuration
80 dhcpd-configuration?
81 dhcpd-configuration-package
82 dhcpd-configuration-config-file
83 dhcpd-configuration-version
84 dhcpd-configuration-run-directory
85 dhcpd-configuration-lease-file
86 dhcpd-configuration-pid-file
87 dhcpd-configuration-interfaces
88
24e96431
TČ		 89 ntp-configuration
90 ntp-configuration?
5658ae8a
MC		 91 ntp-configuration-ntp
92 ntp-configuration-servers
93 ntp-allow-large-adjustment?
94
95 %ntp-servers
96 ntp-server
97 ntp-server-type
98 ntp-server-address
99 ntp-server-options
100
24e96431
TČ		 101 ntp-service-type
102
5658ae8a 103 %openntpd-servers
16718b67
EF		 104 openntpd-configuration
105 openntpd-configuration?
106 openntpd-service-type
107
9260b9d1
TD		 108 inetd-configuration
109 inetd-entry
110 inetd-service-type
111
fd449608
MC		 112 opendht-configuration
113 opendht-configuration-peer-discovery?
114 opendht-configuration-verbose?
115 opendht-configuration-bootstrap-host
116 opendht-configuration-port
117 opendht-configuration-proxy-server-port
118 opendht-configuration-proxy-server-port-tls
119 opendht-configuration->command-line-arguments
120
121 opendht-shepherd-service
122 opendht-service-type
123
24e96431
TČ		 124 tor-configuration
125 tor-configuration?
6331bde7 126 tor-hidden-service
24e96431
TČ		 127 tor-service-type
128
e48fcd7b 129 wicd-service-type
7234ad4f 130 wicd-service
b726096b
CB		 131
132 network-manager-configuration
133 network-manager-configuration?
134 network-manager-configuration-dns
4e37cf35 135 network-manager-configuration-vpn-plugins
b726096b
CB		 136 network-manager-service-type
137
34d60c49
MO		 138 connman-configuration
139 connman-configuration?
140 connman-service-type
141
d94e81db
DM		 142 modem-manager-configuration
143 modem-manager-configuration?
144 modem-manager-service-type
acce0a47 145
f5be5104
FP		 146 usb-modeswitch-configuration
147 usb-modeswitch-configuration?
148 usb-modeswitch-configuration-usb-modeswitch
149 usb-modeswitch-configuration-usb-modeswitch-data
150 usb-modeswitch-service-type
151
acce0a47
MB		 152 wpa-supplicant-configuration
153 wpa-supplicant-configuration?
154 wpa-supplicant-configuration-wpa-supplicant
4d060767 155 wpa-supplicant-configuration-requirement
acce0a47
MB		 156 wpa-supplicant-configuration-pid-file
157 wpa-supplicant-configuration-dbus?
158 wpa-supplicant-configuration-interface
159 wpa-supplicant-configuration-config-file
160 wpa-supplicant-configuration-extra-options
c32d02fe
SB		 161 wpa-supplicant-service-type
162
a03943ec
LC		 163 hostapd-configuration
164 hostapd-configuration?
165 hostapd-configuration-package
166 hostapd-configuration-interface
167 hostapd-configuration-ssid
168 hostapd-configuration-broadcast-ssid?
169 hostapd-configuration-channel
170 hostapd-configuration-driver
171 hostapd-service-type
172
5e7076f2
LC		 173 simulated-wifi-service-type
174
c32d02fe 175 openvswitch-service-type
9926b8f8
AI		 176 openvswitch-configuration
177
178 iptables-configuration
179 iptables-configuration?
180 iptables-configuration-iptables
181 iptables-configuration-ipv4-rules
182 iptables-configuration-ipv6-rules
3c4f5ad7
SB		 183 iptables-service-type
184
185 nftables-service-type
186 nftables-configuration
187 nftables-configuration?
188 nftables-configuration-package
189 nftables-configuration-ruleset
a2161c86
AG		 190 %default-nftables-ruleset
191
192 pagekite-service-type
193 pagekite-configuration
194 pagekite-configuration?
195 pagekite-configuration-package
196 pagekite-configuration-kitename
197 pagekite-configuration-kitesecret
198 pagekite-configuration-frontend
199 pagekite-configuration-kites
fe1cd098 200 pagekite-configuration-extra-file
201
202 yggdrasil-service-type
203 yggdrasil-configuration
204 yggdrasil-configuration?
205 yggdrasil-configuration-autoconf?
206 yggdrasil-configuration-config-file
207 yggdrasil-configuration-log-level
208 yggdrasil-configuration-log-to
209 yggdrasil-configuration-json-config
4e511fcf
OP		 210 yggdrasil-configuration-package
211
2978832b
MD		 212 ipfs-service-type
213 ipfs-configuration
214 ipfs-configuration?
215 ipfs-configuration-package
216 ipfs-configuration-gateway
217 ipfs-configuration-api
218
4e511fcf
OP		 219 keepalived-configuration
220 keepalived-configuration?
221 keepalived-service-type))
db4fdc04
LC		 222
223;;; Commentary:
224;;;
225;;; Networking services.
226;;;
227;;; Code:
228
fa0c1d61
LC		 229(define %facebook-host-aliases
230 ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
231 ;; are to block it.
232 "\
233# Block Facebook IPv4.
234127.0.0.1 www.facebook.com
235127.0.0.1 facebook.com
236127.0.0.1 login.facebook.com
237127.0.0.1 www.login.facebook.com
238127.0.0.1 fbcdn.net
239127.0.0.1 www.fbcdn.net
240127.0.0.1 fbcdn.com
241127.0.0.1 www.fbcdn.com
242127.0.0.1 static.ak.fbcdn.net
243127.0.0.1 static.ak.connect.facebook.com
244127.0.0.1 connect.facebook.net
245127.0.0.1 www.connect.facebook.net
246127.0.0.1 apps.facebook.com
247
248# Block Facebook IPv6.
249fe80::1%lo0 facebook.com
250fe80::1%lo0 login.facebook.com
251fe80::1%lo0 www.login.facebook.com
252fe80::1%lo0 fbcdn.net
253fe80::1%lo0 www.fbcdn.net
254fe80::1%lo0 fbcdn.com
255fe80::1%lo0 www.fbcdn.com
256fe80::1%lo0 static.ak.fbcdn.net
257fe80::1%lo0 static.ak.connect.facebook.com
258fe80::1%lo0 connect.facebook.net
259fe80::1%lo0 www.connect.facebook.net
260fe80::1%lo0 apps.facebook.com\n")
261
0adfe95a 262(define dhcp-client-service-type
d4053c71 263 (shepherd-service-type
00184239 264 'dhcp-client
0adfe95a
LC		 265 (lambda (dhcp)
266 (define dhclient
9e41130b 267 (file-append dhcp "/sbin/dhclient"))
0adfe95a
LC		 268
269 (define pid-file
270 "/var/run/dhclient.pid")
271
d4053c71 272 (shepherd-service
0adfe95a
LC		 273 (documentation "Set up networking via DHCP.")
274 (requirement '(user-processes udev))
275
276 ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
277 ;; networking is unavailable, but also means that the interface is not up
278 ;; yet when 'start' completes. To wait for the interface to be ready, one
279 ;; should instead monitor udev events.
280 (provision '(networking))
281
282 (start #~(lambda _
283 ;; When invoked without any arguments, 'dhclient' discovers all
284 ;; non-loopback interfaces *that are up*. However, the relevant
285 ;; interfaces are typically down at this point. Thus we perform
286 ;; our own interface discovery here.
287 (define valid?
6c2180f5
MB		 288 (lambda (interface)
289 (and (arp-network-interface? interface)
747b7246
BW		 290 (not (loopback-network-interface? interface))
291 ;; XXX: Make sure the interfaces are up so that
292 ;; 'dhclient' can actually send/receive over them.
293 ;; Ignore those that cannot be activated.
294 (false-if-exception
295 (set-network-interface-up interface)))))
0adfe95a
LC		 296 (define ifaces
297 (filter valid? (all-network-interface-names)))
298
0adfe95a
LC		 299 (false-if-exception (delete-file #$pid-file))
300 (let ((pid (fork+exec-command
301 (cons* #$dhclient "-nw"
302 "-pf" #$pid-file ifaces))))
303 (and (zero? (cdr (waitpid pid)))
6f03b080 304 (read-pid-file #$pid-file)))))
39d7fdce 305 (stop #~(make-kill-destructor))))
0d22fc8d
LC		 306 isc-dhcp
307 (description "Run @command{dhcp}, a Dynamic Host Configuration
308Protocol (DHCP) client, on all the non-loopback network interfaces.")))
db4fdc04 309
f1104d90
CM		 310(define-record-type* <dhcpd-configuration>
311 dhcpd-configuration make-dhcpd-configuration
312 dhcpd-configuration?
313 (package dhcpd-configuration-package ;<package>
314 (default isc-dhcp))
315 (config-file dhcpd-configuration-config-file ;file-like
316 (default #f))
317 (version dhcpd-configuration-version ;"4", "6", or "4o6"
a654d3de 318 (default "4"))
f1104d90
CM		 319 (run-directory dhcpd-configuration-run-directory
320 (default "/run/dhcpd"))
321 (lease-file dhcpd-configuration-lease-file
322 (default "/var/db/dhcpd.leases"))
323 (pid-file dhcpd-configuration-pid-file
324 (default "/run/dhcpd/dhcpd.pid"))
325 ;; list of strings, e.g. (list "enp0s25")
326 (interfaces dhcpd-configuration-interfaces
327 (default '())))
328
329(define dhcpd-shepherd-service
330 (match-lambda
331 (($ <dhcpd-configuration> package config-file version run-directory
332 lease-file pid-file interfaces)
333 (unless config-file
334 (error "Must supply a config-file"))
335 (list (shepherd-service
336 ;; Allow users to easily run multiple versions simultaneously.
337 (provision (list (string->symbol
338 (string-append "dhcpv" version "-daemon"))))
339 (documentation (string-append "Run the DHCPv" version " daemon"))
340 (requirement '(networking))
341 (start #~(make-forkexec-constructor
342 '(#$(file-append package "/sbin/dhcpd")
343 #$(string-append "-" version)
344 "-lf" #$lease-file
345 "-pf" #$pid-file
346 "-cf" #$config-file
347 #$@interfaces)
348 #:pid-file #$pid-file))
349 (stop #~(make-kill-destructor)))))))
350
351(define dhcpd-activation
352 (match-lambda
353 (($ <dhcpd-configuration> package config-file version run-directory
354 lease-file pid-file interfaces)
355 (with-imported-modules '((guix build utils))
356 #~(begin
357 (unless (file-exists? #$run-directory)
358 (mkdir #$run-directory))
359 ;; According to the DHCP manual (man dhcpd.leases), the lease
360 ;; database must be present for dhcpd to start successfully.
361 (unless (file-exists? #$lease-file)
362 (with-output-to-file #$lease-file
363 (lambda _ (display ""))))
364 ;; Validate the config.
0f13dd2b 365 (invoke/quiet
f1104d90
CM		 366 #$(file-append package "/sbin/dhcpd") "-t" "-cf"
367 #$config-file))))))
368
369(define dhcpd-service-type
370 (service-type
371 (name 'dhcpd)
372 (extensions
373 (list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
dd0804c6
LC		 374 (service-extension activation-service-type dhcpd-activation)))
375 (description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The
376daemon is responsible for allocating IP addresses to its client.")))
f1104d90 377
0adfe95a
LC		 378\f
379;;;
380;;; NTP.
381;;;
382
5658ae8a
MC		 383(define ntp-server-types (make-enumeration
384 '(pool
385 server
386 peer
387 broadcast
388 manycastclient)))
389
390(define-record-type* <ntp-server>
391 ntp-server make-ntp-server
392 ntp-server?
393 ;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration.
394 (type ntp-server-type
395 (default 'server))
396 (address ntp-server-address) ; a string
397 ;; The list of options can contain single option names or tuples in the form
398 ;; '(name value).
399 (options ntp-server-options
400 (default '())))
401
402(define (ntp-server->string ntp-server)
403 ;; Serialize the NTP server object as a string, ready to use in the NTP
404 ;; configuration file.
405 (define (flatten lst)
406 (reverse
407 (let loop ((x lst)
408 (res '()))
409 (if (list? x)
410 (fold loop res x)
97bc3cbe 411 (cons (format #f "~a" x) res)))))
5658ae8a
MC		 412
413 (match ntp-server
414 (($ <ntp-server> type address options)
415 ;; XXX: It'd be neater if fields were validated at the syntax level (for
416 ;; static ones at least). Perhaps the Guix record type could support a
417 ;; predicate property on a field?
418 (unless (enum-set-member? type ntp-server-types)
419 (error "Invalid NTP server type" type))
420 (string-join (cons* (symbol->string type)
421 address
422 (flatten options))))))
423
424(define %ntp-servers
425 ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
426 ;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact
427 ;; for this NTP pool "zone".
428 (list
429 (ntp-server
430 (type 'pool)
431 (address "0.guix.pool.ntp.org")
432 (options '("iburst"))))) ;as recommended in the ntpd manual
433
0adfe95a
LC		 434(define-record-type* <ntp-configuration>
435 ntp-configuration make-ntp-configuration
436 ntp-configuration?
437 (ntp ntp-configuration-ntp
438 (default ntp))
5658ae8a 439 (servers %ntp-configuration-servers ;list of <ntp-server> objects
64791eb7 440 (default %ntp-servers))
dc0322b5 441 (allow-large-adjustment? ntp-allow-large-adjustment?
08b4a10f 442 (default #t))) ;as recommended in the ntpd manual
0adfe95a 443
5658ae8a
MC		 444(define (ntp-configuration-servers ntp-configuration)
445 ;; A wrapper to support the deprecated form of this field.
446 (let ((ntp-servers (%ntp-configuration-servers ntp-configuration)))
447 (match ntp-servers
448 (((? string?) (? string?) ...)
449 (format (current-error-port) "warning: Defining NTP servers as strings is \
450deprecated. Please use <ntp-server> records instead.\n")
451 (map (lambda (addr)
452 (ntp-server
453 (type 'server)
454 (address addr)
455 (options '()))) ntp-servers))
456 ((($ <ntp-server>) ($ <ntp-server>) ...)
457 ntp-servers))))
458
d4053c71 459(define ntp-shepherd-service
f37ad658
MC		 460 (lambda (config)
461 (match config
462 (($ <ntp-configuration> ntp servers allow-large-adjustment?)
463 (let ((servers (ntp-configuration-servers config)))
464 ;; TODO: Add authentication support.
465 (define config
466 (string-append "driftfile /var/run/ntpd/ntp.drift\n"
467 (string-join (map ntp-server->string servers)
468 "\n")
469 "
63854bcb
LC		 470# Disable status queries as a workaround for CVE-2013-5211:
471# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
d4de2f9e
MC		 472restrict default kod nomodify notrap nopeer noquery limited
473restrict -6 default kod nomodify notrap nopeer noquery limited
63854bcb
LC		 474
475# Yet, allow use of the local 'ntpq'.
476restrict 127.0.0.1
5658ae8a
MC		 477restrict -6 ::1
478
479# This is required to use servers from a pool directive when using the 'nopeer'
480# option by default, as documented in the 'ntp.conf' manual.
481restrict source notrap nomodify noquery\n"))
63854bcb 482
f37ad658
MC		 483 (define ntpd.conf
484 (plain-file "ntpd.conf" config))
485
486 (list (shepherd-service
487 (provision '(ntpd))
488 (documentation "Run the Network Time Protocol (NTP) daemon.")
489 (requirement '(user-processes networking))
490 (start #~(make-forkexec-constructor
491 (list (string-append #$ntp "/bin/ntpd") "-n"
492 "-c" #$ntpd.conf "-u" "ntpd"
493 #$@(if allow-large-adjustment?
494 '("-g")
495 '()))))
496 (stop #~(make-kill-destructor)))))))))
0adfe95a
LC		 497
498(define %ntp-accounts
499 (list (user-account
500 (name "ntpd")
501 (group "nogroup")
502 (system? #t)
503 (comment "NTP daemon user")
504 (home-directory "/var/empty")
9e41130b 505 (shell (file-append shadow "/sbin/nologin")))))
0adfe95a 506
1c6c0ad0
JD		 507
508(define (ntp-service-activation config)
509 "Return the activation gexp for CONFIG."
510 (with-imported-modules '((guix build utils))
511 #~(begin
e57bd0be 512 (use-modules (guix build utils))
1c6c0ad0
JD		 513 (define %user
514 (getpw "ntpd"))
515
516 (let ((directory "/var/run/ntpd"))
517 (mkdir-p directory)
518 (chown directory (passwd:uid %user) (passwd:gid %user))))))
519
0adfe95a
LC		 520(define ntp-service-type
521 (service-type (name 'ntp)
522 (extensions
d4053c71
AK		 523 (list (service-extension shepherd-root-service-type
524 ntp-shepherd-service)
0adfe95a 525 (service-extension account-service-type
1c6c0ad0
JD		 526 (const %ntp-accounts))
527 (service-extension activation-service-type
3f0de257
LC		 528 ntp-service-activation)))
529 (description
530 "Run the @command{ntpd}, the Network Time Protocol (NTP)
531daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon
64791eb7
LC		 532will keep the system clock synchronized with that of the given servers.")
533 (default-value (ntp-configuration))))
0adfe95a 534
0adfe95a 535\f
16718b67
EF		 536;;;
537;;; OpenNTPD.
538;;;
539
5658ae8a
MC		 540(define %openntpd-servers
541 (map ntp-server-address %ntp-servers))
542
16718b67
EF		 543(define-record-type* <openntpd-configuration>
544 openntpd-configuration make-openntpd-configuration
545 openntpd-configuration?
546 (openntpd openntpd-configuration-openntpd
547 (default openntpd))
548 (listen-on openntpd-listen-on
549 (default '("127.0.0.1"
550 "::1")))
551 (query-from openntpd-query-from
552 (default '()))
553 (sensor openntpd-sensor
554 (default '()))
555 (server openntpd-server
16718b67 556 (default '()))
5658ae8a
MC		 557 (servers openntpd-servers
558 (default %openntpd-servers))
16718b67
EF		 559 (constraint-from openntpd-constraint-from
560 (default '()))
561 (constraints-from openntpd-constraints-from
181f290a 562 (default '())))
16718b67 563
2625abc6 564(define (openntpd-configuration->string config)
ccdfae38
MC		 565
566 (define (quote-field? name)
567 (member name '("constraints from")))
568
16718b67 569 (match-record config <openntpd-configuration>
2625abc6
MC		 570 (listen-on query-from sensor server servers constraint-from
571 constraints-from)
ccdfae38 572 (string-append
2625abc6 573 (string-join
ccdfae38
MC		 574 (concatenate
575 (filter-map (lambda (field values)
576 (match values
577 (() #f) ;discard entry with filter-map
578 ((val ...) ;validate value type
579 (map (lambda (value)
580 (if (quote-field? field)
581 (format #f "~a \"~a\"" field value)
582 (format #f "~a ~a" field value)))
583 values))))
584 ;; The entry names.
585 '("listen on" "query from" "sensor" "server" "servers"
586 "constraint from" "constraints from")
587 ;; The corresponding entry values.
588 (list listen-on query-from sensor server servers
589 constraint-from constraints-from)))
590 "\n")
591 "\n"))) ;add a trailing newline
2625abc6
MC		 592
593(define (openntpd-shepherd-service config)
181f290a 594 (let ((openntpd (openntpd-configuration-openntpd config)))
afd39a76
MC		 595
596 (define ntpd.conf
2625abc6 597 (plain-file "ntpd.conf" (openntpd-configuration->string config)))
afd39a76
MC		 598
599 (list (shepherd-service
600 (provision '(ntpd))
601 (documentation "Run the Network Time Protocol (NTP) daemon.")
602 (requirement '(user-processes networking))
603 (start #~(make-forkexec-constructor
604 (list (string-append #$openntpd "/sbin/ntpd")
605 "-f" #$ntpd.conf
181f290a 606 "-d") ;; don't daemonize
afd39a76
MC		 607 ;; When ntpd is daemonized it repeatedly tries to respawn
608 ;; while running, leading shepherd to disable it. To
609 ;; prevent spamming stderr, redirect output to logfile.
610 #:log-file "/var/log/ntpd"))
611 (stop #~(make-kill-destructor))))))
16718b67
EF		 612
613(define (openntpd-service-activation config)
614 "Return the activation gexp for CONFIG."
615 (with-imported-modules '((guix build utils))
616 #~(begin
617 (use-modules (guix build utils))
618
619 (mkdir-p "/var/db")
620 (mkdir-p "/var/run")
621 (unless (file-exists? "/var/db/ntpd.drift")
622 (with-output-to-file "/var/db/ntpd.drift"
623 (lambda _
624 (format #t "0.0")))))))
625
626(define openntpd-service-type
627 (service-type (name 'openntpd)
628 (extensions
629 (list (service-extension shepherd-root-service-type
630 openntpd-shepherd-service)
631 (service-extension account-service-type
632 (const %ntp-accounts))
19f20f4f
EF		 633 (service-extension profile-service-type
634 (compose list openntpd-configuration-openntpd))
16718b67
EF		 635 (service-extension activation-service-type
636 openntpd-service-activation)))
637 (default-value (openntpd-configuration))
638 (description
639 "Run the @command{ntpd}, the Network Time Protocol (NTP)
640daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The
641daemon will keep the system clock synchronized with that of the given servers.")))
642
643\f
9260b9d1
TD		 644;;;
645;;; Inetd.
646;;;
647
648(define-record-type* <inetd-configuration> inetd-configuration
649 make-inetd-configuration
650 inetd-configuration?
651 (program inetd-configuration-program ;file-like
652 (default (file-append inetutils "/libexec/inetd")))
653 (entries inetd-configuration-entries ;list of <inetd-entry>
654 (default '())))
655
656(define-record-type* <inetd-entry> inetd-entry make-inetd-entry
657 inetd-entry?
658 (node inetd-entry-node ;string or #f
659 (default #f))
660 (name inetd-entry-name) ;string, from /etc/services
661
662 (socket-type inetd-entry-socket-type) ;stream | dgram | raw |
663 ;rdm | seqpacket
664 (protocol inetd-entry-protocol) ;string, from /etc/protocols
665
666 (wait? inetd-entry-wait? ;Boolean
667 (default #t))
668 (user inetd-entry-user) ;string
669
670 (program inetd-entry-program ;string or file-like object
671 (default "internal"))
672 (arguments inetd-entry-arguments ;list of strings or file-like objects
673 (default '())))
674
675(define (inetd-config-file entries)
676 (apply mixed-text-file "inetd.conf"
677 (map
678 (lambda (entry)
679 (let* ((node (inetd-entry-node entry))
680 (name (inetd-entry-name entry))
681 (socket
682 (if node (string-append node ":" name) name))
683 (type
684 (match (inetd-entry-socket-type entry)
685 ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
686 (symbol->string (inetd-entry-socket-type entry)))))
687 (protocol (inetd-entry-protocol entry))
688 (wait (if (inetd-entry-wait? entry) "wait" "nowait"))
689 (user (inetd-entry-user entry))
690 (program (inetd-entry-program entry))
691 (args (inetd-entry-arguments entry)))
692 #~(string-append
693 (string-join
694 (list #$@(list socket type protocol wait user program) #$@args)
695 " ") "\n")))
696 entries)))
697
698(define inetd-shepherd-service
699 (match-lambda
700 (($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
701 (($ <inetd-configuration> program entries)
702 (list
703 (shepherd-service
704 (documentation "Run inetd.")
705 (provision '(inetd))
706 (requirement '(user-processes networking syslogd))
707 (start #~(make-forkexec-constructor
708 (list #$program #$(inetd-config-file entries))
709 #:pid-file "/var/run/inetd.pid"))
710 (stop #~(make-kill-destructor)))))))
711
712(define-public inetd-service-type
713 (service-type
714 (name 'inetd)
715 (extensions
716 (list (service-extension shepherd-root-service-type
717 inetd-shepherd-service)))
718
719 ;; The service can be extended with additional lists of entries.
720 (compose concatenate)
721 (extend (lambda (config entries)
722 (inetd-configuration
723 (inherit config)
724 (entries (append (inetd-configuration-entries config)
3f0de257
LC		 725 entries)))))
726 (description
727 "Start @command{inetd}, the @dfn{Internet superserver}. It is responsible
728for listening on Internet sockets and spawning the corresponding services on
729demand.")))
9260b9d1
TD		 730
731\f
fd449608
MC		 732;;;
733;;; OpenDHT, the distributed hash table network used by Jami
734;;;
735
736(define-maybe/no-serialization number)
737(define-maybe/no-serialization string)
738
739;;; To generate the documentation of the following configuration record, you
740;;; can evaluate: (configuration->documentation 'opendht-configuration)
741(define-configuration/no-serialization opendht-configuration
742 (opendht
743 (package opendht)
744 "The @code{opendht} package to use.")
745 (peer-discovery?
746 (boolean #false)
747 "Whether to enable the multicast local peer discovery mechanism.")
748 (enable-logging?
749 (boolean #false)
750 "Whether to enable logging messages to syslog. It is disabled by default
751as it is rather verbose.")
752 (debug?
753 (boolean #false)
754 "Whether to enable debug-level logging messages. This has no effect if
755logging is disabled.")
756 (bootstrap-host
757 (maybe-string "bootstrap.jami.net:4222")
758 "The node host name that is used to make the first connection to the
759network. A specific port value can be provided by appending the @code{:PORT}
760suffix. By default, it uses the Jami bootstrap nodes, but any host can be
761specified here. It's also possible to disable bootstrapping by setting this
762to the @code{'disabled} symbol.")
763 (port
764 (maybe-number 4222)
765 "The UDP port to bind to. When set to @code{'disabled}, an available port
766is automatically selected.")
767 (proxy-server-port
768 (maybe-number 'disabled)
769 "Spawn a proxy server listening on the specified port.")
770 (proxy-server-port-tls
771 (maybe-number 'disabled)
772 "Spawn a proxy server listening to TLS connections on the specified
773port."))
774
775(define %opendht-accounts
776 ;; User account and groups for Tor.
777 (list (user-group (name "opendht") (system? #t))
778 (user-account
779 (name "opendht")
780 (group "opendht")
781 (system? #t)
782 (comment "OpenDHT daemon user")
783 (home-directory "/var/empty")
784 (shell (file-append shadow "/sbin/nologin")))))
785
786(define (opendht-configuration->command-line-arguments config)
787 "Derive the command line arguments used to launch the OpenDHT daemon from
788CONFIG, an <opendht-configuration> object."
789 (match-record config <opendht-configuration>
790 (opendht bootstrap-host enable-logging? port debug? peer-discovery?
791 proxy-server-port proxy-server-port-tls)
792 (let ((dhtnode #~(string-append #$opendht:tools "/bin/dhtnode")))
793 `(,dhtnode
794 "--service" ;non-forking mode
795 ,@(if (string? bootstrap-host)
796 (list "--bootstrap" bootstrap-host))
797 ,@(if enable-logging?
798 (list "--syslog")
799 '())
800 ,@(if (number? port)
801 (list "--port" (number->string port))
802 '())
803 ,@(if debug?
804 (list "--verbose")
805 '())
806 ,@(if peer-discovery?
807 (list "--peer-discovery")
808 '())
809 ,@(if (number? proxy-server-port)
810 (list "--proxyserver" (number->string proxy-server-port))
811 '())
812 ,@(if (number? proxy-server-port-tls)
813 (list "--proxyserverssl" (number->string proxy-server-port-tls))
814 '())))))
815
816(define (opendht-shepherd-service config)
817 "Return a <shepherd-service> running OpenDHT."
a09cdf1f
MC		 818 (with-imported-modules (source-module-closure
819 '((gnu build shepherd)
820 (gnu system file-systems)))
821 (shepherd-service
822 (documentation "Run an OpenDHT node.")
823 (provision '(opendht dhtnode dhtproxy))
824 (requirement '(networking syslogd))
825 (modules '((gnu build shepherd)
826 (gnu system file-systems)))
827 (start #~(make-forkexec-constructor/container
828 (list #$@(opendht-configuration->command-line-arguments config))
829 #:mappings (list (file-system-mapping
830 (source "/dev/log") ;for syslog
831 (target source)))
832 #:user "opendht"
833 #:group "opendht"))
834 (stop #~(make-kill-destructor)))))
fd449608
MC		 835
836(define opendht-service-type
837 (service-type
838 (name 'opendht)
839 (default-value (opendht-configuration))
840 (extensions
841 (list (service-extension shepherd-root-service-type
842 (compose list opendht-shepherd-service))
843 (service-extension account-service-type
844 (const %opendht-accounts))))
845 (description "Run the OpenDHT @command{dhtnode} command that allows
846participating in the distributed hash table based OpenDHT network. The
847service can be configured to act as a proxy to the distributed network, which
848can be useful for portable devices where minimizing energy consumption is
849paramount. OpenDHT was originally based on Kademlia and adapted for
850applications in communication. It is used by Jami, for example.")))
851
852\f
0adfe95a
LC		 853;;;
854;;; Tor.
855;;;
856
6331bde7
LC		 857(define-record-type* <tor-configuration>
858 tor-configuration make-tor-configuration
859 tor-configuration?
860 (tor tor-configuration-tor
861 (default tor))
3d3c5650
LC		 862 (config-file tor-configuration-config-file
863 (default (plain-file "empty" "")))
6331bde7 864 (hidden-services tor-configuration-hidden-services
3bcb305b
CM		 865 (default '()))
866 (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
b309a286
CLW		 867 (default 'tcp))
868 (control-socket? tor-control-socket-path
869 (default #f)))
6331bde7 870
0adfe95a
LC		 871(define %tor-accounts
872 ;; User account and groups for Tor.
873 (list (user-group (name "tor") (system? #t))
874 (user-account
875 (name "tor")
876 (group "tor")
877 (system? #t)
878 (comment "Tor daemon user")
879 (home-directory "/var/empty")
9e41130b 880 (shell (file-append shadow "/sbin/nologin")))))
0adfe95a 881
6331bde7
LC		 882(define-record-type <hidden-service>
883 (hidden-service name mapping)
884 hidden-service?
885 (name hidden-service-name) ;string
886 (mapping hidden-service-mapping)) ;list of port/address tuples
887
888(define (tor-configuration->torrc config)
889 "Return a 'torrc' file for CONFIG."
890 (match config
b309a286
CLW		 891 (($ <tor-configuration> tor config-file services
892 socks-socket-type control-socket?)
6331bde7
LC		 893 (computed-file
894 "torrc"
4ee96a79
LC		 895 (with-imported-modules '((guix build utils))
896 #~(begin
897 (use-modules (guix build utils)
898 (ice-9 match))
899
900 (call-with-output-file #$output
901 (lambda (port)
902 (display "\
0975ca3f 903### These lines were generated from your system configuration:
5ee35eb7 904User tor
6629099a 905DataDirectory /var/lib/tor
5dfd80e1 906PidFile /var/run/tor/tor.pid
5ee35eb7 907Log notice syslog\n" port)
3bcb305b
CM		 908 (when (eq? 'unix '#$socks-socket-type)
909 (display "\
910SocksPort unix:/var/run/tor/socks-sock
911UnixSocksGroupWritable 1\n" port))
b309a286
CLW		 912 (when #$control-socket?
913 (display "\
914ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
915ControlSocketsGroupWritable 1\n"
916 port))
6331bde7 917
4ee96a79
LC		 918 (for-each (match-lambda
919 ((service (ports hosts) ...)
920 (format port "\
6629099a 921HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
4ee96a79
LC		 922 service)
923 (for-each (lambda (tcp-port host)
924 (format port "\
6331bde7 925HiddenServicePort ~a ~a~%"
4ee96a79
LC		 926 tcp-port host))
927 ports hosts)))
928 '#$(map (match-lambda
929 (($ <hidden-service> name mapping)
930 (cons name mapping)))
931 services))
932
0975ca3f
TGR		 933 (display "\
934### End of automatically generated lines.\n\n" port)
935
4ee96a79
LC		 936 ;; Append the user's config file.
937 (call-with-input-file #$config-file
938 (lambda (input)
939 (dump-port input port)))
940 #t))))))))
6331bde7 941
d4053c71 942(define (tor-shepherd-service config)
5dfd80e1 943 "Return a <shepherd-service> running Tor."
375c6108 944 (match config
6331bde7
LC		 945 (($ <tor-configuration> tor)
946 (let ((torrc (tor-configuration->torrc config)))
ee295346
LC		 947 (with-imported-modules (source-module-closure
948 '((gnu build shepherd)
949 (gnu system file-systems)))
950 (list (shepherd-service
951 (provision '(tor))
952
953 ;; Tor needs at least one network interface to be up, hence the
954 ;; dependency on 'loopback'.
955 (requirement '(user-processes loopback syslogd))
956
957 (modules '((gnu build shepherd)
958 (gnu system file-systems)))
959
960 (start #~(make-forkexec-constructor/container
961 (list #$(file-append tor "/bin/tor") "-f" #$torrc)
962
963 #:mappings (list (file-system-mapping
964 (source "/var/lib/tor")
965 (target source)
966 (writable? #t))
967 (file-system-mapping
968 (source "/dev/log") ;for syslog
5dfd80e1
CM		 969 (target source))
970 (file-system-mapping
971 (source "/var/run/tor")
972 (target source)
973 (writable? #t)))
974 #:pid-file "/var/run/tor/tor.pid"))
ee295346
LC		 975 (stop #~(make-kill-destructor))
976 (documentation "Run the Tor anonymous network overlay."))))))))
0adfe95a 977
d973915e 978(define (tor-activation config)
5dfd80e1 979 "Set up directories for Tor and its hidden services, if any."
6331bde7
LC		 980 #~(begin
981 (use-modules (guix build utils))
982
6629099a
LC		 983 (define %user
984 (getpw "tor"))
985
6331bde7 986 (define (initialize service)
6629099a
LC		 987 (let ((directory (string-append "/var/lib/tor/hidden-services/"
988 service)))
6331bde7 989 (mkdir-p directory)
6629099a 990 (chown directory (passwd:uid %user) (passwd:gid %user))
6331bde7
LC		 991
992 ;; The daemon bails out if we give wider permissions.
993 (chmod directory #o700)))
994
5dfd80e1
CM		 995 ;; Allow Tor to write its PID file.
996 (mkdir-p "/var/run/tor")
997 (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
998 ;; Set the group permissions to rw so that if the system administrator
999 ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
1000 ;; of the "tor" group will be able to use the SOCKS socket.
1001 (chmod "/var/run/tor" #o750)
1002
1003 ;; Allow Tor to access the hidden services' directories.
6629099a
LC		 1004 (mkdir-p "/var/lib/tor")
1005 (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
1006 (chmod "/var/lib/tor" #o700)
1007
ba9f0db0
LC		 1008 ;; Make sure /var/lib is accessible to the 'tor' user.
1009 (chmod "/var/lib" #o755)
1010
6331bde7
LC		 1011 (for-each initialize
1012 '#$(map hidden-service-name
1013 (tor-configuration-hidden-services config)))))
1014
0adfe95a
LC		 1015(define tor-service-type
1016 (service-type (name 'tor)
1017 (extensions
d4053c71
AK		 1018 (list (service-extension shepherd-root-service-type
1019 tor-shepherd-service)
0adfe95a 1020 (service-extension account-service-type
6331bde7
LC		 1021 (const %tor-accounts))
1022 (service-extension activation-service-type
d973915e 1023 tor-activation)))
6331bde7
LC		 1024
1025 ;; This can be extended with hidden services.
1026 (compose concatenate)
1027 (extend (lambda (config services)
1028 (tor-configuration
1029 (inherit config)
1030 (hidden-services
1031 (append (tor-configuration-hidden-services config)
3d3c5650 1032 services)))))
3f0de257
LC		 1033 (default-value (tor-configuration))
1034 (description
1035 "Run the @uref{https://torproject.org, Tor} anonymous
1036networking daemon.")))
63854bcb 1037
6331bde7
LC		 1038(define tor-hidden-service-type
1039 ;; A type that extends Tor with hidden services.
1040 (service-type (name 'tor-hidden-service)
1041 (extensions
3f0de257
LC		 1042 (list (service-extension tor-service-type list)))
1043 (description
1044 "Define a new Tor @dfn{hidden service}.")))
6331bde7
LC		 1045
1046(define (tor-hidden-service name mapping)
1047 "Define a new Tor @dfn{hidden service} called @var{name} and implementing
1048@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
1049
1050@example
1051 '((22 \"127.0.0.1:22\")
1052 (80 \"127.0.0.1:8080\"))
1053@end example
1054
1055In this example, port 22 of the hidden service is mapped to local port 22, and
1056port 80 is mapped to local port 8080.
1057
6629099a
LC		 1058This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
1059the @file{hostname} file contains the @code{.onion} host name for the hidden
6331bde7
LC		 1060service.
1061
1062See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
1063project's documentation} for more information."
1064 (service tor-hidden-service-type
1065 (hidden-service name mapping)))
0adfe95a
LC		 1066
1067\f
0adfe95a
LC		 1068;;;
1069;;; Wicd.
1070;;;
1071
1072(define %wicd-activation
1073 ;; Activation gexp for Wicd.
1074 #~(begin
1075 (use-modules (guix build utils))
1076
1077 (mkdir-p "/etc/wicd")
1078 (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
1079 (unless (file-exists? file-name)
1080 (copy-file (string-append #$wicd file-name)
69323016
LC		 1081 file-name)))
1082
1083 ;; Wicd invokes 'wpa_supplicant', which needs this directory for its
1084 ;; named socket files.
1085 (mkdir-p "/var/run/wpa_supplicant")
1086 (chmod "/var/run/wpa_supplicant" #o750)))
0adfe95a 1087
d4053c71
AK		 1088(define (wicd-shepherd-service wicd)
1089 "Return a shepherd service for WICD."
1090 (list (shepherd-service
0adfe95a
LC		 1091 (documentation "Run the Wicd network manager.")
1092 (provision '(networking))
1093 (requirement '(user-processes dbus-system loopback))
1094 (start #~(make-forkexec-constructor
1095 (list (string-append #$wicd "/sbin/wicd")
1096 "--no-daemon")))
1097 (stop #~(make-kill-destructor)))))
1098
1099(define wicd-service-type
1100 (service-type (name 'wicd)
1101 (extensions
d4053c71
AK		 1102 (list (service-extension shepherd-root-service-type
1103 wicd-shepherd-service)
0adfe95a
LC		 1104 (service-extension dbus-root-service-type
1105 list)
1106 (service-extension activation-service-type
87f40011
LC		 1107 (const %wicd-activation))
1108
1109 ;; Add Wicd to the global profile.
3f0de257
LC		 1110 (service-extension profile-service-type list)))
1111 (description
1112 "Run @url{https://launchpad.net/wicd,Wicd}, a network
1113management daemon that aims to simplify wired and wireless networking.")))
4627a464 1114
b7d0c494
MW		 1115(define* (wicd-service #:key (wicd wicd))
1116 "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
87f40011
LC		 1117management daemon that aims to simplify wired and wireless networking.
1118
1119This service adds the @var{wicd} package to the global profile, providing
1120several commands to interact with the daemon and configure networking:
1121@command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
1122and @command{wicd-curses} user interfaces."
0adfe95a 1123 (service wicd-service-type wicd))
b7d0c494 1124
7234ad4f 1125\f
d94e81db
DM		 1126;;;
1127;;; ModemManager
1128;;;
1129
1130(define-record-type* <modem-manager-configuration>
1131 modem-manager-configuration make-modem-manager-configuration
1132 modem-manager-configuration?
1133 (modem-manager modem-manager-configuration-modem-manager
1134 (default modem-manager)))
1135
1136\f
7234ad4f
SB		 1137;;;
1138;;; NetworkManager
1139;;;
1140
b726096b
CB		 1141(define-record-type* <network-manager-configuration>
1142 network-manager-configuration make-network-manager-configuration
1143 network-manager-configuration?
1144 (network-manager network-manager-configuration-network-manager
1145 (default network-manager))
1146 (dns network-manager-configuration-dns
94d2a250 1147 (default "default"))
4e37cf35 1148 (vpn-plugins network-manager-configuration-vpn-plugins ;list of <package>
94d2a250 1149 (default '())))
b726096b 1150
57c16c97
FP		 1151(define network-manager-activation
1152 ;; Activation gexp for NetworkManager
1153 (match-lambda
1154 (($ <network-manager-configuration> network-manager dns vpn-plugins)
1155 #~(begin
1156 (use-modules (guix build utils))
1157 (mkdir-p "/etc/NetworkManager/system-connections")
1158 #$@(if (equal? dns "dnsmasq")
1159 ;; create directory to store dnsmasq lease file
1160 '((mkdir-p "/var/lib/misc"))
1161 '())))))
7234ad4f 1162
94d2a250
LC		 1163(define (vpn-plugin-directory plugins)
1164 "Return a directory containing PLUGINS, the NM VPN plugins."
1165 (directory-union "network-manager-vpn-plugins" plugins))
1166
e52b9534
LC		 1167(define (network-manager-accounts config)
1168 "Return the list of <user-account> and <user-group> for CONFIG."
1169 (define nologin
1170 (file-append shadow "/sbin/nologin"))
1171
1172 (define accounts
1173 (append-map (lambda (package)
1174 (map (lambda (name)
1175 (user-account (system? #t)
1176 (name name)
1177 (group "network-manager")
1178 (comment "NetworkManager helper")
1179 (home-directory "/var/empty")
1180 (create-home-directory? #f)
1181 (shell nologin)))
1182 (or (assoc-ref (package-properties package)
1183 'user-accounts)
1184 '())))
1185 (network-manager-configuration-vpn-plugins config)))
1186
1187 (match accounts
1188 (()
1189 '())
1190 (_
1191 (cons (user-group (name "network-manager") (system? #t))
1192 accounts))))
1193
94d2a250
LC		 1194(define network-manager-environment
1195 (match-lambda
1196 (($ <network-manager-configuration> network-manager dns vpn-plugins)
1197 ;; Define this variable in the global environment such that
1198 ;; "nmcli connection import type openvpn file foo.ovpn" works.
1199 `(("NM_VPN_PLUGIN_DIR"
1200 . ,(file-append (vpn-plugin-directory vpn-plugins)
1201 "/lib/NetworkManager/VPN"))))))
1202
b726096b
CB		 1203(define network-manager-shepherd-service
1204 (match-lambda
94d2a250
LC		 1205 (($ <network-manager-configuration> network-manager dns vpn-plugins)
1206 (let ((conf (plain-file "NetworkManager.conf"
1207 (string-append "[main]\ndns=" dns "\n")))
1208 (vpn (vpn-plugin-directory vpn-plugins)))
1209 (list (shepherd-service
1210 (documentation "Run the NetworkManager.")
1211 (provision '(networking))
1212 (requirement '(user-processes dbus-system wpa-supplicant loopback))
1213 (start #~(make-forkexec-constructor
1214 (list (string-append #$network-manager
1215 "/sbin/NetworkManager")
1216 (string-append "--config=" #$conf)
1217 "--no-daemon")
1218 #:environment-variables
1219 (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
4efdede2
JL		 1220 "/lib/NetworkManager/VPN")
1221 ;; Override non-existent default users
1222 "NM_OPENVPN_USER="
1223 "NM_OPENVPN_GROUP=")))
94d2a250 1224 (stop #~(make-kill-destructor))))))))
7234ad4f
SB		 1225
1226(define network-manager-service-type
b726096b 1227 (let
40557aea 1228 ((config->packages
b726096b 1229 (match-lambda
40557aea
JL		 1230 (($ <network-manager-configuration> network-manager _ vpn-plugins)
1231 `(,network-manager ,@vpn-plugins)))))
b726096b
CB		 1232
1233 (service-type
1234 (name 'network-manager)
1235 (extensions
1236 (list (service-extension shepherd-root-service-type
1237 network-manager-shepherd-service)
40557aea
JL		 1238 (service-extension dbus-root-service-type config->packages)
1239 (service-extension polkit-service-type
1240 (compose
1241 list
1242 network-manager-configuration-network-manager))
e52b9534
LC		 1243 (service-extension account-service-type
1244 network-manager-accounts)
b726096b 1245 (service-extension activation-service-type
57c16c97 1246 network-manager-activation)
94d2a250
LC		 1247 (service-extension session-environment-service-type
1248 network-manager-environment)
b726096b 1249 ;; Add network-manager to the system profile.
40557aea 1250 (service-extension profile-service-type config->packages)))
3f0de257
LC		 1251 (default-value (network-manager-configuration))
1252 (description
1253 "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
1254NetworkManager}, a network management daemon that aims to simplify wired and
1255wireless networking."))))
7234ad4f 1256
76192896
EF		 1257\f
1258;;;
1259;;; Connman
1260;;;
1261
34d60c49
MO		 1262(define-record-type* <connman-configuration>
1263 connman-configuration make-connman-configuration
1264 connman-configuration?
1265 (connman connman-configuration-connman
1266 (default connman))
1267 (disable-vpn? connman-configuration-disable-vpn?
1268 (default #f)))
1269
1270(define (connman-activation config)
1271 (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
1272 (with-imported-modules '((guix build utils))
1273 #~(begin
1274 (use-modules (guix build utils))
1275 (mkdir-p "/var/lib/connman/")
1276 (unless #$disable-vpn?
1277 (mkdir-p "/var/lib/connman-vpn/"))))))
1278
1279(define (connman-shepherd-service config)
76192896 1280 "Return a shepherd service for Connman"
34d60c49
MO		 1281 (and
1282 (connman-configuration? config)
1283 (let ((connman (connman-configuration-connman config))
1284 (disable-vpn? (connman-configuration-disable-vpn? config)))
1285 (list (shepherd-service
1286 (documentation "Run Connman")
1287 (provision '(networking))
1288 (requirement
1289 '(user-processes dbus-system loopback wpa-supplicant))
1290 (start #~(make-forkexec-constructor
1291 (list (string-append #$connman
1292 "/sbin/connmand")
0ba3a38b
EF		 1293 "--nodaemon"
1294 "--nodnsproxy"
06e5c3af
LC		 1295 #$@(if disable-vpn? '("--noplugin=vpn") '()))
1296
1297 ;; As connman(8) notes, when passing '-n', connman
1298 ;; "directs log output to the controlling terminal in
1299 ;; addition to syslog." Redirect stdout and stderr
1300 ;; to avoid spamming the console (XXX: for some reason
1301 ;; redirecting to /dev/null doesn't work.)
1302 #:log-file "/var/log/connman.log"))
34d60c49 1303 (stop #~(make-kill-destructor)))))))
76192896
EF		 1304
1305(define connman-service-type
34d60c49
MO		 1306 (let ((connman-package (compose list connman-configuration-connman)))
1307 (service-type (name 'connman)
1308 (extensions
1309 (list (service-extension shepherd-root-service-type
1310 connman-shepherd-service)
d8ac7987
EF		 1311 (service-extension polkit-service-type
1312 connman-package)
34d60c49
MO		 1313 (service-extension dbus-root-service-type
1314 connman-package)
1315 (service-extension activation-service-type
1316 connman-activation)
1317 ;; Add connman to the system profile.
1318 (service-extension profile-service-type
3f0de257 1319 connman-package)))
9b0e5146 1320 (default-value (connman-configuration))
3f0de257
LC		 1321 (description
1322 "Run @url{https://01.org/connman,Connman},
1323a network connection manager."))))
2cccbc2a
TČ		 1324
1325\f
d94e81db
DM		 1326;;;
1327;;; Modem manager
1328;;;
1329
1330(define modem-manager-service-type
1331 (let ((config->package
1332 (match-lambda
1333 (($ <modem-manager-configuration> modem-manager)
1334 (list modem-manager)))))
1335 (service-type (name 'modem-manager)
1336 (extensions
1337 (list (service-extension dbus-root-service-type
1338 config->package)
1339 (service-extension udev-service-type
1340 config->package)
1341 (service-extension polkit-service-type
1342 config->package)))
1343 (default-value (modem-manager-configuration))
1344 (description
1345 "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
1346ModemManager}, a modem management daemon that aims to simplify dialup
1347networking."))))
1348
1349\f
f5be5104
FP		 1350;;;
1351;;; USB_ModeSwitch
1352;;;
1353
1354(define-record-type* <usb-modeswitch-configuration>
1355 usb-modeswitch-configuration make-usb-modeswitch-configuration
1356 usb-modeswitch-configuration?
1357 (usb-modeswitch usb-modeswitch-configuration-usb-modeswitch
1358 (default usb-modeswitch))
1359 (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
1360 (default usb-modeswitch-data))
1361 (config-file usb-modeswitch-configuration-config-file
1362 (default #~(string-append #$usb-modeswitch:dispatcher
1363 "/etc/usb_modeswitch.conf"))))
1364
1365(define (usb-modeswitch-sh usb-modeswitch config-file)
1366 "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
1367modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
1368and wrap it to actually find the dispatcher in USB-MODESWITCH. The script
1369will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
1370device is detected."
1371 (computed-file
1372 "usb_modeswitch-sh"
1373 (with-imported-modules '((guix build utils))
1374 #~(begin
1375 (use-modules (guix build utils))
1376 (let ((cfg-param
1377 #$(if config-file
1378 #~(string-append " --config-file=" #$config-file)
1379 "")))
1380 (mkdir #$output)
1381 (install-file (string-append #$usb-modeswitch:dispatcher
1382 "/lib/udev/usb_modeswitch")
1383 #$output)
1384
1385 ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
1386 (substitute* (string-append #$output "/usb_modeswitch")
1387 (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
1388 (string-append left cfg-param right))
1389 (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
1390 (string-append left cfg-param right)))
1391
1392 ;; wrap-program needs bash in PATH:
1393 (putenv (string-append "PATH=" #$bash "/bin"))
1394 (wrap-program (string-append #$output "/usb_modeswitch")
1395 `("PATH" ":" = (,(string-append #$coreutils "/bin")
1396 ,(string-append
1397 #$usb-modeswitch:dispatcher
1398 "/bin")))))))))
1399
1400(define (usb-modeswitch-configuration->udev-rules config)
1401 "Build a rules file for extending udev-service-type from the rules in the
1402usb-modeswitch package specified in CONFIG. The rules file will invoke
1403usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
1404config file."
1405 (match config
1406 (($ <usb-modeswitch-configuration> usb-modeswitch data config-file)
1407 (computed-file
1408 "usb_modeswitch.rules"
1409 (with-imported-modules '((guix build utils))
1410 #~(begin
1411 (use-modules (guix build utils))
1412 (let ((in (string-append #$data "/udev/40-usb_modeswitch.rules"))
1413 (out (string-append #$output "/lib/udev/rules.d"))
1414 (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
1415 (mkdir-p out)
1416 (chdir out)
1417 (install-file in out)
1418 (substitute* "40-usb_modeswitch.rules"
1419 (("PROGRAM=\"usb_modeswitch")
1420 (string-append "PROGRAM=\"" script "/usb_modeswitch"))
1421 (("RUN\\+=\"usb_modeswitch")
1422 (string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
1423
1424(define usb-modeswitch-service-type
1425 (service-type
1426 (name 'usb-modeswitch)
1427 (extensions
1428 (list
1429 (service-extension
1430 udev-service-type
1431 (lambda (config)
1432 (let ((rules (usb-modeswitch-configuration->udev-rules config)))
1433 (list rules))))))
1434 (default-value (usb-modeswitch-configuration))
1435 (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
1436USB_ModeSwitch}, a mode switching tool for controlling USB devices with
1437multiple @dfn{modes}. When plugged in for the first time many USB
1438devices (primarily high-speed WAN modems) act like a flash storage containing
1439installers for Windows drivers. USB_ModeSwitch replays the sequence the
1440Windows drivers would send to switch their mode from storage to modem (or
1441whatever the thing is supposed to do).")))
1442
1443\f
2cccbc2a
TČ		 1444;;;
1445;;; WPA supplicant
1446;;;
1447
acce0a47
MB		 1448(define-record-type* <wpa-supplicant-configuration>
1449 wpa-supplicant-configuration make-wpa-supplicant-configuration
1450 wpa-supplicant-configuration?
1451 (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;<package>
1452 (default wpa-supplicant))
4d060767 1453 (requirement wpa-supplicant-configuration-requirement ;list of symbols
d48b17ad 1454 (default '(user-processes loopback syslogd)))
acce0a47
MB		 1455 (pid-file wpa-supplicant-configuration-pid-file ;string
1456 (default "/var/run/wpa_supplicant.pid"))
1457 (dbus? wpa-supplicant-configuration-dbus? ;Boolean
1458 (default #t))
1459 (interface wpa-supplicant-configuration-interface ;#f | string
1460 (default #f))
1461 (config-file wpa-supplicant-configuration-config-file ;#f | <file-like>
1462 (default #f))
1463 (extra-options wpa-supplicant-configuration-extra-options ;list of strings
1464 (default '())))
1465
1466(define wpa-supplicant-shepherd-service
1467 (match-lambda
4d060767
MB		 1468 (($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
1469 interface config-file extra-options)
acce0a47
MB		 1470 (list (shepherd-service
1471 (documentation "Run the WPA supplicant daemon")
1472 (provision '(wpa-supplicant))
d48b17ad
MB		 1473 (requirement (if dbus?
1474 (cons 'dbus-system requirement)
1475 requirement))
acce0a47
MB		 1476 (start #~(make-forkexec-constructor
1477 (list (string-append #$wpa-supplicant
1478 "/sbin/wpa_supplicant")
1479 (string-append "-P" #$pid-file)
1480 "-B" ;run in background
177bc62d 1481 "-s" ;log to syslogd
acce0a47
MB		 1482 #$@(if dbus?
1483 #~("-u")
1484 #~())
1485 #$@(if interface
3d472b5e 1486 #~((string-append "-i" #$interface))
acce0a47
MB		 1487 #~())
1488 #$@(if config-file
3d472b5e 1489 #~((string-append "-c" #$config-file))
acce0a47
MB		 1490 #~())
1491 #$@extra-options)
1492 #:pid-file #$pid-file))
1493 (stop #~(make-kill-destructor)))))))
2cccbc2a
TČ		 1494
1495(define wpa-supplicant-service-type
acce0a47
MB		 1496 (let ((config->package
1497 (match-lambda
1498 (($ <wpa-supplicant-configuration> wpa-supplicant)
1499 (list wpa-supplicant)))))
1500 (service-type (name 'wpa-supplicant)
1501 (extensions
1502 (list (service-extension shepherd-root-service-type
1503 wpa-supplicant-shepherd-service)
1504 (service-extension dbus-root-service-type config->package)
1505 (service-extension profile-service-type config->package)))
1506 (description "Run the WPA Supplicant daemon, a service that
1507implements authentication, key negotiation and more for wireless networks.")
1508 (default-value (wpa-supplicant-configuration)))))
2cccbc2a 1509
c32d02fe 1510\f
a03943ec
LC		 1511;;;
1512;;; Hostapd.
1513;;;
1514
1515(define-record-type* <hostapd-configuration>
1516 hostapd-configuration make-hostapd-configuration
1517 hostapd-configuration?
1518 (package hostapd-configuration-package
1519 (default hostapd))
1520 (interface hostapd-configuration-interface ;string
1521 (default "wlan0"))
1522 (ssid hostapd-configuration-ssid) ;string
1523 (broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean
1524 (default #t))
1525 (channel hostapd-configuration-channel ;integer
1526 (default 1))
1527 (driver hostapd-configuration-driver ;string
1528 (default "nl80211"))
1529 ;; See <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> for a list of
1530 ;; additional options we could add.
1531 (extra-settings hostapd-configuration-extra-settings ;string
1532 (default "")))
1533
1534(define (hostapd-configuration-file config)
1535 "Return the configuration file for CONFIG, a <hostapd-configuration>."
1536 (match-record config <hostapd-configuration>
1537 (interface ssid broadcast-ssid? channel driver extra-settings)
1538 (plain-file "hostapd.conf"
1539 (string-append "\
1540# Generated from your Guix configuration.
1541
1542interface=" interface "
1543ssid=" ssid "
1544ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") "
1545channel=" (number->string channel) "\n"
1546extra-settings "\n"))))
1547
1548(define* (hostapd-shepherd-services config #:key (requirement '()))
1549 "Return Shepherd services for hostapd."
1550 (list (shepherd-service
1551 (provision '(hostapd))
1552 (requirement `(user-processes ,@requirement))
1553 (documentation "Run the hostapd WiFi access point daemon.")
1554 (start #~(make-forkexec-constructor
62a8d487
BW		 1555 (list #$(file-append (hostapd-configuration-package config)
1556 "/sbin/hostapd")
a03943ec
LC		 1557 #$(hostapd-configuration-file config))
1558 #:log-file "/var/log/hostapd.log"))
1559 (stop #~(make-kill-destructor)))))
1560
1561(define hostapd-service-type
1562 (service-type
1563 (name 'hostapd)
1564 (extensions
1565 (list (service-extension shepherd-root-service-type
1566 hostapd-shepherd-services)))
1567 (description
1568 "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access
1569points and authentication servers.")))
1570
5e7076f2
LC		 1571(define (simulated-wifi-shepherd-services config)
1572 "Return Shepherd services to run hostapd with CONFIG, a
1573<hostapd-configuration>, as well as services to set up WiFi hardware
1574simulation."
1575 (append (hostapd-shepherd-services config
1576 #:requirement
1577 '(unblocked-wifi
ef20acae 1578 kernel-module-loader))
5e7076f2
LC		 1579 (list (shepherd-service
1580 (provision '(unblocked-wifi))
ef20acae 1581 (requirement '(file-systems kernel-module-loader))
5e7076f2
LC		 1582 (documentation
1583 "Unblock WiFi devices for use by mac80211_hwsim.")
1584 (start #~(lambda _
1585 (invoke #$(file-append util-linux "/sbin/rfkill")
1586 "unblock" "0")
1587 (invoke #$(file-append util-linux "/sbin/rfkill")
1588 "unblock" "1")))
5e7076f2
LC		 1589 (one-shot? #t)))))
1590
1591(define simulated-wifi-service-type
1592 (service-type
1593 (name 'simulated-wifi)
1594 (extensions
1595 (list (service-extension shepherd-root-service-type
ef20acae
BW		 1596 simulated-wifi-shepherd-services)
1597 (service-extension kernel-module-loader-service-type
1598 (const '("mac80211_hwsim")))))
5e7076f2
LC		 1599 (default-value (hostapd-configuration
1600 (interface "wlan1")
1601 (ssid "Test Network")))
1602 (description "Run hostapd to simulate WiFi connectivity.")))
1603
a03943ec 1604\f
c32d02fe
SB		 1605;;;
1606;;; Open vSwitch
1607;;;
1608
1609(define-record-type* <openvswitch-configuration>
1610 openvswitch-configuration make-openvswitch-configuration
1611 openvswitch-configuration?
1612 (package openvswitch-configuration-package
1613 (default openvswitch)))
1614
1615(define openvswitch-activation
1616 (match-lambda
1617 (($ <openvswitch-configuration> package)
1618 (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
1619 (with-imported-modules '((guix build utils))
1620 #~(begin
1621 (use-modules (guix build utils))
1622 (mkdir-p "/var/run/openvswitch")
1623 (mkdir-p "/var/lib/openvswitch")
1624 (let ((conf.db "/var/lib/openvswitch/conf.db"))
1625 (unless (file-exists? conf.db)
1626 (system* #$ovsdb-tool "create" conf.db)))))))))
1627
1628(define openvswitch-shepherd-service
1629 (match-lambda
1630 (($ <openvswitch-configuration> package)
1631 (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
1632 (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
1633 (list
1634 (shepherd-service
1635 (provision '(ovsdb))
1636 (documentation "Run the Open vSwitch database server.")
1637 (start #~(make-forkexec-constructor
1638 (list #$ovsdb-server "--pidfile"
1639 "--remote=punix:/var/run/openvswitch/db.sock")
1640 #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
1641 (stop #~(make-kill-destructor)))
1642 (shepherd-service
1643 (provision '(vswitchd))
1644 (requirement '(ovsdb))
1645 (documentation "Run the Open vSwitch daemon.")
1646 (start #~(make-forkexec-constructor
1647 (list #$ovs-vswitchd "--pidfile")
1648 #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
1649 (stop #~(make-kill-destructor))))))))
1650
1651(define openvswitch-service-type
1652 (service-type
1653 (name 'openvswitch)
1654 (extensions
1655 (list (service-extension activation-service-type
1656 openvswitch-activation)
1657 (service-extension profile-service-type
1658 (compose list openvswitch-configuration-package))
1659 (service-extension shepherd-root-service-type
3f0de257
LC		 1660 openvswitch-shepherd-service)))
1661 (description
1662 "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
1663switch designed to enable massive network automation through programmatic
e73ded3c
MB		 1664extension.")
1665 (default-value (openvswitch-configuration))))
c32d02fe 1666
9926b8f8
AI		 1667;;;
1668;;; iptables
1669;;;
1670
1671(define %iptables-accept-all-rules
1672 (plain-file "iptables-accept-all.rules"
1673 "*filter
1674:INPUT ACCEPT
1675:FORWARD ACCEPT
1676:OUTPUT ACCEPT
1677COMMIT
1678"))
1679
1680(define-record-type* <iptables-configuration>
1681 iptables-configuration make-iptables-configuration iptables-configuration?
1682 (iptables iptables-configuration-iptables
1683 (default iptables))
1684 (ipv4-rules iptables-configuration-ipv4-rules
1685 (default %iptables-accept-all-rules))
1686 (ipv6-rules iptables-configuration-ipv6-rules
1687 (default %iptables-accept-all-rules)))
1688
1689(define iptables-shepherd-service
1690 (match-lambda
1691 (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
1692 (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
1693 (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
1694 (shepherd-service
1695 (documentation "Packet filtering framework")
1696 (provision '(iptables))
1697 (start #~(lambda _
1698 (invoke #$iptables-restore #$ipv4-rules)
1699 (invoke #$ip6tables-restore #$ipv6-rules)))
1700 (stop #~(lambda _
1701 (invoke #$iptables-restore #$%iptables-accept-all-rules)
1702 (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
1703
1704(define iptables-service-type
1705 (service-type
1706 (name 'iptables)
1707 (description
1708 "Run @command{iptables-restore}, setting up the specified rules.")
1709 (extensions
1710 (list (service-extension shepherd-root-service-type
1711 (compose list iptables-shepherd-service))))))
1712
3c4f5ad7
SB		 1713;;;
1714;;; nftables
1715;;;
1716
1717(define %default-nftables-ruleset
1718 (plain-file "nftables.conf"
1719 "# A simple and safe firewall
1720table inet filter {
1721 chain input {
1722 type filter hook input priority 0; policy drop;
1723
1724 # early drop of invalid connections
1725 ct state invalid drop
1726
1727 # allow established/related connections
1728 ct state { established, related } accept
1729
1730 # allow from loopback
1731 iifname lo accept
1732
1733 # allow icmp
1734 ip protocol icmp accept
1735 ip6 nexthdr icmpv6 accept
1736
1737 # allow ssh
1738 tcp dport ssh accept
1739
1740 # reject everything else
1741 reject with icmpx type port-unreachable
1742 }
1743 chain forward {
1744 type filter hook forward priority 0; policy drop;
1745 }
1746 chain output {
1747 type filter hook output priority 0; policy accept;
1748 }
1749}
1750"))
1751
1752(define-record-type* <nftables-configuration>
1753 nftables-configuration
1754 make-nftables-configuration
1755 nftables-configuration?
1756 (package nftables-configuration-package
1757 (default nftables))
1758 (ruleset nftables-configuration-ruleset ; file-like object
1759 (default %default-nftables-ruleset)))
1760
1761(define nftables-shepherd-service
1762 (match-lambda
1763 (($ <nftables-configuration> package ruleset)
1764 (let ((nft (file-append package "/sbin/nft")))
1765 (shepherd-service
1766 (documentation "Packet filtering and classification")
1767 (provision '(nftables))
1768 (start #~(lambda _
1769 (invoke #$nft "--file" #$ruleset)))
1770 (stop #~(lambda _
1771 (invoke #$nft "flush" "ruleset"))))))))
1772
1773(define nftables-service-type
1774 (service-type
1775 (name 'nftables)
1776 (description
1777 "Run @command{nft}, setting up the specified ruleset.")
1778 (extensions
1779 (list (service-extension shepherd-root-service-type
1780 (compose list nftables-shepherd-service))
1781 (service-extension profile-service-type
1782 (compose list nftables-configuration-package))))
1783 (default-value (nftables-configuration))))
1784
a2161c86
AG		 1785\f
1786;;;
1787;;; PageKite
1788;;;
1789
1790(define-record-type* <pagekite-configuration>
1791 pagekite-configuration
1792 make-pagekite-configuration
1793 pagekite-configuration?
1794 (package pagekite-configuration-package
1795 (default pagekite))
1796 (kitename pagekite-configuration-kitename
1797 (default #f))
1798 (kitesecret pagekite-configuration-kitesecret
1799 (default #f))
1800 (frontend pagekite-configuration-frontend
1801 (default #f))
1802 (kites pagekite-configuration-kites
1803 (default '("http:@kitename:localhost:80:@kitesecret")))
1804 (extra-file pagekite-configuration-extra-file
1805 (default #f)))
1806
1807(define (pagekite-configuration-file config)
1808 (match-record config <pagekite-configuration>
1809 (package kitename kitesecret frontend kites extra-file)
1810 (mixed-text-file "pagekite.rc"
1811 (if extra-file
1812 (string-append "optfile = " extra-file "\n")
1813 "")
1814 (if kitename
1815 (string-append "kitename = " kitename "\n")
1816 "")
1817 (if kitesecret
1818 (string-append "kitesecret = " kitesecret "\n")
1819 "")
1820 (if frontend
1821 (string-append "frontend = " frontend "\n")
1822 "defaults\n")
1823 (string-join (map (lambda (kite)
1824 (string-append "service_on = " kite))
1825 kites)
1826 "\n"
1827 'suffix))))
1828
1829(define (pagekite-shepherd-service config)
1830 (match-record config <pagekite-configuration>
1831 (package kitename kitesecret frontend kites extra-file)
1832 (with-imported-modules (source-module-closure
1833 '((gnu build shepherd)
1834 (gnu system file-systems)))
1835 (shepherd-service
1836 (documentation "Run the PageKite service.")
1837 (provision '(pagekite))
1838 (requirement '(networking))
1839 (modules '((gnu build shepherd)
1840 (gnu system file-systems)))
1841 (start #~(make-forkexec-constructor/container
1842 (list #$(file-append package "/bin/pagekite")
1843 "--clean"
1844 "--nullui"
1845 "--nocrashreport"
1846 "--runas=pagekite:pagekite"
1847 (string-append "--optfile="
1848 #$(pagekite-configuration-file config)))
1849 #:log-file "/var/log/pagekite.log"
1850 #:mappings #$(if extra-file
1851 #~(list (file-system-mapping
1852 (source #$extra-file)
1853 (target source)))
1854 #~'())))
1855 ;; SIGTERM doesn't always work for some reason.
1856 (stop #~(make-kill-destructor SIGINT))))))
1857
1858(define %pagekite-accounts
1859 (list (user-group (name "pagekite") (system? #t))
1860 (user-account
1861 (name "pagekite")
1862 (group "pagekite")
1863 (system? #t)
1864 (comment "PageKite user")
1865 (home-directory "/var/empty")
1866 (shell (file-append shadow "/sbin/nologin")))))
1867
1868(define pagekite-service-type
1869 (service-type
1870 (name 'pagekite)
1871 (default-value (pagekite-configuration))
1872 (extensions
1873 (list (service-extension shepherd-root-service-type
1874 (compose list pagekite-shepherd-service))
1875 (service-extension account-service-type
1876 (const %pagekite-accounts))))
1877 (description
1878 "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
1879local servers publicly accessible on the web, even behind NATs and firewalls.")))
1880
fe1cd098 1881\f
1882;;;
1883;;; Yggdrasil
1884;;;
1885
1886(define-record-type* <yggdrasil-configuration>
1887 yggdrasil-configuration
1888 make-yggdrasil-configuration
1889 yggdrasil-configuration?
1890 (package yggdrasil-configuration-package
1891 (default yggdrasil))
1892 (json-config yggdrasil-configuration-json-config
1893 (default '()))
1894 (config-file yggdrasil-config-file
1895 (default "/etc/yggdrasil-private.conf"))
1896 (autoconf? yggdrasil-configuration-autoconf?
1897 (default #f))
1898 (log-level yggdrasil-configuration-log-level
1899 (default 'info))
1900 (log-to yggdrasil-configuration-log-to
1901 (default 'stdout)))
1902
1903(define (yggdrasil-configuration-file config)
1904 (define (scm->yggdrasil-json x)
1905 (define key-value?
1906 dotted-list?)
1907 (define (param->camel str)
1908 (string-concatenate
1909 (map
1910 string-capitalize
1911 (string-split str (cut eqv? <> #\-)))))
1912 (cond
1913 ((key-value? x)
1914 (let ((k (car x))
1915 (v (cdr x)))
1916 (cons
1917 (if (symbol? k)
1918 (param->camel (symbol->string k))
1919 k)
1920 v)))
1921 ((list? x) (map scm->yggdrasil-json x))
1922 ((vector? x) (vector-map scm->yggdrasil-json x))
1923 (else x)))
1924 (computed-file
1925 "yggdrasil.conf"
1926 #~(call-with-output-file #$output
1927 (lambda (port)
1928 ;; it's HJSON, so comments are a-okay
1929 (display "# Generated by yggdrasil-service\n" port)
1930 (display #$(scm->json-string
1931 (scm->yggdrasil-json
1932 (yggdrasil-configuration-json-config config)))
1933 port)))))
1934
1935(define (yggdrasil-shepherd-service config)
1936 "Return a <shepherd-service> for yggdrasil with CONFIG."
1937 (define yggdrasil-command
1938 #~(append
1939 (list (string-append
1940 #$(yggdrasil-configuration-package config)
1941 "/bin/yggdrasil")
1942 "-useconffile"
1943 #$(yggdrasil-configuration-file config))
1944 (if #$(yggdrasil-configuration-autoconf? config)
1945 '("-autoconf")
1946 '())
1947 (let ((extraconf #$(yggdrasil-config-file config)))
1948 (if extraconf
1949 (list "-extraconffile" extraconf)
1950 '()))
1951 (list "-loglevel"
1952 #$(symbol->string
1953 (yggdrasil-configuration-log-level config))
1954 "-logto"
1955 #$(symbol->string
1956 (yggdrasil-configuration-log-to config)))))
1957 (list (shepherd-service
1958 (documentation "Connect to the Yggdrasil mesh network")
1959 (provision '(yggdrasil))
1960 (requirement '(networking))
1961 (start #~(make-forkexec-constructor
1962 #$yggdrasil-command
1963 #:log-file "/var/log/yggdrasil.log"
1964 #:group "yggdrasil"))
1965 (stop #~(make-kill-destructor)))))
1966
1967(define %yggdrasil-accounts
1968 (list (user-group (name "yggdrasil") (system? #t))))
1969
1970(define yggdrasil-service-type
1971 (service-type
1972 (name 'yggdrasil)
1973 (description
1974 "Connect to the Yggdrasil mesh network.
1975See yggdrasil -genconf for config options.")
1976 (extensions
1977 (list (service-extension shepherd-root-service-type
1978 yggdrasil-shepherd-service)
1979 (service-extension account-service-type
1980 (const %yggdrasil-accounts))
1981 (service-extension profile-service-type
1982 (compose list yggdrasil-configuration-package))))))
1983
4e511fcf 1984\f
2978832b
MD		 1985;;;
1986;;; IPFS
1987;;;
1988
1989(define-record-type* <ipfs-configuration>
1990 ipfs-configuration
1991 make-ipfs-configuration
1992 ipfs-configuration?
1993 (package ipfs-configuration-package
1994 (default go-ipfs))
1995 (gateway ipfs-configuration-gateway
1996 (default "/ip4/127.0.0.1/tcp/8082"))
1997 (api ipfs-configuration-api
1998 (default "/ip4/127.0.0.1/tcp/5001")))
1999
2000(define %ipfs-home "/var/lib/ipfs")
2001
2002(define %ipfs-accounts
2003 (list (user-account
2004 (name "ipfs")
2005 (group "ipfs")
2006 (system? #t)
2007 (comment "IPFS daemon user")
2008 (home-directory "/var/lib/ipfs")
2009 (shell (file-append shadow "/sbin/nologin")))
2010 (user-group
2011 (name "ipfs")
2012 (system? #t))))
2013
2014(define (ipfs-binary config)
2015 (file-append (ipfs-configuration-package config) "/bin/ipfs"))
2016
2017(define %ipfs-home-mapping
2018 #~(file-system-mapping
2019 (source #$%ipfs-home)
2020 (target #$%ipfs-home)
2021 (writable? #t)))
2022
2023(define %ipfs-environment
2024 #~(list #$(string-append "HOME=" %ipfs-home)))
2025
2026(define (ipfs-shepherd-service config)
2027 "Return a <shepherd-service> for IPFS with CONFIG."
2028 (define ipfs-daemon-command
2029 #~(list #$(ipfs-binary config) "daemon"))
2030 (list
2031 (with-imported-modules (source-module-closure
2032 '((gnu build shepherd)
2033 (gnu system file-systems)))
2034 (shepherd-service
2035 (provision '(ipfs))
2036 ;; While IPFS is most useful when the machine is connected
2037 ;; to the network, only loopback is required for starting
2038 ;; the service.
2039 (requirement '(loopback))
2040 (documentation "Connect to the IPFS network")
2041 (modules '((gnu build shepherd)
2042 (gnu system file-systems)))
2043 (start #~(make-forkexec-constructor/container
2044 #$ipfs-daemon-command
2045 #:namespaces '#$(fold delq %namespaces '(user net))
2046 #:mappings (list #$%ipfs-home-mapping)
2047 #:log-file "/var/log/ipfs.log"
2048 #:user "ipfs"
2049 #:group "ipfs"
2050 #:environment-variables #$%ipfs-environment))
2051 (stop #~(make-kill-destructor))))))
2052
2053(define (%ipfs-activation config)
2054 "Return an activation gexp for IPFS with CONFIG"
2055 (define (ipfs-config-command setting value)
2056 #~(#$(ipfs-binary config) "config" #$setting #$value))
2057 (define (set-config!-gexp setting value)
2058 #~(system* #$@(ipfs-config-command setting value)))
2059 (define settings
2060 `(("Addresses.API" ,(ipfs-configuration-api config))
2061 ("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
2062 (define inner-gexp
2063 #~(begin
2064 (umask #o077)
2065 ;; Create $HOME/.ipfs structure
2066 (system* #$(ipfs-binary config) "init")
2067 ;; Apply settings
2068 #$@(map (cute apply set-config!-gexp <>) settings)))
2069 (define inner-script
2070 (program-file "ipfs-activation-inner" inner-gexp))
2071 ;; Run ipfs init and ipfs config from a container,
2072 ;; in case the IPFS daemon was compromised at some point
2073 ;; and ~/.ipfs is now a symlink to somewhere outside
2074 ;; %ipfs-home.
2075 (define container-gexp
2076 (with-extensions (list shepherd)
2077 (with-imported-modules (source-module-closure
2078 '((gnu build shepherd)
2079 (gnu system file-systems)))
2080 #~(begin
2081 (use-modules (gnu build shepherd)
2082 (gnu system file-systems))
2083 (let* ((constructor
2084 (make-forkexec-constructor/container
2085 (list #$inner-script)
2086 #:namespaces '#$(fold delq %namespaces '(user))
2087 #:mappings (list #$%ipfs-home-mapping)
2088 #:user "ipfs"
2089 #:group "ipfs"
2090 #:environment-variables #$%ipfs-environment))
2091 (pid (constructor)))
2092 (waitpid pid))))))
2093 ;; The activation may happen from the initrd, which uses
2094 ;; a statically-linked guile, while the guix container
2095 ;; procedures require a working dynamic-link.
2096 (define container-script
2097 (program-file "ipfs-activation-container" container-gexp))
2098 #~(system* #$container-script))
2099
2100(define ipfs-service-type
2101 (service-type
2102 (name 'ipfs)
2103 (extensions
2104 (list (service-extension account-service-type
2105 (const %ipfs-accounts))
2106 (service-extension activation-service-type
2107 %ipfs-activation)
2108 (service-extension shepherd-root-service-type
2109 ipfs-shepherd-service)))
2110 (default-value (ipfs-configuration))
2111 (description
2112 "Run @command{ipfs daemon}, the reference implementation
4d0d6d86 2113of the IPFS peer-to-peer storage network.")))
2978832b
MD		 2114
2115\f
4e511fcf
OP		 2116;;;
2117;;; Keepalived
2118;;;
2119
2120(define-record-type* <keepalived-configuration>
2121 keepalived-configuration make-keepalived-configuration
2122 keepalived-configuration?
2123 (keepalived keepalived-configuration-keepalived ;<package>
2124 (default keepalived))
2125 (config-file keepalived-configuration-config-file ;file-like
2126 (default #f)))
2127
2128(define keepalived-shepherd-service
2129 (match-lambda
2130 (($ <keepalived-configuration> keepalived config-file)
2131 (list
2132 (shepherd-service
2133 (provision '(keepalived))
2134 (documentation "Run keepalived.")
2135 (requirement '(loopback))
2136 (start #~(make-forkexec-constructor
2137 (list (string-append #$keepalived "/sbin/keepalived")
2138 "--dont-fork" "--log-console" "--log-detail"
2139 "--pid=/var/run/keepalived.pid"
2140 (string-append "--use-file=" #$config-file))
2141 #:pid-file "/var/run/keepalived.pid"
2142 #:log-file "/var/log/keepalived.log"))
2143 (respawn? #f)
2144 (stop #~(make-kill-destructor)))))))
2145
2146(define keepalived-service-type
2147 (service-type (name 'keepalived)
2148 (extensions (list (service-extension shepherd-root-service-type
2149 keepalived-shepherd-service)))
2150 (description
2151 "Run @uref{https://www.keepalived.org/, Keepalived}
2152routing software.")))
2153
db4fdc04 2154;;; networking.scm ends here
jackhill's copy of GNU Guix: https://guix.gnu.org/