HCoop / jackhill / guix / guix.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
services: greetd: Remove unnecessary user groups.
[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
AL		 774specified here. It's also possible to disable bootstrapping by explicitly
775setting this field to the @code{*unspecified*} value.")
fd449608
MC		 776 (port
777 (maybe-number 4222)
8cb1a49a
AL		 778 "The UDP port to bind to. When set to @code{*unspecified*}, an available
779port is automatically 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:
5ee35eb7 921User tor
6629099a 922DataDirectory /var/lib/tor
5dfd80e1 923PidFile /var/run/tor/tor.pid
5ee35eb7 924Log notice syslog\n" port)
3bcb305b
CM		 925 (when (eq? 'unix '#$socks-socket-type)
926 (display "\
927SocksPort unix:/var/run/tor/socks-sock
928UnixSocksGroupWritable 1\n" port))
b309a286
CLW		 929 (when #$control-socket?
930 (display "\
931ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
932ControlSocketsGroupWritable 1\n"
933 port))
6331bde7 934
4ee96a79
LC		 935 (for-each (match-lambda
936 ((service (ports hosts) ...)
937 (format port "\
6629099a 938HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
4ee96a79
LC		 939 service)
940 (for-each (lambda (tcp-port host)
941 (format port "\
6331bde7 942HiddenServicePort ~a ~a~%"
4ee96a79
LC		 943 tcp-port host))
944 ports hosts)))
945 '#$(map (match-lambda
946 (($ <hidden-service> name mapping)
947 (cons name mapping)))
948 services))
949
0975ca3f
TGR		 950 (display "\
951### End of automatically generated lines.\n\n" port)
952
4ee96a79
LC		 953 ;; Append the user's config file.
954 (call-with-input-file #$config-file
955 (lambda (input)
956 (dump-port input port)))
957 #t))))))))
6331bde7 958
d4053c71 959(define (tor-shepherd-service config)
5dfd80e1 960 "Return a <shepherd-service> running Tor."
375c6108 961 (match config
6331bde7
LC		 962 (($ <tor-configuration> tor)
963 (let ((torrc (tor-configuration->torrc config)))
ee295346
LC		 964 (with-imported-modules (source-module-closure
965 '((gnu build shepherd)
966 (gnu system file-systems)))
967 (list (shepherd-service
968 (provision '(tor))
969
970 ;; Tor needs at least one network interface to be up, hence the
971 ;; dependency on 'loopback'.
972 (requirement '(user-processes loopback syslogd))
973
974 (modules '((gnu build shepherd)
975 (gnu system file-systems)))
976
977 (start #~(make-forkexec-constructor/container
978 (list #$(file-append tor "/bin/tor") "-f" #$torrc)
979
8bb45504 980 #:log-file "/var/log/tor.log"
ee295346
LC		 981 #:mappings (list (file-system-mapping
982 (source "/var/lib/tor")
983 (target source)
984 (writable? #t))
985 (file-system-mapping
986 (source "/dev/log") ;for syslog
5dfd80e1
CM		 987 (target source))
988 (file-system-mapping
989 (source "/var/run/tor")
990 (target source)
991 (writable? #t)))
992 #:pid-file "/var/run/tor/tor.pid"))
ee295346
LC		 993 (stop #~(make-kill-destructor))
994 (documentation "Run the Tor anonymous network overlay."))))))))
0adfe95a 995
29c93178 996(define %tor-log-rotation
997 (list (log-rotation
998 (files '("/var/log/tor.log")))))
999
d973915e 1000(define (tor-activation config)
5dfd80e1 1001 "Set up directories for Tor and its hidden services, if any."
6331bde7
LC		 1002 #~(begin
1003 (use-modules (guix build utils))
1004
6629099a
LC		 1005 (define %user
1006 (getpw "tor"))
1007
6331bde7 1008 (define (initialize service)
6629099a
LC		 1009 (let ((directory (string-append "/var/lib/tor/hidden-services/"
1010 service)))
6331bde7 1011 (mkdir-p directory)
6629099a 1012 (chown directory (passwd:uid %user) (passwd:gid %user))
6331bde7
LC		 1013
1014 ;; The daemon bails out if we give wider permissions.
1015 (chmod directory #o700)))
1016
5dfd80e1
CM		 1017 ;; Allow Tor to write its PID file.
1018 (mkdir-p "/var/run/tor")
1019 (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
1020 ;; Set the group permissions to rw so that if the system administrator
1021 ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
1022 ;; of the "tor" group will be able to use the SOCKS socket.
1023 (chmod "/var/run/tor" #o750)
1024
1025 ;; Allow Tor to access the hidden services' directories.
6629099a
LC		 1026 (mkdir-p "/var/lib/tor")
1027 (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
1028 (chmod "/var/lib/tor" #o700)
1029
ba9f0db0
LC		 1030 ;; Make sure /var/lib is accessible to the 'tor' user.
1031 (chmod "/var/lib" #o755)
1032
6331bde7
LC		 1033 (for-each initialize
1034 '#$(map hidden-service-name
1035 (tor-configuration-hidden-services config)))))
1036
0adfe95a
LC		 1037(define tor-service-type
1038 (service-type (name 'tor)
1039 (extensions
d4053c71
AK		 1040 (list (service-extension shepherd-root-service-type
1041 tor-shepherd-service)
0adfe95a 1042 (service-extension account-service-type
6331bde7
LC		 1043 (const %tor-accounts))
1044 (service-extension activation-service-type
29c93178 1045 tor-activation)
1046 (service-extension rottlog-service-type
1047 (const %tor-log-rotation))))
6331bde7
LC		 1048
1049 ;; This can be extended with hidden services.
1050 (compose concatenate)
1051 (extend (lambda (config services)
1052 (tor-configuration
1053 (inherit config)
1054 (hidden-services
1055 (append (tor-configuration-hidden-services config)
3d3c5650 1056 services)))))
3f0de257
LC		 1057 (default-value (tor-configuration))
1058 (description
1059 "Run the @uref{https://torproject.org, Tor} anonymous
1060networking daemon.")))
63854bcb 1061
6331bde7
LC		 1062(define tor-hidden-service-type
1063 ;; A type that extends Tor with hidden services.
1064 (service-type (name 'tor-hidden-service)
1065 (extensions
3f0de257
LC		 1066 (list (service-extension tor-service-type list)))
1067 (description
1068 "Define a new Tor @dfn{hidden service}.")))
6331bde7
LC		 1069
1070(define (tor-hidden-service name mapping)
1071 "Define a new Tor @dfn{hidden service} called @var{name} and implementing
1072@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
1073
1074@example
1075 '((22 \"127.0.0.1:22\")
1076 (80 \"127.0.0.1:8080\"))
1077@end example
1078
1079In this example, port 22 of the hidden service is mapped to local port 22, and
1080port 80 is mapped to local port 8080.
1081
6629099a
LC		 1082This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
1083the @file{hostname} file contains the @code{.onion} host name for the hidden
6331bde7
LC		 1084service.
1085
1086See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
1087project's documentation} for more information."
1088 (service tor-hidden-service-type
1089 (hidden-service name mapping)))
0adfe95a
LC		 1090
1091\f
d94e81db
DM		 1092;;;
1093;;; ModemManager
1094;;;
1095
1096(define-record-type* <modem-manager-configuration>
1097 modem-manager-configuration make-modem-manager-configuration
1098 modem-manager-configuration?
1099 (modem-manager modem-manager-configuration-modem-manager
1100 (default modem-manager)))
1101
1102\f
7234ad4f
SB		 1103;;;
1104;;; NetworkManager
1105;;;
1106
b726096b
CB		 1107(define-record-type* <network-manager-configuration>
1108 network-manager-configuration make-network-manager-configuration
1109 network-manager-configuration?
1110 (network-manager network-manager-configuration-network-manager
1111 (default network-manager))
1112 (dns network-manager-configuration-dns
94d2a250 1113 (default "default"))
892f1b72 1114 (vpn-plugins network-manager-configuration-vpn-plugins ;list of file-like
94d2a250 1115 (default '())))
b726096b 1116
57c16c97
FP		 1117(define network-manager-activation
1118 ;; Activation gexp for NetworkManager
1119 (match-lambda
1120 (($ <network-manager-configuration> network-manager dns vpn-plugins)
1121 #~(begin
1122 (use-modules (guix build utils))
1123 (mkdir-p "/etc/NetworkManager/system-connections")
1124 #$@(if (equal? dns "dnsmasq")
1125 ;; create directory to store dnsmasq lease file
1126 '((mkdir-p "/var/lib/misc"))
1127 '())))))
7234ad4f 1128
94d2a250
LC		 1129(define (vpn-plugin-directory plugins)
1130 "Return a directory containing PLUGINS, the NM VPN plugins."
1131 (directory-union "network-manager-vpn-plugins" plugins))
1132
e52b9534
LC		 1133(define (network-manager-accounts config)
1134 "Return the list of <user-account> and <user-group> for CONFIG."
1135 (define nologin
1136 (file-append shadow "/sbin/nologin"))
1137
1138 (define accounts
1139 (append-map (lambda (package)
1140 (map (lambda (name)
1141 (user-account (system? #t)
1142 (name name)
1143 (group "network-manager")
1144 (comment "NetworkManager helper")
1145 (home-directory "/var/empty")
1146 (create-home-directory? #f)
1147 (shell nologin)))
1148 (or (assoc-ref (package-properties package)
1149 'user-accounts)
1150 '())))
1151 (network-manager-configuration-vpn-plugins config)))
1152
1153 (match accounts
1154 (()
1155 '())
1156 (_
1157 (cons (user-group (name "network-manager") (system? #t))
1158 accounts))))
1159
94d2a250
LC		 1160(define network-manager-environment
1161 (match-lambda
1162 (($ <network-manager-configuration> network-manager dns vpn-plugins)
1163 ;; Define this variable in the global environment such that
1164 ;; "nmcli connection import type openvpn file foo.ovpn" works.
1165 `(("NM_VPN_PLUGIN_DIR"
1166 . ,(file-append (vpn-plugin-directory vpn-plugins)
1167 "/lib/NetworkManager/VPN"))))))
1168
b726096b
CB		 1169(define network-manager-shepherd-service
1170 (match-lambda
94d2a250
LC		 1171 (($ <network-manager-configuration> network-manager dns vpn-plugins)
1172 (let ((conf (plain-file "NetworkManager.conf"
1173 (string-append "[main]\ndns=" dns "\n")))
1174 (vpn (vpn-plugin-directory vpn-plugins)))
1175 (list (shepherd-service
1176 (documentation "Run the NetworkManager.")
1177 (provision '(networking))
1178 (requirement '(user-processes dbus-system wpa-supplicant loopback))
1179 (start #~(make-forkexec-constructor
1180 (list (string-append #$network-manager
1181 "/sbin/NetworkManager")
1182 (string-append "--config=" #$conf)
1183 "--no-daemon")
1184 #:environment-variables
1185 (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
4efdede2
JL		 1186 "/lib/NetworkManager/VPN")
1187 ;; Override non-existent default users
1188 "NM_OPENVPN_USER="
1189 "NM_OPENVPN_GROUP=")))
94d2a250 1190 (stop #~(make-kill-destructor))))))))
7234ad4f
SB		 1191
1192(define network-manager-service-type
b726096b 1193 (let
40557aea 1194 ((config->packages
b726096b 1195 (match-lambda
40557aea
JL		 1196 (($ <network-manager-configuration> network-manager _ vpn-plugins)
1197 `(,network-manager ,@vpn-plugins)))))
b726096b
CB		 1198
1199 (service-type
1200 (name 'network-manager)
1201 (extensions
1202 (list (service-extension shepherd-root-service-type
1203 network-manager-shepherd-service)
40557aea
JL		 1204 (service-extension dbus-root-service-type config->packages)
1205 (service-extension polkit-service-type
1206 (compose
1207 list
1208 network-manager-configuration-network-manager))
e52b9534
LC		 1209 (service-extension account-service-type
1210 network-manager-accounts)
b726096b 1211 (service-extension activation-service-type
57c16c97 1212 network-manager-activation)
94d2a250
LC		 1213 (service-extension session-environment-service-type
1214 network-manager-environment)
b726096b 1215 ;; Add network-manager to the system profile.
40557aea 1216 (service-extension profile-service-type config->packages)))
3f0de257
LC		 1217 (default-value (network-manager-configuration))
1218 (description
1219 "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
1220NetworkManager}, a network management daemon that aims to simplify wired and
1221wireless networking."))))
7234ad4f 1222
76192896
EF		 1223\f
1224;;;
1225;;; Connman
1226;;;
1227
34d60c49
MO		 1228(define-record-type* <connman-configuration>
1229 connman-configuration make-connman-configuration
1230 connman-configuration?
1231 (connman connman-configuration-connman
1232 (default connman))
1233 (disable-vpn? connman-configuration-disable-vpn?
1234 (default #f)))
1235
1236(define (connman-activation config)
1237 (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
1238 (with-imported-modules '((guix build utils))
1239 #~(begin
1240 (use-modules (guix build utils))
1241 (mkdir-p "/var/lib/connman/")
1242 (unless #$disable-vpn?
1243 (mkdir-p "/var/lib/connman-vpn/"))))))
1244
1245(define (connman-shepherd-service config)
76192896 1246 "Return a shepherd service for Connman"
34d60c49
MO		 1247 (and
1248 (connman-configuration? config)
1249 (let ((connman (connman-configuration-connman config))
1250 (disable-vpn? (connman-configuration-disable-vpn? config)))
1251 (list (shepherd-service
1252 (documentation "Run Connman")
1253 (provision '(networking))
1254 (requirement
1255 '(user-processes dbus-system loopback wpa-supplicant))
1256 (start #~(make-forkexec-constructor
1257 (list (string-append #$connman
1258 "/sbin/connmand")
0ba3a38b
EF		 1259 "--nodaemon"
1260 "--nodnsproxy"
06e5c3af
LC		 1261 #$@(if disable-vpn? '("--noplugin=vpn") '()))
1262
1263 ;; As connman(8) notes, when passing '-n', connman
1264 ;; "directs log output to the controlling terminal in
1265 ;; addition to syslog." Redirect stdout and stderr
1266 ;; to avoid spamming the console (XXX: for some reason
1267 ;; redirecting to /dev/null doesn't work.)
1268 #:log-file "/var/log/connman.log"))
34d60c49 1269 (stop #~(make-kill-destructor)))))))
76192896 1270
29c93178 1271(define %connman-log-rotation
1272 (list (log-rotation
1273 (files '("/var/log/connman.log")))))
1274
76192896 1275(define connman-service-type
34d60c49
MO		 1276 (let ((connman-package (compose list connman-configuration-connman)))
1277 (service-type (name 'connman)
1278 (extensions
1279 (list (service-extension shepherd-root-service-type
1280 connman-shepherd-service)
d8ac7987
EF		 1281 (service-extension polkit-service-type
1282 connman-package)
34d60c49
MO		 1283 (service-extension dbus-root-service-type
1284 connman-package)
1285 (service-extension activation-service-type
1286 connman-activation)
1287 ;; Add connman to the system profile.
1288 (service-extension profile-service-type
29c93178 1289 connman-package)
1290 (service-extension rottlog-service-type
1291 (const %connman-log-rotation))))
9b0e5146 1292 (default-value (connman-configuration))
3f0de257
LC		 1293 (description
1294 "Run @url{https://01.org/connman,Connman},
1295a network connection manager."))))
2cccbc2a
TČ		 1296
1297\f
d94e81db
DM		 1298;;;
1299;;; Modem manager
1300;;;
1301
1302(define modem-manager-service-type
1303 (let ((config->package
1304 (match-lambda
1305 (($ <modem-manager-configuration> modem-manager)
1306 (list modem-manager)))))
1307 (service-type (name 'modem-manager)
1308 (extensions
1309 (list (service-extension dbus-root-service-type
1310 config->package)
1311 (service-extension udev-service-type
1312 config->package)
1313 (service-extension polkit-service-type
1314 config->package)))
1315 (default-value (modem-manager-configuration))
1316 (description
1317 "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
1318ModemManager}, a modem management daemon that aims to simplify dialup
1319networking."))))
1320
1321\f
f5be5104
FP		 1322;;;
1323;;; USB_ModeSwitch
1324;;;
1325
1326(define-record-type* <usb-modeswitch-configuration>
1327 usb-modeswitch-configuration make-usb-modeswitch-configuration
1328 usb-modeswitch-configuration?
1329 (usb-modeswitch usb-modeswitch-configuration-usb-modeswitch
1330 (default usb-modeswitch))
1331 (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
1332 (default usb-modeswitch-data))
1333 (config-file usb-modeswitch-configuration-config-file
1334 (default #~(string-append #$usb-modeswitch:dispatcher
1335 "/etc/usb_modeswitch.conf"))))
1336
1337(define (usb-modeswitch-sh usb-modeswitch config-file)
1338 "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
1339modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
1340and wrap it to actually find the dispatcher in USB-MODESWITCH. The script
1341will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
1342device is detected."
1343 (computed-file
1344 "usb_modeswitch-sh"
1345 (with-imported-modules '((guix build utils))
1346 #~(begin
1347 (use-modules (guix build utils))
1348 (let ((cfg-param
1349 #$(if config-file
1350 #~(string-append " --config-file=" #$config-file)
1351 "")))
1352 (mkdir #$output)
1353 (install-file (string-append #$usb-modeswitch:dispatcher
1354 "/lib/udev/usb_modeswitch")
1355 #$output)
1356
1357 ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
1358 (substitute* (string-append #$output "/usb_modeswitch")
1359 (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
1360 (string-append left cfg-param right))
1361 (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
1362 (string-append left cfg-param right)))
1363
1364 ;; wrap-program needs bash in PATH:
1365 (putenv (string-append "PATH=" #$bash "/bin"))
1366 (wrap-program (string-append #$output "/usb_modeswitch")
1367 `("PATH" ":" = (,(string-append #$coreutils "/bin")
1368 ,(string-append
1369 #$usb-modeswitch:dispatcher
1370 "/bin")))))))))
1371
1372(define (usb-modeswitch-configuration->udev-rules config)
1373 "Build a rules file for extending udev-service-type from the rules in the
1374usb-modeswitch package specified in CONFIG. The rules file will invoke
1375usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
1376config file."
1377 (match config
1378 (($ <usb-modeswitch-configuration> usb-modeswitch data config-file)
1379 (computed-file
1380 "usb_modeswitch.rules"
1381 (with-imported-modules '((guix build utils))
1382 #~(begin
1383 (use-modules (guix build utils))
1384 (let ((in (string-append #$data "/udev/40-usb_modeswitch.rules"))
1385 (out (string-append #$output "/lib/udev/rules.d"))
1386 (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
1387 (mkdir-p out)
1388 (chdir out)
1389 (install-file in out)
1390 (substitute* "40-usb_modeswitch.rules"
1391 (("PROGRAM=\"usb_modeswitch")
1392 (string-append "PROGRAM=\"" script "/usb_modeswitch"))
1393 (("RUN\\+=\"usb_modeswitch")
1394 (string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
1395
1396(define usb-modeswitch-service-type
1397 (service-type
1398 (name 'usb-modeswitch)
1399 (extensions
1400 (list
1401 (service-extension
1402 udev-service-type
1403 (lambda (config)
1404 (let ((rules (usb-modeswitch-configuration->udev-rules config)))
1405 (list rules))))))
1406 (default-value (usb-modeswitch-configuration))
1407 (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
1408USB_ModeSwitch}, a mode switching tool for controlling USB devices with
1409multiple @dfn{modes}. When plugged in for the first time many USB
1410devices (primarily high-speed WAN modems) act like a flash storage containing
1411installers for Windows drivers. USB_ModeSwitch replays the sequence the
1412Windows drivers would send to switch their mode from storage to modem (or
1413whatever the thing is supposed to do).")))
1414
1415\f
2cccbc2a
TČ		 1416;;;
1417;;; WPA supplicant
1418;;;
1419
acce0a47
MB		 1420(define-record-type* <wpa-supplicant-configuration>
1421 wpa-supplicant-configuration make-wpa-supplicant-configuration
1422 wpa-supplicant-configuration?
892f1b72 1423 (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;file-like
acce0a47 1424 (default wpa-supplicant))
4d060767 1425 (requirement wpa-supplicant-configuration-requirement ;list of symbols
d48b17ad 1426 (default '(user-processes loopback syslogd)))
acce0a47
MB		 1427 (pid-file wpa-supplicant-configuration-pid-file ;string
1428 (default "/var/run/wpa_supplicant.pid"))
1429 (dbus? wpa-supplicant-configuration-dbus? ;Boolean
1430 (default #t))
1431 (interface wpa-supplicant-configuration-interface ;#f | string
1432 (default #f))
1433 (config-file wpa-supplicant-configuration-config-file ;#f | <file-like>
1434 (default #f))
1435 (extra-options wpa-supplicant-configuration-extra-options ;list of strings
1436 (default '())))
1437
1438(define wpa-supplicant-shepherd-service
1439 (match-lambda
4d060767
MB		 1440 (($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
1441 interface config-file extra-options)
acce0a47
MB		 1442 (list (shepherd-service
1443 (documentation "Run the WPA supplicant daemon")
1444 (provision '(wpa-supplicant))
d48b17ad
MB		 1445 (requirement (if dbus?
1446 (cons 'dbus-system requirement)
1447 requirement))
acce0a47
MB		 1448 (start #~(make-forkexec-constructor
1449 (list (string-append #$wpa-supplicant
1450 "/sbin/wpa_supplicant")
1451 (string-append "-P" #$pid-file)
1452 "-B" ;run in background
177bc62d 1453 "-s" ;log to syslogd
acce0a47
MB		 1454 #$@(if dbus?
1455 #~("-u")
1456 #~())
1457 #$@(if interface
3d472b5e 1458 #~((string-append "-i" #$interface))
acce0a47
MB		 1459 #~())
1460 #$@(if config-file
3d472b5e 1461 #~((string-append "-c" #$config-file))
acce0a47
MB		 1462 #~())
1463 #$@extra-options)
1464 #:pid-file #$pid-file))
1465 (stop #~(make-kill-destructor)))))))
2cccbc2a
TČ		 1466
1467(define wpa-supplicant-service-type
acce0a47
MB		 1468 (let ((config->package
1469 (match-lambda
1470 (($ <wpa-supplicant-configuration> wpa-supplicant)
1471 (list wpa-supplicant)))))
1472 (service-type (name 'wpa-supplicant)
1473 (extensions
1474 (list (service-extension shepherd-root-service-type
1475 wpa-supplicant-shepherd-service)
1476 (service-extension dbus-root-service-type config->package)
1477 (service-extension profile-service-type config->package)))
1478 (description "Run the WPA Supplicant daemon, a service that
1479implements authentication, key negotiation and more for wireless networks.")
1480 (default-value (wpa-supplicant-configuration)))))
2cccbc2a 1481
c32d02fe 1482\f
a03943ec
LC		 1483;;;
1484;;; Hostapd.
1485;;;
1486
1487(define-record-type* <hostapd-configuration>
1488 hostapd-configuration make-hostapd-configuration
1489 hostapd-configuration?
1490 (package hostapd-configuration-package
1491 (default hostapd))
1492 (interface hostapd-configuration-interface ;string
1493 (default "wlan0"))
1494 (ssid hostapd-configuration-ssid) ;string
1495 (broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean
1496 (default #t))
1497 (channel hostapd-configuration-channel ;integer
1498 (default 1))
1499 (driver hostapd-configuration-driver ;string
1500 (default "nl80211"))
1501 ;; See <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> for a list of
1502 ;; additional options we could add.
1503 (extra-settings hostapd-configuration-extra-settings ;string
1504 (default "")))
1505
1506(define (hostapd-configuration-file config)
1507 "Return the configuration file for CONFIG, a <hostapd-configuration>."
1508 (match-record config <hostapd-configuration>
1509 (interface ssid broadcast-ssid? channel driver extra-settings)
1510 (plain-file "hostapd.conf"
1511 (string-append "\
1512# Generated from your Guix configuration.
1513
1514interface=" interface "
1515ssid=" ssid "
1516ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") "
1517channel=" (number->string channel) "\n"
1518extra-settings "\n"))))
1519
1520(define* (hostapd-shepherd-services config #:key (requirement '()))
1521 "Return Shepherd services for hostapd."
1522 (list (shepherd-service
1523 (provision '(hostapd))
1524 (requirement `(user-processes ,@requirement))
1525 (documentation "Run the hostapd WiFi access point daemon.")
1526 (start #~(make-forkexec-constructor
62a8d487
BW		 1527 (list #$(file-append (hostapd-configuration-package config)
1528 "/sbin/hostapd")
a03943ec
LC		 1529 #$(hostapd-configuration-file config))
1530 #:log-file "/var/log/hostapd.log"))
1531 (stop #~(make-kill-destructor)))))
1532
29c93178 1533(define %hostapd-log-rotation
1534 (list (log-rotation
1535 (files '("/var/log/hostapd.log")))))
1536
a03943ec
LC		 1537(define hostapd-service-type
1538 (service-type
1539 (name 'hostapd)
1540 (extensions
1541 (list (service-extension shepherd-root-service-type
29c93178 1542 hostapd-shepherd-services)
1543 (service-extension rottlog-service-type
1544 (const %hostapd-log-rotation))))
a03943ec
LC		 1545 (description
1546 "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access
1547points and authentication servers.")))
1548
5e7076f2
LC		 1549(define (simulated-wifi-shepherd-services config)
1550 "Return Shepherd services to run hostapd with CONFIG, a
1551<hostapd-configuration>, as well as services to set up WiFi hardware
1552simulation."
1553 (append (hostapd-shepherd-services config
1554 #:requirement
1555 '(unblocked-wifi
ef20acae 1556 kernel-module-loader))
5e7076f2
LC		 1557 (list (shepherd-service
1558 (provision '(unblocked-wifi))
ef20acae 1559 (requirement '(file-systems kernel-module-loader))
5e7076f2
LC		 1560 (documentation
1561 "Unblock WiFi devices for use by mac80211_hwsim.")
1562 (start #~(lambda _
1563 (invoke #$(file-append util-linux "/sbin/rfkill")
1564 "unblock" "0")
1565 (invoke #$(file-append util-linux "/sbin/rfkill")
1566 "unblock" "1")))
5e7076f2
LC		 1567 (one-shot? #t)))))
1568
1569(define simulated-wifi-service-type
1570 (service-type
1571 (name 'simulated-wifi)
1572 (extensions
1573 (list (service-extension shepherd-root-service-type
ef20acae
BW		 1574 simulated-wifi-shepherd-services)
1575 (service-extension kernel-module-loader-service-type
1576 (const '("mac80211_hwsim")))))
5e7076f2
LC		 1577 (default-value (hostapd-configuration
1578 (interface "wlan1")
1579 (ssid "Test Network")))
1580 (description "Run hostapd to simulate WiFi connectivity.")))
1581
a03943ec 1582\f
c32d02fe
SB		 1583;;;
1584;;; Open vSwitch
1585;;;
1586
1587(define-record-type* <openvswitch-configuration>
1588 openvswitch-configuration make-openvswitch-configuration
1589 openvswitch-configuration?
1590 (package openvswitch-configuration-package
1591 (default openvswitch)))
1592
1593(define openvswitch-activation
1594 (match-lambda
1595 (($ <openvswitch-configuration> package)
1596 (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
1597 (with-imported-modules '((guix build utils))
1598 #~(begin
1599 (use-modules (guix build utils))
1600 (mkdir-p "/var/run/openvswitch")
1601 (mkdir-p "/var/lib/openvswitch")
1602 (let ((conf.db "/var/lib/openvswitch/conf.db"))
1603 (unless (file-exists? conf.db)
1604 (system* #$ovsdb-tool "create" conf.db)))))))))
1605
1606(define openvswitch-shepherd-service
1607 (match-lambda
1608 (($ <openvswitch-configuration> package)
1609 (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
1610 (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
1611 (list
1612 (shepherd-service
1613 (provision '(ovsdb))
1614 (documentation "Run the Open vSwitch database server.")
1615 (start #~(make-forkexec-constructor
1616 (list #$ovsdb-server "--pidfile"
1617 "--remote=punix:/var/run/openvswitch/db.sock")
1618 #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
1619 (stop #~(make-kill-destructor)))
1620 (shepherd-service
1621 (provision '(vswitchd))
1622 (requirement '(ovsdb))
1623 (documentation "Run the Open vSwitch daemon.")
1624 (start #~(make-forkexec-constructor
1625 (list #$ovs-vswitchd "--pidfile")
1626 #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
1627 (stop #~(make-kill-destructor))))))))
1628
1629(define openvswitch-service-type
1630 (service-type
1631 (name 'openvswitch)
1632 (extensions
1633 (list (service-extension activation-service-type
1634 openvswitch-activation)
1635 (service-extension profile-service-type
1636 (compose list openvswitch-configuration-package))
1637 (service-extension shepherd-root-service-type
3f0de257
LC		 1638 openvswitch-shepherd-service)))
1639 (description
1640 "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
1641switch designed to enable massive network automation through programmatic
e73ded3c
MB		 1642extension.")
1643 (default-value (openvswitch-configuration))))
c32d02fe 1644
9926b8f8
AI		 1645;;;
1646;;; iptables
1647;;;
1648
1649(define %iptables-accept-all-rules
1650 (plain-file "iptables-accept-all.rules"
1651 "*filter
1652:INPUT ACCEPT
1653:FORWARD ACCEPT
1654:OUTPUT ACCEPT
1655COMMIT
1656"))
1657
1658(define-record-type* <iptables-configuration>
1659 iptables-configuration make-iptables-configuration iptables-configuration?
1660 (iptables iptables-configuration-iptables
1661 (default iptables))
1662 (ipv4-rules iptables-configuration-ipv4-rules
1663 (default %iptables-accept-all-rules))
1664 (ipv6-rules iptables-configuration-ipv6-rules
1665 (default %iptables-accept-all-rules)))
1666
1667(define iptables-shepherd-service
1668 (match-lambda
1669 (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
1670 (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
1671 (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
1672 (shepherd-service
1673 (documentation "Packet filtering framework")
1674 (provision '(iptables))
1675 (start #~(lambda _
1676 (invoke #$iptables-restore #$ipv4-rules)
1677 (invoke #$ip6tables-restore #$ipv6-rules)))
1678 (stop #~(lambda _
1679 (invoke #$iptables-restore #$%iptables-accept-all-rules)
1680 (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
1681
1682(define iptables-service-type
1683 (service-type
1684 (name 'iptables)
1685 (description
1686 "Run @command{iptables-restore}, setting up the specified rules.")
1687 (extensions
1688 (list (service-extension shepherd-root-service-type
1689 (compose list iptables-shepherd-service))))))
1690
3c4f5ad7
SB		 1691;;;
1692;;; nftables
1693;;;
1694
1695(define %default-nftables-ruleset
1696 (plain-file "nftables.conf"
1697 "# A simple and safe firewall
1698table inet filter {
1699 chain input {
1700 type filter hook input priority 0; policy drop;
1701
1702 # early drop of invalid connections
1703 ct state invalid drop
1704
1705 # allow established/related connections
1706 ct state { established, related } accept
1707
1708 # allow from loopback
1709 iifname lo accept
1710
1711 # allow icmp
1712 ip protocol icmp accept
1713 ip6 nexthdr icmpv6 accept
1714
1715 # allow ssh
1716 tcp dport ssh accept
1717
1718 # reject everything else
1719 reject with icmpx type port-unreachable
1720 }
1721 chain forward {
1722 type filter hook forward priority 0; policy drop;
1723 }
1724 chain output {
1725 type filter hook output priority 0; policy accept;
1726 }
1727}
1728"))
1729
1730(define-record-type* <nftables-configuration>
1731 nftables-configuration
1732 make-nftables-configuration
1733 nftables-configuration?
1734 (package nftables-configuration-package
1735 (default nftables))
1736 (ruleset nftables-configuration-ruleset ; file-like object
1737 (default %default-nftables-ruleset)))
1738
1739(define nftables-shepherd-service
1740 (match-lambda
1741 (($ <nftables-configuration> package ruleset)
1742 (let ((nft (file-append package "/sbin/nft")))
1743 (shepherd-service
1744 (documentation "Packet filtering and classification")
1745 (provision '(nftables))
1746 (start #~(lambda _
1747 (invoke #$nft "--file" #$ruleset)))
1748 (stop #~(lambda _
1749 (invoke #$nft "flush" "ruleset"))))))))
1750
1751(define nftables-service-type
1752 (service-type
1753 (name 'nftables)
1754 (description
1755 "Run @command{nft}, setting up the specified ruleset.")
1756 (extensions
1757 (list (service-extension shepherd-root-service-type
1758 (compose list nftables-shepherd-service))
1759 (service-extension profile-service-type
1760 (compose list nftables-configuration-package))))
1761 (default-value (nftables-configuration))))
1762
a2161c86
AG		 1763\f
1764;;;
1765;;; PageKite
1766;;;
1767
1768(define-record-type* <pagekite-configuration>
1769 pagekite-configuration
1770 make-pagekite-configuration
1771 pagekite-configuration?
1772 (package pagekite-configuration-package
1773 (default pagekite))
1774 (kitename pagekite-configuration-kitename
1775 (default #f))
1776 (kitesecret pagekite-configuration-kitesecret
1777 (default #f))
1778 (frontend pagekite-configuration-frontend
1779 (default #f))
1780 (kites pagekite-configuration-kites
1781 (default '("http:@kitename:localhost:80:@kitesecret")))
1782 (extra-file pagekite-configuration-extra-file
1783 (default #f)))
1784
1785(define (pagekite-configuration-file config)
1786 (match-record config <pagekite-configuration>
1787 (package kitename kitesecret frontend kites extra-file)
1788 (mixed-text-file "pagekite.rc"
1789 (if extra-file
1790 (string-append "optfile = " extra-file "\n")
1791 "")
1792 (if kitename
1793 (string-append "kitename = " kitename "\n")
1794 "")
1795 (if kitesecret
1796 (string-append "kitesecret = " kitesecret "\n")
1797 "")
1798 (if frontend
1799 (string-append "frontend = " frontend "\n")
1800 "defaults\n")
1801 (string-join (map (lambda (kite)
1802 (string-append "service_on = " kite))
1803 kites)
1804 "\n"
1805 'suffix))))
1806
1807(define (pagekite-shepherd-service config)
1808 (match-record config <pagekite-configuration>
1809 (package kitename kitesecret frontend kites extra-file)
1810 (with-imported-modules (source-module-closure
1811 '((gnu build shepherd)
1812 (gnu system file-systems)))
1813 (shepherd-service
1814 (documentation "Run the PageKite service.")
1815 (provision '(pagekite))
1816 (requirement '(networking))
1817 (modules '((gnu build shepherd)
1818 (gnu system file-systems)))
1819 (start #~(make-forkexec-constructor/container
1820 (list #$(file-append package "/bin/pagekite")
1821 "--clean"
1822 "--nullui"
1823 "--nocrashreport"
1824 "--runas=pagekite:pagekite"
1825 (string-append "--optfile="
1826 #$(pagekite-configuration-file config)))
1827 #:log-file "/var/log/pagekite.log"
1828 #:mappings #$(if extra-file
1829 #~(list (file-system-mapping
1830 (source #$extra-file)
1831 (target source)))
1832 #~'())))
1833 ;; SIGTERM doesn't always work for some reason.
1834 (stop #~(make-kill-destructor SIGINT))))))
1835
29c93178 1836(define %pagekite-log-rotation
1837 (list (log-rotation
1838 (files '("/var/log/pagekite.log")))))
1839
a2161c86
AG		 1840(define %pagekite-accounts
1841 (list (user-group (name "pagekite") (system? #t))
1842 (user-account
1843 (name "pagekite")
1844 (group "pagekite")
1845 (system? #t)
1846 (comment "PageKite user")
1847 (home-directory "/var/empty")
1848 (shell (file-append shadow "/sbin/nologin")))))
1849
1850(define pagekite-service-type
1851 (service-type
1852 (name 'pagekite)
1853 (default-value (pagekite-configuration))
1854 (extensions
1855 (list (service-extension shepherd-root-service-type
1856 (compose list pagekite-shepherd-service))
1857 (service-extension account-service-type
29c93178 1858 (const %pagekite-accounts))
1859 (service-extension rottlog-service-type
1860 (const %pagekite-log-rotation))))
a2161c86
AG		 1861 (description
1862 "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
1863local servers publicly accessible on the web, even behind NATs and firewalls.")))
1864
fe1cd098 1865\f
1866;;;
1867;;; Yggdrasil
1868;;;
1869
1870(define-record-type* <yggdrasil-configuration>
1871 yggdrasil-configuration
1872 make-yggdrasil-configuration
1873 yggdrasil-configuration?
1874 (package yggdrasil-configuration-package
1875 (default yggdrasil))
1876 (json-config yggdrasil-configuration-json-config
1877 (default '()))
1878 (config-file yggdrasil-config-file
1879 (default "/etc/yggdrasil-private.conf"))
1880 (autoconf? yggdrasil-configuration-autoconf?
1881 (default #f))
1882 (log-level yggdrasil-configuration-log-level
1883 (default 'info))
1884 (log-to yggdrasil-configuration-log-to
1885 (default 'stdout)))
1886
1887(define (yggdrasil-configuration-file config)
1888 (define (scm->yggdrasil-json x)
1889 (define key-value?
1890 dotted-list?)
1891 (define (param->camel str)
1892 (string-concatenate
1893 (map
1894 string-capitalize
1895 (string-split str (cut eqv? <> #\-)))))
1896 (cond
1897 ((key-value? x)
1898 (let ((k (car x))
1899 (v (cdr x)))
1900 (cons
1901 (if (symbol? k)
1902 (param->camel (symbol->string k))
1903 k)
1904 v)))
1905 ((list? x) (map scm->yggdrasil-json x))
1906 ((vector? x) (vector-map scm->yggdrasil-json x))
1907 (else x)))
1908 (computed-file
1909 "yggdrasil.conf"
1910 #~(call-with-output-file #$output
1911 (lambda (port)
1912 ;; it's HJSON, so comments are a-okay
1913 (display "# Generated by yggdrasil-service\n" port)
1914 (display #$(scm->json-string
1915 (scm->yggdrasil-json
1916 (yggdrasil-configuration-json-config config)))
1917 port)))))
1918
1919(define (yggdrasil-shepherd-service config)
1920 "Return a <shepherd-service> for yggdrasil with CONFIG."
1921 (define yggdrasil-command
1922 #~(append
1923 (list (string-append
1924 #$(yggdrasil-configuration-package config)
1925 "/bin/yggdrasil")
1926 "-useconffile"
1927 #$(yggdrasil-configuration-file config))
1928 (if #$(yggdrasil-configuration-autoconf? config)
1929 '("-autoconf")
1930 '())
1931 (let ((extraconf #$(yggdrasil-config-file config)))
1932 (if extraconf
1933 (list "-extraconffile" extraconf)
1934 '()))
1935 (list "-loglevel"
1936 #$(symbol->string
1937 (yggdrasil-configuration-log-level config))
1938 "-logto"
1939 #$(symbol->string
1940 (yggdrasil-configuration-log-to config)))))
1941 (list (shepherd-service
1942 (documentation "Connect to the Yggdrasil mesh network")
1943 (provision '(yggdrasil))
1944 (requirement '(networking))
1945 (start #~(make-forkexec-constructor
1946 #$yggdrasil-command
1947 #:log-file "/var/log/yggdrasil.log"
1948 #:group "yggdrasil"))
1949 (stop #~(make-kill-destructor)))))
1950
29c93178 1951(define %yggdrasil-log-rotation
1952 (list (log-rotation
1953 (files '("/var/log/yggdrasil.log")))))
1954
fe1cd098 1955(define %yggdrasil-accounts
1956 (list (user-group (name "yggdrasil") (system? #t))))
1957
1958(define yggdrasil-service-type
1959 (service-type
1960 (name 'yggdrasil)
1961 (description
1962 "Connect to the Yggdrasil mesh network.
f95c037b 1963See @command{yggdrasil -genconf} for config options.")
fe1cd098 1964 (extensions
1965 (list (service-extension shepherd-root-service-type
1966 yggdrasil-shepherd-service)
1967 (service-extension account-service-type
1968 (const %yggdrasil-accounts))
1969 (service-extension profile-service-type
29c93178 1970 (compose list yggdrasil-configuration-package))
1971 (service-extension rottlog-service-type
1972 (const %yggdrasil-log-rotation))))))
fe1cd098 1973
4e511fcf 1974\f
2978832b
MD		 1975;;;
1976;;; IPFS
1977;;;
1978
1979(define-record-type* <ipfs-configuration>
1980 ipfs-configuration
1981 make-ipfs-configuration
1982 ipfs-configuration?
1983 (package ipfs-configuration-package
1984 (default go-ipfs))
1985 (gateway ipfs-configuration-gateway
1986 (default "/ip4/127.0.0.1/tcp/8082"))
1987 (api ipfs-configuration-api
1988 (default "/ip4/127.0.0.1/tcp/5001")))
1989
1990(define %ipfs-home "/var/lib/ipfs")
1991
1992(define %ipfs-accounts
1993 (list (user-account
1994 (name "ipfs")
1995 (group "ipfs")
1996 (system? #t)
1997 (comment "IPFS daemon user")
1998 (home-directory "/var/lib/ipfs")
1999 (shell (file-append shadow "/sbin/nologin")))
2000 (user-group
2001 (name "ipfs")
2002 (system? #t))))
2003
2004(define (ipfs-binary config)
f5ef68ba
LC		 2005 (define command
2006 (file-append (ipfs-configuration-package config) "/bin/ipfs"))
2007
2008 (least-authority-wrapper
2009 command
2010 #:name "ipfs"
2011 #:mappings (list %ipfs-home-mapping)
2012 #:namespaces (delq 'net %namespaces)))
2978832b
MD		 2013
2014(define %ipfs-home-mapping
f5ef68ba
LC		 2015 (file-system-mapping
2016 (source %ipfs-home)
2017 (target %ipfs-home)
2018 (writable? #t)))
2978832b
MD		 2019
2020(define %ipfs-environment
2021 #~(list #$(string-append "HOME=" %ipfs-home)))
2022
2023(define (ipfs-shepherd-service config)
2024 "Return a <shepherd-service> for IPFS with CONFIG."
2025 (define ipfs-daemon-command
2026 #~(list #$(ipfs-binary config) "daemon"))
f5ef68ba
LC		 2027
2028 (list (shepherd-service
2029 (provision '(ipfs))
2030 ;; While IPFS is most useful when the machine is connected
2031 ;; to the network, only loopback is required for starting
2032 ;; the service.
2033 (requirement '(loopback))
2034 (documentation "Connect to the IPFS network")
2035 (start #~(make-forkexec-constructor
2036 #$ipfs-daemon-command
2037 #:log-file "/var/log/ipfs.log"
2038 #:user "ipfs" #:group "ipfs"
2039 #:environment-variables #$%ipfs-environment))
2040 (stop #~(make-kill-destructor)))))
2978832b 2041
29c93178 2042(define %ipfs-log-rotation
2043 (list (log-rotation
2044 (files '("/var/log/ipfs.log")))))
2045
2978832b
MD		 2046(define (%ipfs-activation config)
2047 "Return an activation gexp for IPFS with CONFIG"
f5ef68ba
LC		 2048 (define (exec-command . args)
2049 ;; Exec the given ifps command with the right authority.
2050 #~(let ((pid (primitive-fork)))
2051 (if (zero? pid)
2052 (dynamic-wind
2053 (const #t)
2054 (lambda ()
2055 ;; Run ipfs init and ipfs config from a container,
2056 ;; in case the IPFS daemon was compromised at some point
2057 ;; and ~/.ipfs is now a symlink to somewhere outside
2058 ;; %ipfs-home.
2059 (let ((pw (getpwnam "ipfs")))
2060 (setgroups '#())
2061 (setgid (passwd:gid pw))
2062 (setuid (passwd:uid pw))
2063 (environ #$%ipfs-environment)
2064 (execl #$(ipfs-binary config) #$@args)))
2065 (lambda ()
2066 (primitive-exit 127)))
2067 (waitpid pid))))
2068
2978832b
MD		 2069 (define settings
2070 `(("Addresses.API" ,(ipfs-configuration-api config))
2071 ("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
f5ef68ba 2072
2978832b
MD		 2073 (define inner-gexp
2074 #~(begin
2075 (umask #o077)
2076 ;; Create $HOME/.ipfs structure
f5ef68ba 2077 #$(exec-command "ipfs" "init")
2978832b 2078 ;; Apply settings
f5ef68ba
LC		 2079 #$@(map (match-lambda
2080 ((setting value)
2081 (exec-command "ipfs" "config" setting value)))
2082 settings)))
2083
2978832b
MD		 2084 (define inner-script
2085 (program-file "ipfs-activation-inner" inner-gexp))
6b677f42 2086
2978832b
MD		 2087 ;; The activation may happen from the initrd, which uses
2088 ;; a statically-linked guile, while the guix container
2089 ;; procedures require a working dynamic-link.
f5ef68ba 2090 #~(system* #$inner-script))
2978832b
MD		 2091
2092(define ipfs-service-type
2093 (service-type
2094 (name 'ipfs)
2095 (extensions
2096 (list (service-extension account-service-type
2097 (const %ipfs-accounts))
2098 (service-extension activation-service-type
2099 %ipfs-activation)
2100 (service-extension shepherd-root-service-type
29c93178 2101 ipfs-shepherd-service)
2102 (service-extension rottlog-service-type
2103 (const %ipfs-log-rotation))))
2978832b
MD		 2104 (default-value (ipfs-configuration))
2105 (description
2106 "Run @command{ipfs daemon}, the reference implementation
4d0d6d86 2107of the IPFS peer-to-peer storage network.")))
2978832b
MD		 2108
2109\f
4e511fcf
OP		 2110;;;
2111;;; Keepalived
2112;;;
2113
2114(define-record-type* <keepalived-configuration>
2115 keepalived-configuration make-keepalived-configuration
2116 keepalived-configuration?
892f1b72 2117 (keepalived keepalived-configuration-keepalived ;file-like
4e511fcf
OP		 2118 (default keepalived))
2119 (config-file keepalived-configuration-config-file ;file-like
2120 (default #f)))
2121
2122(define keepalived-shepherd-service
2123 (match-lambda
2124 (($ <keepalived-configuration> keepalived config-file)
2125 (list
2126 (shepherd-service
2127 (provision '(keepalived))
2128 (documentation "Run keepalived.")
2129 (requirement '(loopback))
2130 (start #~(make-forkexec-constructor
2131 (list (string-append #$keepalived "/sbin/keepalived")
2132 "--dont-fork" "--log-console" "--log-detail"
2133 "--pid=/var/run/keepalived.pid"
2134 (string-append "--use-file=" #$config-file))
2135 #:pid-file "/var/run/keepalived.pid"
2136 #:log-file "/var/log/keepalived.log"))
2137 (respawn? #f)
2138 (stop #~(make-kill-destructor)))))))
2139
29c93178 2140(define %keepalived-log-rotation
2141 (list (log-rotation
2142 (files '("/var/log/keepalived.log")))))
2143
4e511fcf
OP		 2144(define keepalived-service-type
2145 (service-type (name 'keepalived)
2146 (extensions (list (service-extension shepherd-root-service-type
29c93178 2147 keepalived-shepherd-service)
2148 (service-extension rottlog-service-type
2149 (const %keepalived-log-rotation))))
4e511fcf
OP		 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/