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