projects/guix·blob ruby-team · refs

2941 lines · 116.4 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013-2025 Ludovic Courtès <[email protected]>
3;;; Copyright © 2015 Mark H Weaver <[email protected]>
4;;; Copyright © 2016, 2018, 2020 Efraim Flashner <[email protected]>
5;;; Copyright © 2016 John Darrington <[email protected]>
6;;; Copyright © 2017 Clément Lassieur <[email protected]>
7;;; Copyright © 2017 Thomas Danckaert <[email protected]>
8;;; Copyright © 2017, 2018 Marius Bakke <[email protected]>
9;;; Copyright © 2018 Tobias Geerinckx-Rice <[email protected]>
10;;; Copyright © 2018 Chris Marusich <[email protected]>
11;;; Copyright © 2018 Arun Isaac <[email protected]>
12;;; Copyright © 2019 Florian Pelz <[email protected]>
13;;; Copyright © 2019, 2021, 2024, 2025 Maxim Cournoyer <[email protected]>
14;;; Copyright © 2019 Sou Bunnbu <[email protected]>
15;;; Copyright © 2019 Alex Griffin <[email protected]>
16;;; Copyright © 2020 Brice Waegeneire <[email protected]>
17;;; Copyright © 2021 Oleg Pykhalov <[email protected]>
18;;; Copyright © 2021 Christine Lemmer-Webber <[email protected]>
19;;; Copyright © 2021 Maxime Devos <[email protected]>
20;;; Copyright © 2021 Guillaume Le Vaillant <[email protected]>
21;;; Copyright © 2022, 2023 Andrew Tropin <[email protected]>
22;;; Copyright © 2023 Declan Tsien <[email protected]>
23;;; Copyright © 2023 Bruno Victal <[email protected]>
24;;; Copyright © 2023 muradm <[email protected]>
25;;; Copyright © 2024 Nigko Yerden <[email protected]>
26;;; Copyright © 2025 45mg <[email protected]>
27;;; Copyright © 2025 Andreas Enge <[email protected]>
28;;;
29;;; This file is part of GNU Guix.
30;;;
31;;; GNU Guix is free software; you can redistribute it and/or modify it
32;;; under the terms of the GNU General Public License as published by
33;;; the Free Software Foundation; either version 3 of the License, or (at
34;;; your option) any later version.
35;;;
36;;; GNU Guix is distributed in the hope that it will be useful, but
37;;; WITHOUT ANY WARRANTY; without even the implied warranty of
38;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
39;;; GNU General Public License for more details.
40;;;
41;;; You should have received a copy of the GNU General Public License
42;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
43
44(define-module (gnu services networking)
45 #:use-module (gnu home services utils)
46 #:use-module (gnu services)
47 #:use-module (gnu services base)
48 #:use-module (gnu services configuration)
49 #:use-module (gnu services linux)
50 #:use-module (gnu services shepherd)
51 #:use-module (gnu services dbus)
52 #:use-module (gnu services admin)
53 #:use-module (gnu system shadow)
54 #:use-module (gnu system pam)
55 #:use-module ((gnu system file-systems) #:select (file-system-mapping))
56 #:use-module (gnu packages admin)
57 #:use-module (gnu packages base)
58 #:use-module (gnu packages bash)
59 #:use-module (gnu packages cluster)
60 #:use-module (gnu packages connman)
61 #:use-module (gnu packages dns)
62 #:use-module (gnu packages freedesktop)
63 #:use-module (gnu packages linux)
64 #:use-module (gnu packages tor)
65 #:use-module (gnu packages usb-modeswitch)
66 #:use-module (gnu packages messaging)
67 #:use-module (gnu packages networking)
68 #:use-module (gnu packages nss)
69 #:use-module (gnu packages ntp)
70 #:use-module (gnu packages gnome)
71 #:use-module (gnu packages ipfs)
72 #:use-module (gnu build linux-container)
73 #:autoload (guix least-authority) (least-authority-wrapper)
74 #:use-module (guix gexp)
75 #:use-module (guix records)
76 #:use-module (guix modules)
77 #:use-module (guix packages)
78 #:use-module (guix deprecation)
79 #:use-module (guix diagnostics)
80 #:autoload (guix ui) (display-hint)
81 #:use-module (guix i18n)
82 #:use-module (rnrs enums)
83 #:use-module (srfi srfi-1)
84 #:use-module (srfi srfi-9)
85 #:use-module (srfi srfi-26)
86 #:use-module (srfi srfi-43)
87 #:use-module ((ice-9 curried-definitions) #:select (define))
88 #:use-module (ice-9 format)
89 #:use-module (ice-9 match)
90 #:use-module (ice-9 string-fun)
91 #:use-module (json)
92 #:re-export (static-networking-service
93 static-networking-service-type)
94 #:export (%facebook-host-aliases ;deprecated
95 block-facebook-hosts-service-type
96
97 dhcpd-service-type
98 dhcpd-configuration
99 dhcpd-configuration?
100 dhcpd-configuration-package
101 dhcpd-configuration-config-file
102 dhcpd-configuration-version
103 dhcpd-configuration-run-directory
104 dhcpd-configuration-lease-file
105 dhcpd-configuration-pid-file
106 dhcpd-configuration-interfaces
107
108 dhcpcd-service-type
109 dhcpcd-configuration
110 dhcpcd-configuration?
111 dhcpcd-configuration-interfaces
112 dhcpcd-configuration-command-arguments
113 dhcpcd-configuration-host-name
114 dhcpcd-configuration-duid
115 dhcpcd-configuration-persistent?
116 dhcpcd-configuration-option
117 dhcpcd-configuration-require
118 dhcpcd-configuration-slaac
119 dhcpcd-configuration-no-option
120 dhcpcd-configuration-no-hook
121 dhcpcd-configuration-static
122 dhcpcd-configuration-vendor-class-id
123 dhcpcd-configuration-client-id
124 dhcpcd-configuration-extra-content
125 dhcpcd-configuration-shepherd-requirement
126
127 ntp-configuration
128 ntp-configuration?
129 ntp-configuration-ntp
130 ntp-configuration-servers
131 ntp-allow-large-adjustment?
132
133 %ntp-servers
134 ntp-server
135 ntp-server-type
136 ntp-server-address
137 ntp-server-options
138
139 ntp-service-type
140
141 %openntpd-servers
142 openntpd-configuration
143 openntpd-configuration?
144 openntpd-service-type
145
146 inetd-configuration
147 inetd-configuration?
148 inetd-configuration-program
149 inetd-configuration-entries
150 inetd-entry
151 inetd-entry?
152 inetd-entry-node
153 inetd-entry-name
154 inetd-entry-socket-type
155 inetd-entry-protocol
156 inetd-entry-wait?
157 inetd-entry-user
158 inetd-entry-program
159 inetd-entry-arguments
160 inetd-service-type
161
162 opendht-configuration
163 opendht-configuration-peer-discovery?
164 opendht-configuration-verbose?
165 opendht-configuration-bootstrap-host
166 opendht-configuration-port
167 opendht-configuration-proxy-server-port
168 opendht-configuration-proxy-server-port-tls
169 opendht-configuration->command-line-arguments
170
171 opendht-shepherd-service
172 opendht-service-type
173
174 tor-configuration
175 tor-configuration?
176 tor-configuration-tor
177 tor-configuration-config-file
178 tor-configuration-hidden-services
179 tor-configuration-socks-socket-type
180 tor-configuration-control-socket-path
181 tor-configuration-transport-plugins
182 tor-configuration-auto-start
183 tor-onion-service-configuration
184 tor-onion-service-configuration?
185 tor-onion-service-configuration-name
186 tor-onion-service-configuration-mapping
187 tor-transport-plugin
188 tor-transport-plugin?
189 tor-plugin-role
190 tor-plugin-protocol
191 tor-plugin-program
192 tor-hidden-service ; deprecated
193 tor-service-type
194
195 network-manager-configuration
196 network-manager-configuration?
197 network-manager-configuration-shepherd-requirement
198 network-manager-configuration-dns
199 network-manager-configuration-vpn-plugins
200 network-manager-service-type
201
202 connman-general-configuration
203 connman-general-configuration?
204 connman-configuration
205 connman-configuration?
206 connman-configuration-connman
207 connman-configuration-shepherd-requirement
208 connman-configuration-disable-vpn?
209 connman-configuration-iwd?
210 connman-service-type
211
212 modem-manager-configuration
213 modem-manager-configuration?
214 modem-manager-service-type
215
216 usb-modeswitch-configuration
217 usb-modeswitch-configuration?
218 usb-modeswitch-configuration-usb-modeswitch
219 usb-modeswitch-configuration-usb-modeswitch-data
220 usb-modeswitch-service-type
221
222 wpa-supplicant-configuration
223 wpa-supplicant-configuration?
224 wpa-supplicant-configuration-wpa-supplicant
225 wpa-supplicant-configuration-requirement
226 wpa-supplicant-configuration-shepherd-requirement
227 wpa-supplicant-configuration-shepherd-provision
228 wpa-supplicant-configuration-pid-file
229 wpa-supplicant-configuration-dbus?
230 wpa-supplicant-configuration-interface
231 wpa-supplicant-configuration-config-file
232 wpa-supplicant-configuration-extra-options
233 wpa-supplicant-service-type
234
235 iwd-configuration
236 iwd-configuration-config
237 iwd-configuration-ignored-interfaces
238 iwd-configuration-ignored-phys
239 iwd-configuration-interfaces
240 iwd-configuration-iwd
241 iwd-configuration-phys
242 iwd-configuration-shepherd-provision
243 iwd-configuration-shepherd-requirement
244 iwd-service-type
245 iwd-general-settings
246 iwd-network-settings
247 iwd-scan-settings
248 iwd-settings
249
250 hostapd-configuration
251 hostapd-configuration?
252 hostapd-configuration-package
253 hostapd-configuration-interface
254 hostapd-configuration-ssid
255 hostapd-configuration-broadcast-ssid?
256 hostapd-configuration-channel
257 hostapd-configuration-driver
258 hostapd-service-type
259
260 simulated-wifi-service-type
261
262 openvswitch-service-type
263 openvswitch-configuration
264
265 iptables-configuration
266 iptables-configuration?
267 iptables-configuration-iptables
268 iptables-configuration-ipv4-rules
269 iptables-configuration-ipv6-rules
270 iptables-service-type
271
272 nftables-service-type
273 nftables-configuration
274 nftables-configuration?
275 nftables-configuration-package
276 nftables-configuration-debug-levels
277 nftables-configuration-ruleset
278 %default-nftables-ruleset
279
280 pagekite-service-type
281 pagekite-configuration
282 pagekite-configuration?
283 pagekite-configuration-package
284 pagekite-configuration-kitename
285 pagekite-configuration-kitesecret
286 pagekite-configuration-frontend
287 pagekite-configuration-kites
288 pagekite-configuration-extra-file
289
290 yggdrasil-service-type
291 yggdrasil-configuration
292 yggdrasil-configuration?
293 yggdrasil-configuration-autoconf?
294 yggdrasil-configuration-config-file
295 yggdrasil-configuration-log-level
296 yggdrasil-configuration-log-to
297 yggdrasil-configuration-json-config
298 yggdrasil-configuration-package
299
300 ipfs-service-type
301 ipfs-configuration
302 ipfs-configuration?
303 ipfs-configuration-package
304 ipfs-configuration-gateway
305 ipfs-configuration-api
306
307 keepalived-configuration
308 keepalived-configuration?
309 keepalived-service-type))
310
311;;; Commentary:
312;;;
313;;; Networking services.
314;;;
315;;; Code:
316
317(define %unroutable-ipv4
318 ;; Unroutable address, as per <https://www.rfc-editor.org/rfc/rfc5737>.
319 "203.0.113.1")
320
321(define %unroutable-ipv6
322 ;; Unroutable address, as per <https://www.rfc-editor.org/rfc/rfc6666>.
323 "0100::")
324
325(define facebook-host-aliases
326 ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
327 ;; are to block it.
328 (let ((domains '("facebook.com" "www.facebook.com"
329 "login.facebook.com" "www.login.facebook.com"
330 "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
331 "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
332 "connect.facebook.net" "www.connect.facebook.net"
333 "apps.facebook.com")))
334 (append-map (lambda (name)
335 (map (lambda (addr)
336 (host addr name))
337 (list %unroutable-ipv4 %unroutable-ipv6)))
338 domains)))
339
340(define-deprecated %facebook-host-aliases
341 block-facebook-hosts-service-type
342 (string-join
343 (map (lambda (x)
344 (string-append (host-address x) "\t"
345 (host-canonical-name x) "\n"))
346 facebook-host-aliases)))
347
348(define block-facebook-hosts-service-type
349 (service-type
350 (name 'block-facebook-hosts)
351 (extensions
352 (list (service-extension hosts-service-type
353 (const facebook-host-aliases))))
354 (default-value #f)
355 (description "Add a list of known Facebook hosts to @file{/etc/hosts}")))
356
357(define-record-type* <dhcpd-configuration>
358 dhcpd-configuration make-dhcpd-configuration
359 dhcpd-configuration?
360 (package dhcpd-configuration-package ;file-like
361 (default isc-dhcp))
362 (config-file dhcpd-configuration-config-file ;file-like
363 (default #f))
364 (version dhcpd-configuration-version ;"4", "6", or "4o6"
365 (default "4"))
366 (run-directory dhcpd-configuration-run-directory
367 (default "/run/dhcpd"))
368 (lease-file dhcpd-configuration-lease-file
369 (default "/var/db/dhcpd.leases"))
370 (pid-file dhcpd-configuration-pid-file
371 (default "/run/dhcpd/dhcpd.pid"))
372 ;; list of strings, e.g. (list "enp0s25")
373 (interfaces dhcpd-configuration-interfaces
374 (default '())))
375
376(define (dhcpd-shepherd-service config)
377 (match-record config <dhcpd-configuration>
378 (package config-file version run-directory
379 lease-file pid-file interfaces)
380 (unless config-file
381 (error "Must supply a config-file"))
382 (list (shepherd-service
383 ;; Allow users to easily run multiple versions simultaneously.
384 (provision (list (string->symbol
385 (string-append "dhcpv" version "-daemon"))))
386 (documentation (string-append "Run the DHCPv" version " daemon"))
387 (requirement '(networking))
388 (start #~(make-forkexec-constructor
389 '(#$(file-append package "/sbin/dhcpd")
390 #$(string-append "-" version)
391 "-lf" #$lease-file
392 "-pf" #$pid-file
393 "-cf" #$config-file
394 #$@interfaces)
395 #:pid-file #$pid-file))
396 (stop #~(make-kill-destructor))))))
397
398(define (dhcpd-activation config)
399 (match-record config <dhcpd-configuration>
400 (package config-file version run-directory
401 lease-file pid-file interfaces)
402 (with-imported-modules '((guix build utils))
403 #~(begin
404 (unless (file-exists? #$run-directory)
405 (mkdir #$run-directory))
406 ;; According to the DHCP manual (man dhcpd.leases), the lease
407 ;; database must be present for dhcpd to start successfully.
408 (unless (file-exists? #$lease-file)
409 (with-output-to-file #$lease-file
410 (lambda _ (display ""))))
411 ;; Validate the config.
412 (invoke/quiet
413 #$(file-append package "/sbin/dhcpd")
414 #$(string-append "-" version)
415 "-t" "-cf" #$config-file)))))
416
417(define dhcpd-service-type
418 (service-type
419 (name 'dhcpd)
420 (extensions
421 (list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
422 (service-extension activation-service-type dhcpd-activation)))
423 (description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The
424daemon is responsible for allocating IP addresses to its client.")))
425
426
427;;
428;; DHCPCD.
429;;
430
431(define (serialize-field-name field-name)
432 (let ((str (symbol->string field-name)))
433 (string-replace-substring
434 (if (string-suffix? "?" str)
435 (string-drop-right str 1)
436 str)
437 "-" "")))
438
439(define (dhcpcd-serialize-string field-name value)
440 (if (equal? field-name 'extra-content)
441 #~(string-append #$value "\n")
442 #~(format #f "~a ~a~%" #$(serialize-field-name field-name) #$value)))
443
444(define (dhcpcd-serialize-boolean field-name value)
445 (if value
446 #~(format #f "~a~%" #$(serialize-field-name field-name))
447 ""))
448
449(define (dhcpcd-serialize-list-of-strings field-name value)
450 #~(string-append #$@(map (cut dhcpcd-serialize-string field-name <>) value)))
451
452;; Some fields (e.g. host-name) can be specified with an empty string argument.
453;; Therefore, we need a maybe type to differentiate disabled/empty-string.
454(define-maybe string (prefix dhcpcd-))
455
456(define-configuration dhcpcd-configuration
457 (interfaces
458 (list '())
459 "List of networking interfaces---e.g., @code{\"eth0\"}---to start a DHCP client
460for. If no interface is specified (i.e., the list is empty) then @command{dhcpcd}
461discovers available Ethernet interfaces, that can be configured, automatically."
462 empty-serializer)
463 (command-arguments
464 (list '("-q" "-q"))
465 "List of additional command-line options."
466 empty-serializer)
467
468 ;; The following defaults replicate the default dhcpcd configuration file.
469 ;;
470 ;; See https://github.com/NetworkConfiguration/dhcpcd/tree/v10.0.10#configuration
471 (host-name
472 (maybe-string "")
473 "Host name to send via DHCP, defaults to the current system host name.")
474 (duid
475 (maybe-string "")
476 "DHCPv4 clients require a unique client identifier, this option uses the DHCPv6
477Unique Identifier as a DHCPv4 client identifier as well. For more information, refer
478to @uref{https://www.rfc-editor.org/rfc/rfc4361, RFC 4361} and @code{dhcpcd.conf(5)}.")
479 (persistent?
480 (boolean #t)
481 "When true, automatically de-configure the interface when @command{dhcpcd} exits.")
482 (option
483 (list-of-strings
484 '("rapid_commit"
485 "domain_name_servers"
486 "domain_name"
487 "domain_search"
488 "host_name"
489 "classless_static_routes"
490 "interface_mtu"))
491 "List of options to request from the server.")
492 (require
493 (list-of-strings '("dhcp_server_identifier"))
494 "List of options to require in responses.")
495 (slaac
496 (maybe-string "private")
497 "Interface identifier used for SLAAC generated IPv6 addresses.")
498
499 ;; Common options not set in the default configuration file.
500 (no-option
501 (list-of-strings '())
502 "List of options to remove from the message before it's processed.")
503 (no-hook
504 (list-of-strings '())
505 "List of hook script which should not be invoked.")
506 (static
507 (list-of-strings '())
508 "DHCP client can request different options from a DHCP server, through
509@code{static} it is possible to configure static values for selected options. For
510example, @code{\"domain_name_servers=127.0.0.1\"}.")
511 (vendor-class-id
512 maybe-string
513 "Set the DHCP Vendor Class (e.g., @code{MSFT}). For more information, refer
514to @uref{https://www.rfc-editor.org/rfc/rfc2132#section-9.13,RFC 2132}.")
515 (client-id
516 maybe-string
517 "Use the interface hardware address or the given string as a client identifier,
518this is mutually exclusive with the @code{duid} option.")
519
520 ;; Escape hatch for the generated configuration file.
521 (extra-content
522 maybe-string
523 "Extra content to append to the configuration as-is.")
524
525 (shepherd-provision
526 (list-of-symbols '(networking))
527 "This is a list of symbols naming Shepherd services provided by this service."
528 empty-serializer)
529
530 (shepherd-requirement
531 (list-of-symbols '())
532 "This is a list of symbols naming Shepherd services that this service
533will depend on."
534 empty-serializer)
535
536 (prefix dhcpcd-))
537
538(define (dhcpcd-config-file config)
539 (mixed-text-file "dhcpcd.conf"
540 (serialize-configuration
541 config
542 dhcpcd-configuration-fields)))
543
544(define dhcpcd-account-service
545 (list (user-group (name "dhcpcd") (system? #t))
546 (user-account
547 (name "dhcpcd")
548 (group "dhcpcd")
549 (system? #t)
550 (comment "dhcpcd daemon user")
551 (home-directory "/var/empty")
552 (shell (file-append shadow "/sbin/nologin")))))
553
554(define (dhcpcd-shepherd-service config)
555 (match-record config <dhcpcd-configuration>
556 (command-arguments interfaces shepherd-provision shepherd-requirement)
557 (let ((config-file (dhcpcd-config-file config)))
558 (list (shepherd-service
559 (documentation "dhcpcd daemon.")
560 (provision shepherd-provision)
561 (requirement `(user-processes udev ,@shepherd-requirement))
562 (actions (list (shepherd-configuration-action config-file)))
563 (start
564 #~(make-forkexec-constructor
565 (list (string-append #$dhcpcd "/sbin/dhcpcd")
566 #$@command-arguments "-B" "-f" #$config-file #$@interfaces)))
567 (stop #~(make-kill-destructor)))))))
568
569(define dhcpcd-service-type
570 (service-type (name 'dhcpcd)
571 (description "Run the dhcpcd daemon.")
572 (extensions
573 (list (service-extension account-service-type
574 (const dhcpcd-account-service))
575 (service-extension shepherd-root-service-type
576 dhcpcd-shepherd-service)))
577 (compose concatenate)
578 (default-value (dhcpcd-configuration))))
579
580
581;;;
582;;; NTP.
583;;;
584
585(define ntp-server-types (make-enumeration
586 '(pool
587 server
588 peer
589 broadcast
590 manycastclient)))
591
592(define-record-type* <ntp-server>
593 ntp-server make-ntp-server
594 ntp-server?
595 ;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration.
596 (type ntp-server-type
597 (default 'server))
598 (address ntp-server-address) ; a string
599 ;; The list of options can contain single option names or tuples in the form
600 ;; '(name value).
601 (options ntp-server-options
602 (default '())))
603
604(define (ntp-server->string ntp-server)
605 ;; Serialize the NTP server object as a string, ready to use in the NTP
606 ;; configuration file.
607 (define (flatten lst)
608 (reverse
609 (let loop ((x lst)
610 (res '()))
611 (if (list? x)
612 (fold loop res x)
613 (cons (format #f "~a" x) res)))))
614
615 (match-record ntp-server <ntp-server>
616 (type address options)
617 ;; XXX: It'd be neater if fields were validated at the syntax level (for
618 ;; static ones at least). Perhaps the Guix record type could support a
619 ;; predicate property on a field?
620 (unless (enum-set-member? type ntp-server-types)
621 (error "Invalid NTP server type" type))
622 (string-join (cons* (symbol->string type)
623 address
624 (flatten options)))))
625
626(define %ntp-servers
627 ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
628 ;; Within Guix, Leo Famulari <[email protected]> is the administrative contact
629 ;; for this NTP pool "zone".
630 ;; The full list of available URLs are 0.guix.pool.ntp.org,
631 ;; 1.guix.pool.ntp.org, 2.guix.pool.ntp.org, and 3.guix.pool.ntp.org. We
632 ;; use 2.guix.pool.ntp.org as default as it supports IPv6, contrary to the
633 ;; others.
634 (list
635 (ntp-server
636 (type 'pool)
637 (address "2.guix.pool.ntp.org")
638 (options '("iburst"))))) ;as recommended in the ntpd manual
639
640(define-record-type* <ntp-configuration>
641 ntp-configuration make-ntp-configuration
642 ntp-configuration?
643 (ntp ntp-configuration-ntp
644 (default ntp))
645 (servers ntp-configuration-servers ;list of <ntp-server> objects
646 (default %ntp-servers))
647 (allow-large-adjustment? ntp-allow-large-adjustment?
648 (default #t))) ;as recommended in the ntpd manual
649
650(define (ntp-shepherd-service config)
651 (match-record config <ntp-configuration>
652 (ntp servers allow-large-adjustment?)
653 ;; TODO: Add authentication support.
654 (define config
655 (string-append "driftfile /var/run/ntpd/ntp.drift\n"
656 (string-join (map ntp-server->string servers) "\n")
657 "
658# Disable status queries as a workaround for CVE-2013-5211:
659# <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
660restrict default kod nomodify notrap nopeer noquery limited
661restrict -6 default kod nomodify notrap nopeer noquery limited
662
663# Yet, allow use of the local 'ntpq'.
664restrict 127.0.0.1
665restrict -6 ::1
666
667# This is required to use servers from a pool directive when using the 'nopeer'
668# option by default, as documented in the 'ntp.conf' manual.
669restrict source notrap nomodify noquery\n"))
670
671 (define ntpd.conf
672 (plain-file "ntpd.conf" config))
673
674 (list (shepherd-service
675 (provision '(ntpd))
676 (documentation "Run the Network Time Protocol (NTP) daemon.")
677 (requirement '(user-processes networking))
678 (actions (list (shepherd-configuration-action ntpd.conf)))
679 (start #~(make-forkexec-constructor
680 (list (string-append #$ntp "/bin/ntpd") "-n"
681 "-c" #$ntpd.conf "-u" "ntpd"
682 #$@(if allow-large-adjustment?
683 '("-g")
684 '()))
685 #:log-file "/var/log/ntpd.log"))
686 (stop #~(make-kill-destructor))))))
687
688(define %ntp-accounts
689 (list (user-account
690 (name "ntpd")
691 (group "nogroup")
692 (system? #t)
693 (comment "NTP daemon user")
694 (home-directory "/var/empty")
695 (shell (file-append shadow "/sbin/nologin")))))
696
697
698(define (ntp-service-activation config)
699 "Return the activation gexp for CONFIG."
700 (with-imported-modules '((guix build utils))
701 #~(begin
702 (use-modules (guix build utils))
703 (define %user
704 (getpw "ntpd"))
705
706 (let ((directory "/var/run/ntpd"))
707 (mkdir-p directory)
708 (chown directory (passwd:uid %user) (passwd:gid %user))))))
709
710(define ntp-service-type
711 (service-type (name 'ntp)
712 (extensions
713 (list (service-extension shepherd-root-service-type
714 ntp-shepherd-service)
715 (service-extension account-service-type
716 (const %ntp-accounts))
717 (service-extension activation-service-type
718 ntp-service-activation)))
719 (description
720 "Run the @command{ntpd}, the Network Time Protocol (NTP)
721daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon
722will keep the system clock synchronized with that of the given servers.")
723 (default-value (ntp-configuration))))
724
725
726;;;
727;;; OpenNTPD.
728;;;
729
730(define %openntpd-servers
731 (map ntp-server-address %ntp-servers))
732
733(define-record-type* <openntpd-configuration>
734 openntpd-configuration make-openntpd-configuration
735 openntpd-configuration?
736 (openntpd openntpd-configuration-openntpd
737 (default openntpd))
738 (listen-on openntpd-listen-on
739 (default '("127.0.0.1"
740 "::1")))
741 (query-from openntpd-query-from
742 (default '()))
743 (sensor openntpd-sensor
744 (default '()))
745 (server openntpd-server
746 (default '()))
747 (servers openntpd-servers
748 (default %openntpd-servers))
749 (constraint-from openntpd-constraint-from
750 (default '()))
751 (constraints-from openntpd-constraints-from
752 (default '())))
753
754(define (openntpd-configuration->string config)
755
756 (define (quote-field? name)
757 (member name '("constraints from")))
758
759 (match-record config <openntpd-configuration>
760 (listen-on query-from sensor server servers constraint-from
761 constraints-from)
762 (string-append
763 (string-join
764 (concatenate
765 (filter-map (lambda (field values)
766 (match values
767 (() #f) ;discard entry with filter-map
768 ((val ...) ;validate value type
769 (map (lambda (value)
770 (if (quote-field? field)
771 (format #f "~a \"~a\"" field value)
772 (format #f "~a ~a" field value)))
773 values))))
774 ;; The entry names.
775 '("listen on" "query from" "sensor" "server" "servers"
776 "constraint from" "constraints from")
777 ;; The corresponding entry values.
778 (list listen-on query-from sensor server servers
779 constraint-from constraints-from)))
780 "\n")
781 "\n"))) ;add a trailing newline
782
783(define (openntpd-shepherd-service config)
784 (let ((openntpd (openntpd-configuration-openntpd config)))
785
786 (define ntpd.conf
787 (plain-file "ntpd.conf" (openntpd-configuration->string config)))
788
789 (list (shepherd-service
790 (provision '(ntpd))
791 (documentation "Run the Network Time Protocol (NTP) daemon.")
792 (requirement '(user-processes networking))
793 (start #~(make-forkexec-constructor
794 (list (string-append #$openntpd "/sbin/ntpd")
795 "-f" #$ntpd.conf
796 "-d") ;; don't daemonize
797 ;; When ntpd is daemonized it repeatedly tries to respawn
798 ;; while running, leading shepherd to disable it. To
799 ;; prevent spamming stderr, redirect output to logfile.
800 #:log-file "/var/log/ntpd.log"))
801 (stop #~(make-kill-destructor))
802 (actions (list (shepherd-configuration-action ntpd.conf)))))))
803
804(define (openntpd-service-activation config)
805 "Return the activation gexp for CONFIG."
806 (with-imported-modules '((guix build utils))
807 #~(begin
808 (use-modules (guix build utils))
809
810 (mkdir-p "/var/db")
811 (mkdir-p "/var/run")
812 (unless (file-exists? "/var/db/ntpd.drift")
813 (with-output-to-file "/var/db/ntpd.drift"
814 (lambda _
815 (format #t "0.0")))))))
816
817(define openntpd-service-type
818 (service-type (name 'openntpd)
819 (extensions
820 (list (service-extension shepherd-root-service-type
821 openntpd-shepherd-service)
822 (service-extension account-service-type
823 (const %ntp-accounts))
824 (service-extension profile-service-type
825 (compose list openntpd-configuration-openntpd))
826 (service-extension activation-service-type
827 openntpd-service-activation)))
828 (default-value (openntpd-configuration))
829 (description
830 "Run the @command{ntpd}, the Network Time Protocol (NTP)
831daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}. The
832daemon will keep the system clock synchronized with that of the given servers.")))
833
834
835;;;
836;;; Inetd.
837;;;
838
839(define-record-type* <inetd-configuration> inetd-configuration
840 make-inetd-configuration
841 inetd-configuration?
842 (program inetd-configuration-program ;file-like
843 (default (file-append inetutils "/libexec/inetd")))
844 (entries inetd-configuration-entries ;list of <inetd-entry>
845 (default '())))
846
847(define-record-type* <inetd-entry> inetd-entry make-inetd-entry
848 inetd-entry?
849 (node inetd-entry-node ;string or #f
850 (default #f))
851 (name inetd-entry-name) ;string, from /etc/services
852
853 (socket-type inetd-entry-socket-type) ;stream | dgram | raw |
854 ;rdm | seqpacket
855 (protocol inetd-entry-protocol) ;string, from /etc/protocols
856
857 (wait? inetd-entry-wait? ;Boolean
858 (default #t))
859 (user inetd-entry-user) ;string
860
861 (program inetd-entry-program ;string or file-like object
862 (default "internal"))
863 (arguments inetd-entry-arguments ;list of strings or file-like objects
864 (default '())))
865
866(define (inetd-config-file entries)
867 (apply mixed-text-file "inetd.conf"
868 (map
869 (lambda (entry)
870 (let* ((node (inetd-entry-node entry))
871 (name (inetd-entry-name entry))
872 (socket
873 (if node (string-append node ":" name) name))
874 (type
875 (match (inetd-entry-socket-type entry)
876 ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
877 (symbol->string (inetd-entry-socket-type entry)))))
878 (protocol (inetd-entry-protocol entry))
879 (wait (if (inetd-entry-wait? entry) "wait" "nowait"))
880 (user (inetd-entry-user entry))
881 (program (inetd-entry-program entry))
882 (args (inetd-entry-arguments entry)))
883 #~(string-append
884 (string-join
885 (list #$@(list socket type protocol wait user program) #$@args)
886 " ") "\n")))
887 entries)))
888
889(define (inetd-shepherd-service config)
890 (let ((entries (inetd-configuration-entries config)))
891 (if (null? entries)
892 '() ;do nothing
893 (let ((program (inetd-configuration-program config)))
894 (list (shepherd-service
895 (documentation "Run inetd.")
896 (provision '(inetd))
897 (requirement '(user-processes networking syslogd))
898 (start #~(make-forkexec-constructor
899 (list #$program #$(inetd-config-file entries))
900 #:pid-file "/var/run/inetd.pid"))
901 (stop #~(make-kill-destructor))))))))
902
903(define-public inetd-service-type
904 (service-type
905 (name 'inetd)
906 (extensions
907 (list (service-extension shepherd-root-service-type
908 inetd-shepherd-service)))
909
910 ;; The service can be extended with additional lists of entries.
911 (compose concatenate)
912 (extend (lambda (config entries)
913 (inetd-configuration
914 (inherit config)
915 (entries (append (inetd-configuration-entries config)
916 entries)))))
917 (description
918 "Start @command{inetd}, the @dfn{Internet superserver}. It is responsible
919for listening on Internet sockets and spawning the corresponding services on
920demand.")))
921
922
923;;;
924;;; OpenDHT, the distributed hash table network used by Jami
925;;;
926
927(define-maybe/no-serialization number)
928(define-maybe/no-serialization string)
929
930;;; To generate the documentation of the following configuration record, you
931;;; can evaluate: (configuration->documentation 'opendht-configuration)
932(define-configuration/no-serialization opendht-configuration
933 (opendht
934 (file-like opendht)
935 "The @code{opendht} package to use.")
936 (peer-discovery?
937 (boolean #false)
938 "Whether to enable the multicast local peer discovery mechanism.")
939 (enable-logging?
940 (boolean #false)
941 "Whether to enable logging messages to syslog. It is disabled by default
942as it is rather verbose.")
943 (debug?
944 (boolean #false)
945 "Whether to enable debug-level logging messages. This has no effect if
946logging is disabled.")
947 (bootstrap-host
948 (maybe-string "bootstrap.jami.net:4222")
949 "The node host name that is used to make the first connection to the
950network. A specific port value can be provided by appending the @code{:PORT}
951suffix. By default, it uses the Jami bootstrap nodes, but any host can be
952specified here. It's also possible to disable bootstrapping by explicitly
953setting this field to @code{%unset-value}.")
954 (port
955 (maybe-number 4222)
956 "The UDP port to bind to. When left unspecified, an available port is
957automatically selected.")
958 (proxy-server-port
959 maybe-number
960 "Spawn a proxy server listening on the specified port.")
961 (proxy-server-port-tls
962 maybe-number
963 "Spawn a proxy server listening to TLS connections on the specified
964port."))
965
966(define %opendht-accounts
967 ;; User account and groups for Tor.
968 (list (user-group (name "opendht") (system? #t))
969 (user-account
970 (name "opendht")
971 (group "opendht")
972 (system? #t)
973 (comment "OpenDHT daemon user")
974 (home-directory "/var/empty")
975 (shell (file-append shadow "/sbin/nologin")))))
976
977(define (opendht-configuration->command-line-arguments config)
978 "Derive the command line arguments used to launch the OpenDHT daemon from
979CONFIG, an <opendht-configuration> object."
980 (match-record config <opendht-configuration>
981 (opendht bootstrap-host enable-logging? port debug? peer-discovery?
982 proxy-server-port proxy-server-port-tls)
983 (let ((dhtnode (least-authority-wrapper
984 ;; XXX: Work around lack of support for multiple outputs
985 ;; in 'file-append'.
986 (computed-file "dhtnode"
987 #~(symlink
988 (string-append #$opendht:tools
989 "/bin/dhtnode")
990 #$output))
991 #:name "dhtnode"
992 #:mappings (list (file-system-mapping
993 (source "/dev/log") ;for syslog
994 (target source)))
995 #:namespaces (delq 'net %namespaces))))
996 `(,dhtnode
997 "--service" ;non-forking mode
998 ,@(if (string? bootstrap-host)
999 (list "--bootstrap" bootstrap-host))
1000 ,@(if enable-logging?
1001 (list "--syslog")
1002 '())
1003 ,@(if (number? port)
1004 (list "--port" (number->string port))
1005 '())
1006 ,@(if debug?
1007 (list "--verbose")
1008 '())
1009 ,@(if peer-discovery?
1010 (list "--peer-discovery")
1011 '())
1012 ,@(if (number? proxy-server-port)
1013 (list "--proxyserver" (number->string proxy-server-port))
1014 '())
1015 ,@(if (number? proxy-server-port-tls)
1016 (list "--proxyserverssl" (number->string proxy-server-port-tls))
1017 '())))))
1018
1019(define (opendht-shepherd-service config)
1020 "Return a <shepherd-service> running OpenDHT."
1021 (shepherd-service
1022 (documentation "Run an OpenDHT node.")
1023 (provision '(opendht dhtnode dhtproxy))
1024 (requirement '(user-processes networking syslogd))
1025 (start #~(make-forkexec-constructor
1026 (list #$@(opendht-configuration->command-line-arguments config))
1027 #:user "opendht"
1028 #:group "opendht"))
1029 (stop #~(make-kill-destructor))))
1030
1031(define opendht-service-type
1032 (service-type
1033 (name 'opendht)
1034 (default-value (opendht-configuration))
1035 (extensions
1036 (list (service-extension shepherd-root-service-type
1037 (compose list opendht-shepherd-service))
1038 (service-extension account-service-type
1039 (const %opendht-accounts))))
1040 (description "Run the OpenDHT @command{dhtnode} command that allows
1041participating in the distributed hash table based OpenDHT network. The
1042service can be configured to act as a proxy to the distributed network, which
1043can be useful for portable devices where minimizing energy consumption is
1044paramount. OpenDHT was originally based on Kademlia and adapted for
1045applications in communication. It is used by Jami, for example.")))
1046
1047
1048;;;
1049;;; Tor.
1050;;;
1051
1052(define-record-type* <tor-configuration>
1053 tor-configuration make-tor-configuration
1054 tor-configuration?
1055 (tor tor-configuration-tor
1056 (default tor))
1057 (config-file tor-configuration-config-file
1058 (default (plain-file "empty" "")))
1059 (hidden-services tor-configuration-hidden-services
1060 (default '()))
1061 (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
1062 (default 'tcp))
1063 (control-socket? tor-configuration-control-socket-path
1064 (default #f))
1065 (transport-plugins tor-configuration-transport-plugins
1066 (default '()))
1067 (auto-start? tor-configuration-auto-start
1068 (default #t)))
1069
1070(define %tor-accounts
1071 ;; User account and groups for Tor.
1072 (list (user-group (name "tor") (system? #t))
1073 (user-account
1074 (name "tor")
1075 (group "tor")
1076 (system? #t)
1077 (comment "Tor daemon user")
1078 (home-directory "/var/empty")
1079 (shell (file-append shadow "/sbin/nologin")))))
1080
1081(define-configuration/no-serialization tor-onion-service-configuration
1082 (name
1083 string
1084 "Name for this Onion Service. This creates a
1085@file{/var/lib/tor/hidden-services/@var{name}} directory, where the
1086@file{hostname} file contains the @indicateurl{.onion} host name for this
1087Onion Service.")
1088
1089 (mapping
1090 alist
1091 "Association list of port to address mappings. The following example:
1092@lisp
1093'((22 \"127.0.0.1:22\")
1094 (80 \"127.0.0.1:8080\"))
1095@end lisp
1096maps ports 22 and 80 of the Onion Service to the local ports 22 and 8080."))
1097
1098(define-record-type* <tor-transport-plugin>
1099 tor-transport-plugin make-tor-transport-plugin
1100 tor-transport-plugin?
1101 (role tor-plugin-role
1102 (default 'client)
1103 (sanitize (lambda (value)
1104 (if (memq value '(client server))
1105 value
1106 (configuration-field-error #f 'role value)))))
1107 (protocol tor-plugin-protocol
1108 (default "obfs4"))
1109 (program tor-plugin-program))
1110
1111(define (tor-configuration->torrc config)
1112 "Return a 'torrc' file for CONFIG."
1113 (match-record config <tor-configuration>
1114 (tor config-file hidden-services socks-socket-type control-socket?
1115 transport-plugins)
1116 (computed-file
1117 "torrc"
1118 (with-imported-modules '((guix build utils))
1119 #~(begin
1120 (use-modules (guix build utils)
1121 (ice-9 match))
1122
1123 (call-with-output-file #$output
1124 (lambda (port)
1125 (display "\
1126### These lines were generated from your system configuration:
1127DataDirectory /var/lib/tor
1128Log notice stderr\n" port)
1129 (when (eq? 'unix '#$socks-socket-type)
1130 (display "\
1131SocksPort unix:/var/run/tor/socks-sock
1132UnixSocksGroupWritable 1\n" port))
1133 (when #$control-socket?
1134 (display "\
1135ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck
1136ControlSocketsGroupWritable 1\n"
1137 port))
1138
1139 (for-each (match-lambda
1140 ((service (ports hosts) ...)
1141 (format port "\
1142HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
1143 service)
1144 (for-each (lambda (tcp-port host)
1145 (format port "\
1146HiddenServicePort ~a ~a~%"
1147 tcp-port host))
1148 ports hosts)))
1149 '#$(map (match-lambda
1150 (($ <tor-onion-service-configuration> name mapping)
1151 (cons name mapping)))
1152 hidden-services))
1153
1154 (for-each (match-lambda
1155 ((role-string protocol program)
1156 (format port "\
1157~aTransportPlugin ~a exec ~a~%"
1158 role-string protocol program)))
1159 '#$(map (match-lambda
1160 (($ <tor-transport-plugin> role protocol program)
1161 (list (if (eq? role 'client)
1162 "Client"
1163 "Server")
1164 protocol
1165 program)))
1166 transport-plugins))
1167
1168 (display "\
1169### End of automatically generated lines.\n\n" port)
1170
1171 ;; Append the user's config file.
1172 (call-with-input-file #$config-file
1173 (lambda (input)
1174 (dump-port input port)))
1175 #t)))))))
1176
1177(define (tor-shepherd-service config)
1178 "Return a <shepherd-service> running Tor."
1179 (let* ((torrc (tor-configuration->torrc config))
1180 (transport-plugins (tor-configuration-transport-plugins config))
1181 (auto-start? (tor-configuration-auto-start config))
1182 (tor (least-authority-wrapper
1183 (file-append (tor-configuration-tor config) "/bin/tor")
1184 #:name "tor"
1185 #:mappings (append
1186 (list (file-system-mapping
1187 (source "/var/lib/tor")
1188 (target source)
1189 (writable? #t))
1190 (file-system-mapping
1191 (source "/var/run/tor")
1192 (target source)
1193 (writable? #t))
1194 (file-system-mapping
1195 (source torrc)
1196 (target source))
1197
1198 ;; Transport plugins like the lyrebird
1199 ;; webtunnel need X.509 certificates.
1200 (file-system-mapping
1201 (source (file-append nss-certs "/etc/ssl/certs"))
1202 (target "/etc/ssl/certs")))
1203 (map (lambda (plugin)
1204 (file-system-mapping
1205 (source (tor-plugin-program plugin))
1206 (target source)))
1207 transport-plugins))
1208 #:namespaces (delq 'net %namespaces))))
1209 (list (shepherd-service
1210 (provision '(tor))
1211
1212 ;; Tor needs at least one network interface to be up, hence the
1213 ;; dependency on 'loopback'.
1214 (requirement '(user-processes loopback syslogd))
1215
1216 ;; XXX: #:pid-file won't work because the wrapped 'tor'
1217 ;; program would print its PID within the user namespace
1218 ;; instead of its actual PID outside. There's no inetd or
1219 ;; systemd socket activation support either (there's
1220 ;; 'sd_notify' though), so we're stuck with that.
1221 (start #~(make-forkexec-constructor
1222 (list #$tor "-f" #$torrc)
1223 #:user "tor" #:group "tor"))
1224 (auto-start? auto-start?)
1225 (stop #~(make-kill-destructor))
1226 (actions (list (shepherd-configuration-action torrc)))
1227 (documentation "Run the Tor anonymous network overlay.")))))
1228
1229(define (tor-activation config)
1230 "Set up directories for Tor and its hidden services, if any."
1231 #~(begin
1232 (use-modules (guix build utils))
1233
1234 (define %user
1235 (getpw "tor"))
1236
1237 (define (initialize service)
1238 (let ((directory (string-append "/var/lib/tor/hidden-services/"
1239 service)))
1240 (mkdir-p directory)
1241 (chown directory (passwd:uid %user) (passwd:gid %user))
1242
1243 ;; The daemon bails out if we give wider permissions.
1244 (chmod directory #o700)))
1245
1246 ;; Allow Tor to write its PID file.
1247 (mkdir-p "/var/run/tor")
1248 (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
1249 ;; Set the group permissions to rw so that if the system administrator
1250 ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
1251 ;; of the "tor" group will be able to use the SOCKS socket.
1252 (chmod "/var/run/tor" #o750)
1253
1254 ;; Allow Tor to access the hidden services' directories.
1255 (mkdir-p "/var/lib/tor")
1256 (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
1257 (chmod "/var/lib/tor" #o700)
1258
1259 ;; Make sure /var/lib is accessible to the 'tor' user.
1260 (chmod "/var/lib" #o755)
1261
1262 (for-each initialize
1263 '#$(map tor-onion-service-configuration-name
1264 (tor-configuration-hidden-services config)))))
1265
1266(define tor-service-type
1267 (service-type (name 'tor)
1268 (extensions
1269 (list (service-extension shepherd-root-service-type
1270 tor-shepherd-service)
1271 (service-extension account-service-type
1272 (const %tor-accounts))
1273 (service-extension activation-service-type
1274 tor-activation)))
1275
1276 ;; This can be extended with Tor Onion Services.
1277 (compose concatenate)
1278 (extend (lambda (config services)
1279 (tor-configuration
1280 (inherit config)
1281 (hidden-services
1282 (append (tor-configuration-hidden-services config)
1283 services)))))
1284 (default-value (tor-configuration))
1285 (description
1286 "Run the @uref{https://torproject.org, Tor} anonymous
1287networking daemon.")))
1288
1289(define-deprecated (tor-hidden-service name mapping)
1290 #f
1291 "Define a new Tor @dfn{hidden service} called @var{name} and implementing
1292@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
1293
1294@example
1295 '((22 \"127.0.0.1:22\")
1296 (80 \"127.0.0.1:8080\"))
1297@end example
1298
1299In this example, port 22 of the hidden service is mapped to local port 22, and
1300port 80 is mapped to local port 8080.
1301
1302This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
1303the @file{hostname} file contains the @code{.onion} host name for the hidden
1304service.
1305
1306See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
1307project's documentation} for more information."
1308 (simple-service 'tor-hidden-service
1309 tor-service-type
1310 (list (tor-onion-service-configuration
1311 (name name)
1312 (mapping mapping)))))
1313
1314
1315;;;
1316;;; ModemManager
1317;;;
1318
1319(define-record-type* <modem-manager-configuration>
1320 modem-manager-configuration make-modem-manager-configuration
1321 modem-manager-configuration?
1322 (modem-manager modem-manager-configuration-modem-manager
1323 (default modem-manager)))
1324
1325
1326;;;
1327;;; NetworkManager
1328;;;
1329
1330;; TODO: deprecated field, remove later.
1331(define-with-syntax-properties (warn-iwd?-field-deprecation
1332 (value properties))
1333 (when value
1334 (warning (source-properties->location properties)
1335 (G_ "the 'iwd?' field is deprecated, please use \
1336'shepherd-requirement' field instead~%")))
1337 value)
1338
1339(define-record-type* <network-manager-configuration>
1340 network-manager-configuration make-network-manager-configuration
1341 network-manager-configuration?
1342 (network-manager network-manager-configuration-network-manager
1343 (default network-manager))
1344 (shepherd-requirement network-manager-configuration-shepherd-requirement
1345 (default '(wireless-daemon)))
1346 (dns network-manager-configuration-dns
1347 (default "default"))
1348 (vpn-plugins network-manager-configuration-vpn-plugins ;list of file-like
1349 (default '()))
1350 (iwd? network-manager-configuration-iwd? ; TODO: deprecated field, remove.
1351 (default #f)
1352 (sanitize warn-iwd?-field-deprecation))
1353 (extra-configuration-files
1354 network-manager-configuration-extra-configuration-files
1355 (default '())) ;'((file-name-string file-like-object) ...)
1356 (dnsmasq-configuration-files
1357 network-manager-configuration-dnsmasq-configuration-files
1358 (default '())))
1359
1360(define (network-manager-activation config)
1361 ;; Activation gexp for NetworkManager
1362 (match-record config <network-manager-configuration>
1363 (network-manager dns vpn-plugins extra-configuration-files dnsmasq-configuration-files)
1364 #~(begin
1365 (use-modules (guix build utils))
1366 (mkdir-p "/etc/NetworkManager/system-connections")
1367 #$@(if (equal? dns "dnsmasq")
1368 ;; create directory to store dnsmasq lease file
1369 '((mkdir-p "/var/lib/misc"))
1370 '())
1371 #$@(if (pair? dnsmasq-configuration-files) ;if non-empty
1372 ;; If /etc/NetworkManager/dnsmasq.d is a symlink to a store file,
1373 ;; delete it.
1374 `((when (false-if-exception
1375 (store-file-name? (readlink "/etc/NetworkManager/dnsmasq.d")))
1376 (delete-file "/etc/NetworkManager/dnsmasq.d"))
1377 (symlink
1378 ,(file-union "network-manager-dnsmasq-configuration-directory"
1379 dnsmasq-configuration-files)
1380 "/etc/NetworkManager/dnsmasq.d"))
1381 '())
1382 #$@(if (pair? extra-configuration-files) ;if non-empty
1383 ;; If /etc/NetworkManager/conf.d is a symlink to a store file,
1384 ;; delete it.
1385 `((when (false-if-exception
1386 (store-file-name? (readlink "/etc/NetworkManager/conf.d")))
1387 (delete-file "/etc/NetworkManager/conf.d"))
1388 ;; If it exists but is not a symlink to a store file, then
1389 ;; this will fail with EEXIST; we leave this for the user to
1390 ;; handle, since they probably created the directory
1391 ;; themselves.
1392 (symlink
1393 ,(file-union "network-manager-configuration-directory"
1394 extra-configuration-files)
1395 "/etc/NetworkManager/conf.d"))
1396 '())
1397 ;; Ensure "/etc/ipsec.secrets" exists, which is required by the
1398 ;; nm-l2tp plugin.
1399 (mkdir-p "/etc/ipsec.secrets"))))
1400
1401(define (vpn-plugin-directory plugins)
1402 "Return a directory containing PLUGINS, the NM VPN plugins."
1403 (directory-union "network-manager-vpn-plugins" plugins))
1404
1405(define (network-manager-accounts config)
1406 "Return the list of <user-account> and <user-group> for CONFIG."
1407 (define nologin
1408 (file-append shadow "/sbin/nologin"))
1409
1410 (define accounts
1411 (append-map (lambda (package)
1412 (map (lambda (name)
1413 (user-account (system? #t)
1414 (name name)
1415 (group "network-manager")
1416 (comment "NetworkManager helper")
1417 (home-directory "/var/empty")
1418 (create-home-directory? #f)
1419 (shell nologin)))
1420 (or (assoc-ref (package-properties package)
1421 'user-accounts)
1422 '())))
1423 (network-manager-configuration-vpn-plugins config)))
1424
1425 (match accounts
1426 (()
1427 '())
1428 (_
1429 (cons (user-group (name "network-manager") (system? #t))
1430 accounts))))
1431
1432(define (network-manager-environment config)
1433 (match-record config <network-manager-configuration>
1434 (network-manager dns vpn-plugins)
1435 ;; Define this variable in the global environment such that
1436 ;; "nmcli connection import type openvpn file foo.ovpn" works.
1437 `(("NM_VPN_PLUGIN_DIR"
1438 . ,(file-append (vpn-plugin-directory vpn-plugins)
1439 "/lib/NetworkManager/VPN")))))
1440
1441(define (network-manager-shepherd-service config)
1442 (match-record config <network-manager-configuration>
1443 (network-manager shepherd-requirement dns vpn-plugins iwd?)
1444 (let* ((iwd? (or iwd? ; TODO: deprecated field, remove later.
1445 (and shepherd-requirement
1446 (memq 'iwd shepherd-requirement))))
1447 (conf (plain-file "NetworkManager.conf"
1448 (string-append
1449 "[main]\ndns=" dns "\n"
1450 (if iwd? "[device]\nwifi.backend=iwd\n" ""))))
1451 (vpn (vpn-plugin-directory vpn-plugins)))
1452 (list (shepherd-service
1453 (documentation "Run the NetworkManager.")
1454 (provision '(NetworkManager networking))
1455 (requirement `(user-processes dbus-system loopback
1456 ,@shepherd-requirement
1457 ;; TODO: iwd? is deprecated and should be passed
1458 ;; with shepherd-requirement, remove later.
1459 ,@(if iwd? '(iwd) '())))
1460 (actions (list (shepherd-configuration-action conf)))
1461 (start
1462 #~(lambda _
1463 (let ((pid
1464 (fork+exec-command
1465 (list #$(file-append network-manager
1466 "/sbin/NetworkManager")
1467 (string-append "--config=" #$conf)
1468 "--no-daemon")
1469 #:environment-variables
1470 (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
1471 "/lib/NetworkManager/VPN")
1472 ;; Override non-existent default users
1473 "NM_OPENVPN_USER="
1474 "NM_OPENVPN_GROUP="
1475 ;; Allow NetworkManager to find the modules.
1476 (string-append
1477 "LINUX_MODULE_DIRECTORY="
1478 "/run/booted-system/kernel/lib/modules")))))
1479 ;; XXX: Despite the "online" name, this doesn't guarantee
1480 ;; WAN connectivity, it merely waits for NetworkManager
1481 ;; to finish starting-up. This is required otherwise
1482 ;; services will fail since the network interfaces be
1483 ;; absent until NetworkManager finishes setting them up.
1484 (system* #$(file-append network-manager "/bin/nm-online")
1485 "--wait-for-startup" "--quiet")
1486 ;; XXX: Finally, return the pid from running
1487 ;; fork+exec-command to shepherd.
1488 pid)))
1489 (stop #~(make-kill-destructor)))))))
1490
1491(define network-manager-service-type
1492 (let ((config->packages
1493 (lambda (config)
1494 (match-record config <network-manager-configuration>
1495 (network-manager vpn-plugins)
1496 `(,network-manager ,@vpn-plugins)))))
1497
1498 (service-type
1499 (name 'network-manager)
1500 (extensions
1501 (list (service-extension shepherd-root-service-type
1502 network-manager-shepherd-service)
1503 (service-extension dbus-root-service-type config->packages)
1504 (service-extension polkit-service-type
1505 (compose
1506 list
1507 network-manager-configuration-network-manager))
1508 (service-extension account-service-type
1509 network-manager-accounts)
1510 (service-extension activation-service-type
1511 network-manager-activation)
1512 (service-extension session-environment-service-type
1513 network-manager-environment)
1514 ;; Add network-manager to the system profile.
1515 (service-extension profile-service-type config->packages)))
1516 (default-value (network-manager-configuration))
1517 (description
1518 "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
1519NetworkManager}, a network management daemon that aims to simplify wired and
1520wireless networking."))))
1521
1522
1523;;;
1524;;; Connman
1525;;;
1526
1527(define (connman-general-configuration-field-name field-name)
1528 (let* ((str->camel (lambda (s)
1529 (string-concatenate
1530 (map string-capitalize (string-split s #\-)))))
1531 (str (if (symbol? field-name)
1532 (str->camel (symbol->string field-name))
1533 field-name)))
1534 (cond
1535 ((string-suffix? "?" str) (connman-general-configuration-field-name
1536 (string-drop-right str 1)))
1537 ((string-contains str "RegulatoryDomain") (connman-general-configuration-field-name
1538 (string-replace-substring str "RegulatoryDomain" "Regdom")))
1539 ((string-contains str "Url") (connman-general-configuration-field-name
1540 (string-replace-substring str "Url" "URL")))
1541 ((string-contains str "Ip") (connman-general-configuration-field-name
1542 (string-replace-substring str "Ip" "IP")))
1543 ((string-contains str "6To4") (connman-general-configuration-field-name
1544 (string-replace-substring str "6To4" "6to4")))
1545 (#t str))))
1546
1547(define (connman-general-configuration-serialize-string field-name value)
1548 (let ((param (connman-general-configuration-field-name field-name)))
1549 #~(string-append #$param " = " #$value "\n")))
1550
1551(define (connman-general-configuration-serialize-number field-name value)
1552 (connman-general-configuration-serialize-string
1553 field-name (number->string value)))
1554
1555(define (connman-general-configuration-serialize-list field-name value)
1556 (connman-general-configuration-serialize-string
1557 field-name (string-join value ",")))
1558
1559(define (connman-general-configuration-serialize-boolean field-name value)
1560 (connman-general-configuration-serialize-string
1561 field-name (if value "true" "false")))
1562
1563(define-maybe boolean (prefix connman-general-configuration-))
1564(define-maybe number (prefix connman-general-configuration-))
1565(define-maybe string (prefix connman-general-configuration-))
1566(define-maybe list (prefix connman-general-configuration-))
1567
1568(define-configuration connman-general-configuration
1569 (input-request-timeout
1570 maybe-number
1571 "Set input request timeout. Default is 120 seconds. The request for inputs
1572like passphrase will timeout after certain amount of time. Use this setting to
1573increase the value in case of different user interface designs.")
1574 (browser-launch-timeout
1575 maybe-number
1576 "Set browser launch timeout. Default is 300 seconds. The request for
1577launching a browser for portal pages will timeout after certain amount of
1578time. Use this setting to increase the value in case of different user
1579interface designs.")
1580 (background-scanning?
1581 maybe-boolean
1582 "Enable background scanning. Default is true. If wifi is disconnected, the
1583background scanning will follow a simple back off mechanism from 3s up to 5
1584minutes. Then, it will stay in 5 minutes unless user specifically asks for
1585scanning through a D-Bus call. If so, the mechanism will start again from
15863s. This feature activates also the background scanning while being connected,
1587which is required for roaming on wifi. When @code{background-scanning?} is false,
1588ConnMan will not perform any scan regardless of wifi is connected or not,
1589unless it is requested by the user through a D-Bus call.")
1590 (use-gateways-as-timeservers?
1591 maybe-boolean
1592 "Assume that service gateways also function as timeservers. Default is false.")
1593 (fallback-timeservers
1594 maybe-list
1595 "List of Fallback timeservers. These timeservers are used for NTP sync
1596when there are no timeservers set by the user or by the service, and when
1597@code{use-gateways-as-timeservers?} is @code{#f}. These can contain a mixed
1598combination of fully qualified domain names, IPv4 and IPv6 addresses.")
1599 (fallback-nameservers
1600 maybe-list
1601 "List of fallback nameservers appended to the list of nameservers given
1602by the service. The nameserver entries must be in numeric format,
1603host names are ignored.")
1604 (default-auto-connect-technologies
1605 maybe-list
1606 "List of technologies that are marked autoconnectable by default. The
1607default value for this entry when empty is @code{\"ethernet\"}, @code{\"wifi\"},
1608@code{\"cellular\"}. Services that are automatically connected must have been
1609set up and saved to storage beforehand.")
1610 (default-favourite-technologies
1611 maybe-list
1612 "List of technologies that are marked favorite by default. The default
1613value for this entry when empty is @code{\"ethernet\"}. Connects to services
1614from this technology even if not setup and saved to storage.")
1615 (always-connected-technologies
1616 maybe-list
1617 "List of technologies which are always connected regardless of
1618preferred-technologies setting (@code{auto-connect?} @code{#t}). The default
1619value is empty and this feature is disabled unless explicitly enabled.")
1620 (preferred-technologies
1621 maybe-list
1622 "List of preferred technologies from the most preferred one to the least
1623preferred one. Services of the listed technology type will be tried one by
1624one in the order given, until one of them gets connected or they are all
1625tried. A service of a preferred technology type in state 'ready' will get
1626the default route when compared to another preferred type further down the
1627list with state 'ready' or with a non-preferred type; a service of a
1628preferred technology type in state 'online' will get the default route when
1629compared to either a non-preferred type or a preferred type further down
1630in the list.")
1631 (network-interface-blacklist
1632 maybe-list
1633 "List of blacklisted network interfaces. Found interfaces will be
1634compared to the list and will not be handled by ConnMan, if their first
1635characters match any of the list entries. Default value is @code{\"vmnet\"},
1636@code{\"vboxnet\"}, @code{\"virbr\"}, @code{\"ifb\"}.")
1637 (allow-hostname-updates?
1638 maybe-boolean
1639 "Allow ConnMan to change the system hostname. This can happen for
1640example if we receive DHCP hostname option. Default value is @code{#t}.")
1641 (allow-domainname-updates?
1642 maybe-boolean
1643 "Allow connman to change the system domainname. This can happen for
1644example if we receive DHCP domainname option. Default value is @code{#t}.")
1645 (single-connected-technology?
1646 maybe-boolean
1647 "Keep only a single connected technology at any time. When a new
1648service is connected by the user or a better one is found according to
1649preferred-technologies, the new service is kept connected and all the
1650other previously connected services are disconnected. With this setting
1651it does not matter whether the previously connected services are
1652in 'online' or 'ready' states, the newly connected service is the only
1653one that will be kept connected. A service connected by the user will
1654be used until going out of network coverage. With this setting enabled
1655applications will notice more network breaks than normal. Note this
1656options can't be used with VPNs. Default value is @code{#f}.")
1657 (tethering-technologies
1658 maybe-list
1659 "List of technologies that are allowed to enable tethering. The
1660default value is @code{\"wifi\"}, @code{\"bluetooth\"},
1661@code{\"gadget\"}. Only those technologies listed here are used for
1662tethering. If one wants to tether ethernet, then add @code{\"ethernet\"}
1663in the list. Note that if ethernet tethering is enabled, then a DHCP
1664server is started on all ethernet interfaces. Tethered ethernet should
1665never be connected to corporate or home network as it will disrupt normal
1666operation of these networks. Due to this ethernet is not tethered by
1667default. Do not activate ethernet tethering unless you really know
1668what you are doing.")
1669 (persistent-tethering-mode?
1670 maybe-boolean
1671 "Restore earlier tethering status when returning from offline mode,
1672re-enabling a technology, and after restarts and reboots. Default
1673value is @code{#f}.")
1674 (enable-6to4?
1675 maybe-boolean
1676 "Automatically enable anycast 6to4 if possible. This is not
1677recommended, as the use of 6to4 will generally lead to a severe
1678degradation of connection quality. See RFC6343. Default value
1679is @code{#f} (as recommended by RFC6343 section 4.1).")
1680 (vendor-class-id
1681 maybe-string
1682 "Set DHCP option 60 (Vendor Class ID) to the given string. This
1683option can be used by DHCP servers to identify specific clients
1684without having to rely on MAC address ranges, etc.")
1685 (enable-online-check?
1686 maybe-boolean
1687 "Enable or disable use of HTTP GET as an online status check. When
1688a service is in a READY state, and is selected as default, ConnMan will
1689issue an HTTP GET request to verify that end-to-end connectivity is
1690successful. Only then the service will be transitioned to ONLINE
1691state. If this setting is false, the default service will remain
1692in READY state. Default value is @code{#t}.")
1693 (online-check-ipv4-url
1694 maybe-string
1695 "IPv4 URL used during the online status check. Please refer to
1696the README for more detailed information. Default value is
1697@url{http://ipv4.connman.net/online/status.html}.")
1698 (online-check-ipv6-url
1699 maybe-string
1700 "IPv6 URL used during the online status check. Please refer to
1701the README for more detailed information. Default value is
1702@url{http://ipv6.connman.net/online/status.html}.")
1703 (online-check-initial-interval
1704 maybe-number
1705 "Range of intervals between two online check requests. Please
1706refer to the README for more detailed information. Default value
1707is @samp{1}.")
1708 (online-check-max-interval
1709 maybe-number
1710 "Range of intervals between two online check requests. Please
1711refer to the README for more detailed information. Default value
1712is @samp{1}.")
1713 (enable-online-to-ready-transition?
1714 maybe-boolean
1715 "WARNING: This is an experimental feature. In addition to
1716@code{enable-online-check} setting, enable or disable use of HTTP GET
1717to detect the loss of end-to-end connectivity. If this setting is
1718@code{#f}, when the default service transitions to ONLINE state, the
1719HTTP GET request is no more called until next cycle, initiated by a
1720transition of the default service to DISCONNECT state. If this
1721setting is @code{#t}, the HTTP GET request keeps being called to
1722guarantee that end-to-end connectivity is still successful. If not,
1723the default service will transition to READY state, enabling another
1724service to become the default one, in replacement. Default value
1725is @code{#f}.")
1726 (auto-connect-roaming-services?
1727 maybe-boolean
1728 "Automatically connect roaming services. This is not recommended
1729unless you know you won't have any billing problem. Default value
1730is @code{#f}.")
1731 (address-conflict-detection?
1732 maybe-boolean
1733 "Enable or disable the implementation of IPv4 address conflict
1734detection according to RFC5227. ConnMan will send probe ARP packets
1735to see if an IPv4 address is already in use before assigning the
1736address to an interface. If an address conflict occurs for a
1737statically configured address, an IPv4LL address will be chosen
1738instead (according to RFC3927). If an address conflict occurs for
1739an address offered via DHCP, ConnMan sends a DHCP DECLINE once
1740and for the second conflict resorts to finding an IPv4LL
1741address. Default value is @code{#f}.")
1742 (localtime
1743 maybe-string
1744 "Path to localtime file. Defaults to @file{/etc/localtime}.")
1745 (regulatory-domain-follows-timezone?
1746 maybe-boolean
1747 "Enable regulatory domain to be changed along timezone changes.
1748With this option set to true each time the timezone changes the first
1749present ISO3166 country code is read from
1750@file{/usr/share/zoneinfo/zone1970.tab} and set as regulatory domain
1751value. Default value is @code{#f}.")
1752 (resolv-conf
1753 maybe-string
1754 "Path to resolv.conf file. If the file does not exist, but
1755intermediate directories exist, it will be created. If this option
1756is not set, it tries to write into @file{/var/run/connman/resolv.conf}
1757if it fails (@file{/var/run/connman} does not exist or is not
1758writeable). If you do not want to update resolv.conf, you can
1759set @file{/dev/null}.")
1760 (prefix connman-general-configuration-))
1761
1762(define-record-type* <connman-configuration>
1763 connman-configuration make-connman-configuration
1764 connman-configuration?
1765 (connman connman-configuration-connman
1766 (default connman))
1767 (shepherd-requirement connman-configuration-shepherd-requirement
1768 (default '()))
1769 (disable-vpn? connman-configuration-disable-vpn?
1770 (default #f))
1771 (iwd? connman-configuration-iwd?
1772 (default #f)
1773 (sanitize warn-iwd?-field-deprecation))
1774 (general-configuration connman-configuration-general-configuration
1775 (default (connman-general-configuration))))
1776
1777(define (connman-activation config)
1778 (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
1779 (with-imported-modules '((guix build utils))
1780 #~(begin
1781 (use-modules (guix build utils))
1782 (mkdir-p "/var/lib/connman/")
1783 (unless #$disable-vpn?
1784 (mkdir-p "/var/lib/connman-vpn/"))))))
1785
1786(define (connman-shepherd-service config)
1787 (match-record config <connman-configuration> (connman shepherd-requirement
1788 disable-vpn? iwd?
1789 general-configuration)
1790 (let ((iwd? (or iwd? ; TODO: deprecated field, remove later.
1791 (and shepherd-requirement
1792 (memq 'iwd shepherd-requirement))))
1793 (config (mixed-text-file
1794 "main.conf"
1795 "[General]\n"
1796 (serialize-configuration
1797 general-configuration
1798 connman-general-configuration-fields))))
1799 (list (shepherd-service
1800 (documentation "Run Connman")
1801 (provision '(connman networking))
1802 (requirement `(user-processes dbus-system loopback
1803 ,@shepherd-requirement
1804 ;; TODO: iwd? is deprecated and should be passed
1805 ;; with shepherd-requirement, remove later.
1806 ,@(if iwd? '(iwd) '())))
1807 (start #~(make-forkexec-constructor
1808 (list (string-append #$connman
1809 "/sbin/connmand")
1810 (string-append "--config=" #$config)
1811 "--nodaemon"
1812 "--nodnsproxy"
1813 #$@(if disable-vpn? '("--noplugin=vpn") '())
1814 #$@(if iwd? '("--wifi=iwd_agent") '()))
1815
1816 ;; As connman(8) notes, when passing '-n', connman
1817 ;; "directs log output to the controlling terminal in
1818 ;; addition to syslog." Redirect stdout and stderr
1819 ;; to avoid spamming the console (XXX: for some reason
1820 ;; redirecting to /dev/null doesn't work.)
1821 #:log-file "/var/log/connman.log"))
1822 (stop #~(make-kill-destructor)))))))
1823
1824(define connman-service-type
1825 (let ((connman-package (compose list connman-configuration-connman)))
1826 (service-type (name 'connman)
1827 (extensions
1828 (list (service-extension shepherd-root-service-type
1829 connman-shepherd-service)
1830 (service-extension polkit-service-type
1831 connman-package)
1832 (service-extension dbus-root-service-type
1833 connman-package)
1834 (service-extension activation-service-type
1835 connman-activation)
1836 ;; Add connman to the system profile.
1837 (service-extension profile-service-type
1838 connman-package)))
1839 (default-value (connman-configuration))
1840 (description
1841 "Run @url{https://01.org/connman,Connman},
1842a network connection manager."))))
1843
1844
1845;;;
1846;;; Modem manager
1847;;;
1848
1849(define modem-manager-service-type
1850 (let ((config->package
1851 (lambda (config)
1852 (list (modem-manager-configuration-modem-manager config)))))
1853 (service-type (name 'modem-manager)
1854 (extensions
1855 (list (service-extension dbus-root-service-type
1856 config->package)
1857 (service-extension udev-service-type
1858 config->package)
1859 (service-extension polkit-service-type
1860 config->package)))
1861 (default-value (modem-manager-configuration))
1862 (description
1863 "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
1864ModemManager}, a modem management daemon that aims to simplify dialup
1865networking."))))
1866
1867
1868;;;
1869;;; USB_ModeSwitch
1870;;;
1871
1872(define-record-type* <usb-modeswitch-configuration>
1873 usb-modeswitch-configuration make-usb-modeswitch-configuration
1874 usb-modeswitch-configuration?
1875 (usb-modeswitch usb-modeswitch-configuration-usb-modeswitch
1876 (default usb-modeswitch))
1877 (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
1878 (default usb-modeswitch-data))
1879 (config-file usb-modeswitch-configuration-config-file
1880 (default #~(string-append #$usb-modeswitch:dispatcher
1881 "/etc/usb_modeswitch.conf"))))
1882
1883(define (usb-modeswitch-sh usb-modeswitch config-file)
1884 "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
1885modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
1886and wrap it to actually find the dispatcher in USB-MODESWITCH. The script
1887will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
1888device is detected."
1889 (computed-file
1890 "usb_modeswitch-sh"
1891 (with-imported-modules '((guix build utils))
1892 #~(begin
1893 (use-modules (guix build utils))
1894 (let ((cfg-param
1895 #$(if config-file
1896 #~(string-append " --config-file=" #$config-file)
1897 "")))
1898 (mkdir #$output)
1899 (install-file (string-append #$usb-modeswitch:dispatcher
1900 "/lib/udev/usb_modeswitch")
1901 #$output)
1902
1903 ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
1904 (substitute* (string-append #$output "/usb_modeswitch")
1905 (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
1906 (string-append left cfg-param right))
1907 (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
1908 (string-append left cfg-param right)))
1909
1910 ;; wrap-program needs bash in PATH:
1911 (putenv (string-append "PATH=" #$bash "/bin"))
1912 (wrap-program (string-append #$output "/usb_modeswitch")
1913 `("PATH" ":" = (,(string-append #$coreutils "/bin")
1914 ,(string-append
1915 #$usb-modeswitch:dispatcher
1916 "/bin")))))))))
1917
1918(define (usb-modeswitch-configuration->udev-rules config)
1919 "Build a rules file for extending udev-service-type from the rules in the
1920usb-modeswitch package specified in CONFIG. The rules file will invoke
1921usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
1922config file."
1923 (match-record config <usb-modeswitch-configuration>
1924 (usb-modeswitch usb-modeswitch-data config-file)
1925 (computed-file
1926 "usb_modeswitch.rules"
1927 (with-imported-modules '((guix build utils))
1928 #~(begin
1929 (use-modules (guix build utils))
1930 (let ((in (string-append #$usb-modeswitch-data
1931 "/udev/40-usb_modeswitch.rules"))
1932 (out (string-append #$output "/lib/udev/rules.d"))
1933 (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
1934 (mkdir-p out)
1935 (chdir out)
1936 (install-file in out)
1937 (substitute* "40-usb_modeswitch.rules"
1938 (("PROGRAM=\"usb_modeswitch")
1939 (string-append "PROGRAM=\"" script "/usb_modeswitch"))
1940 (("RUN\\+=\"usb_modeswitch")
1941 (string-append "RUN+=\"" script "/usb_modeswitch")))))))))
1942
1943(define usb-modeswitch-service-type
1944 (service-type
1945 (name 'usb-modeswitch)
1946 (extensions
1947 (list
1948 (service-extension
1949 udev-service-type
1950 (lambda (config)
1951 (let ((rules (usb-modeswitch-configuration->udev-rules config)))
1952 (list rules))))))
1953 (default-value (usb-modeswitch-configuration))
1954 (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
1955USB_ModeSwitch}, a mode switching tool for controlling USB devices with
1956multiple @dfn{modes}. When plugged in for the first time many USB
1957devices (primarily high-speed WAN modems) act like a flash storage containing
1958installers for Windows drivers. USB_ModeSwitch replays the sequence the
1959Windows drivers would send to switch their mode from storage to modem (or
1960whatever the thing is supposed to do).")))
1961
1962
1963;;;
1964;;; WPA supplicant
1965;;;
1966
1967(define-with-syntax-properties (warn-deprecated-wpa-supplicant-requirement
1968 (value properties))
1969 (unless (unspecified? value)
1970 (warning (source-properties->location properties)
1971 (G_ "the 'requirement' field is deprecated, please use \
1972'shepherd-requirement' field instead~%")))
1973 value)
1974
1975(define-record-type* <wpa-supplicant-configuration>
1976 wpa-supplicant-configuration make-wpa-supplicant-configuration
1977 wpa-supplicant-configuration?
1978 (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;file-like
1979 (default wpa-supplicant))
1980 (requirement wpa-supplicant-configuration-requirement ;list of symbols
1981 (sanitize warn-deprecated-wpa-supplicant-requirement)
1982 (default *unspecified*))
1983 (pid-file wpa-supplicant-configuration-pid-file ;string
1984 (default "/var/run/wpa_supplicant.pid"))
1985 (dbus? wpa-supplicant-configuration-dbus? ;Boolean
1986 (default #t))
1987 (interface wpa-supplicant-configuration-interface ;#f | string
1988 (default #f))
1989 (config-file wpa-supplicant-configuration-config-file ;#f | <file-like>
1990 (default #f))
1991 (extra-options wpa-supplicant-configuration-extra-options ;list of strings
1992 (default '()))
1993 (shepherd-provision wpa-supplicant-configuration-shepherd-provision ;list of symbols
1994 (default '(wpa-supplicant wireless-daemon)))
1995 (shepherd-requirement wpa-supplicant-configuration-shepherd-requirement ;list of symbols
1996 (default '(user-processes loopback syslogd))))
1997
1998(define (wpa-supplicant-shepherd-service config)
1999 (match-record config <wpa-supplicant-configuration>
2000 (wpa-supplicant requirement pid-file dbus?
2001 shepherd-requirement shepherd-provision
2002 interface config-file extra-options)
2003 (list (shepherd-service
2004 (documentation "Run the WPA supplicant daemon")
2005 (provision shepherd-provision)
2006 (requirement `(,@(if dbus? '(dbus-system) '())
2007 ,@(or (if (unspecified? requirement) #f requirement)
2008 shepherd-requirement)))
2009 (start #~(make-forkexec-constructor
2010 (list (string-append #$wpa-supplicant
2011 "/sbin/wpa_supplicant")
2012 (string-append "-P" #$pid-file)
2013 "-B" ;run in background
2014 "-s" ;log to syslogd
2015 #$@(if dbus?
2016 #~("-u")
2017 #~())
2018 #$@(if interface
2019 #~((string-append "-i" #$interface))
2020 #~())
2021 #$@(if config-file
2022 #~((string-append "-c" #$config-file))
2023 #~())
2024 #$@extra-options)
2025 #:pid-file #$pid-file))
2026 (stop #~(make-kill-destructor))))))
2027
2028(define wpa-supplicant-service-type
2029 (let ((config->package
2030 (lambda (config)
2031 (list (wpa-supplicant-configuration-wpa-supplicant config)))))
2032 (service-type (name 'wpa-supplicant)
2033 (extensions
2034 (list (service-extension shepherd-root-service-type
2035 wpa-supplicant-shepherd-service)
2036 (service-extension dbus-root-service-type config->package)
2037 (service-extension profile-service-type config->package)))
2038 (description "Run the WPA Supplicant daemon, a service that
2039implements authentication, key negotiation and more for wireless networks.")
2040 (default-value (wpa-supplicant-configuration)))))
2041
2042
2043;;;
2044;;; IWD
2045;;;
2046(define (iwd-uglify-field-name name)
2047 (object->camel-case-string name 'upper))
2048
2049(define (iwd-serialize-base field-name val)
2050 (format #f "~a=~a\n" field-name val))
2051
2052(define (iwd-serialize-field field-name val)
2053 (iwd-serialize-base (iwd-uglify-field-name field-name) val))
2054
2055(define iwd-serialize-number iwd-serialize-field)
2056
2057(define (iwd-serialize-boolean field-name value)
2058 (iwd-serialize-field
2059 (string-trim-right (symbol->string field-name) #\?)
2060 (if value "true" "false")))
2061
2062(define (iwd-serialize-alist field-name value)
2063 (if (null? value)
2064 ""
2065 #~(string-append #$@(generic-serialize-alist list
2066 iwd-serialize-base
2067 value))))
2068
2069(define-enumerated-field-type resolving-service
2070 (none systemd resolvconf)
2071 (prefix iwd-))
2072
2073(define-configuration iwd-general-settings
2074 (enable-network-configuration?
2075 (boolean #f)
2076 "Setting this option to true enables @code{iwd} to configure the network
2077interfaces with the IP addresses.")
2078 (extra-options
2079 (alist '())
2080 "An association list of option symbols/strings to string values to be
2081appended to the General settings group.")
2082
2083 (prefix iwd-))
2084
2085(define-configuration iwd-network-settings
2086 (enable-ipv6?
2087 (boolean #t)
2088 "Sets the global default that tells @code{iwd} whether it should configure
2089IPv6 addresses and routes")
2090
2091 (name-resolving-service
2092 (resolving-service 'none)
2093 "Configures a DNS resolution method used by the system.")
2094
2095 (extra-options
2096 (alist '())
2097 "An association list of option symbols/strings to string values to be
2098appended to the Network settings group.")
2099
2100 (prefix iwd-))
2101
2102(define-configuration iwd-scan-settings
2103 (disable-periodic-scan?
2104 (boolean #f)
2105 "Setting this option to @code{#t} will prevent @code{iwd} from issuing the
2106periodic scans for the available networks while disconnected.")
2107
2108 (initial-periodic-scan-interval
2109 (number 10)
2110 "The initial periodic scan interval upon disconnect (in seconds).")
2111
2112 (maximum-periodic-scan-interval
2113 (number 300)
2114 "The maximum periodic scan interval (in seconds).")
2115
2116 (disable-roaming-scan?
2117 (boolean #f)
2118 "Setting this option to @code{#t} will prevent @code{iwd} from trying to scan
2119when roaming decisions are activated.")
2120
2121 (extra-options
2122 (alist '())
2123 "An association list of option symbols/strings to string values to be
2124appended to the Scan settings group.")
2125
2126 (prefix iwd-))
2127
2128(define-maybe iwd-network-settings)
2129(define-maybe iwd-scan-settings)
2130
2131(define ((iwd-serialize-config-section fields) name cfg)
2132 #~(format #f "[~a]\n~a\n"
2133 #$(string-upcase (object->string name) 0 1)
2134 #$(serialize-configuration cfg fields)))
2135
2136(define serialize-iwd-network-settings
2137 (iwd-serialize-config-section iwd-network-settings-fields))
2138
2139(define serialize-iwd-scan-settings
2140 (iwd-serialize-config-section iwd-scan-settings-fields))
2141
2142(define serialize-iwd-general-settings
2143 (iwd-serialize-config-section iwd-general-settings-fields))
2144
2145(define-configuration iwd-settings
2146 (general
2147 (iwd-general-settings (iwd-general-settings))
2148 "General settings.")
2149
2150 (network
2151 (maybe-iwd-network-settings (iwd-network-settings))
2152 "Network settings.")
2153
2154 (scan
2155 maybe-iwd-scan-settings
2156 "Scan settings.")
2157
2158 (extra-config
2159 (list-of-strings '())
2160 "Extra configuration values to append to the IWD configuration file."
2161 (serializer (lambda (_ value) (string-join value "\n" 'suffix)))))
2162
2163(define-configuration/no-serialization iwd-configuration
2164 (iwd
2165 (file-like iwd)
2166 "The IWD package to use.")
2167
2168 (interfaces
2169 (list-of-strings '())
2170 "If this is set, it must specify @dfn{glob patterns} matching network
2171interfaces that IWD will control.")
2172
2173 (ignored-interfaces
2174 (list-of-strings '())
2175 "If this is set, it must specify @dfn{glob patterns} matching network
2176interfaces that IWD will not manage.")
2177
2178 (phys
2179 (list-of-strings '())
2180 "If this is set, it must specify @dfn{glob patterns} matching network
2181PHYs names that IWD will control.")
2182
2183 (ignored-phys
2184 (list-of-strings '())
2185 "If this is set, it must specify @dfn{glob patterns} matching network
2186PHYs names that IWD will not manage.")
2187
2188 (shepherd-requirement
2189 (list-of-symbols '())
2190 "Shepherd requirements the service should depend on.")
2191
2192 (shepherd-provision
2193 (list-of-symbols '(iwd wireless-daemon))
2194 "The name(s) of the service.")
2195
2196 (config
2197 (iwd-settings (iwd-settings))
2198 "Configuration settings."))
2199
2200(define (iwd-generate-documentation)
2201 (configuration->documentation 'iwd-configuration)
2202 (configuration->documentation 'iwd-settings)
2203 (configuration->documentation 'iwd-general-settings)
2204 (configuration->documentation 'iwd-network-settings)
2205 (configuration->documentation 'iwd-scan-settings))
2206
2207(define (iwd-config-file config)
2208 "Return an IWD configuration file."
2209 (mixed-text-file "main.conf"
2210 (serialize-configuration
2211 (iwd-configuration-config config)
2212 iwd-settings-fields)))
2213
2214(define (iwd-environment config)
2215 (let ((resolver
2216 (and=> (iwd-settings-network (iwd-configuration-config config))
2217 iwd-network-settings-name-resolving-service)))
2218
2219 (if (eq? resolver 'resolvconf)
2220 #~(list (string-append "PATH=" #$openresolv "/sbin"))
2221 #~(list))))
2222
2223(define (iwd-shepherd-service config)
2224 (match-record config <iwd-configuration>
2225 (iwd interfaces ignored-interfaces
2226 phys ignored-phys
2227 shepherd-requirement shepherd-provision)
2228
2229 (list (shepherd-service
2230 (documentation "Run the iNet Wireless Daemon, iwd.")
2231 (provision shepherd-provision)
2232 (requirement `(user-processes dbus-system loopback ,@shepherd-requirement))
2233 (start #~(make-forkexec-constructor
2234 (list (string-append #$iwd "/libexec/iwd")
2235 "--logger=syslog"
2236 #$@(if (null? interfaces) '()
2237 (list (string-append "--interfaces="
2238 (string-join interfaces ","))))
2239 #$@(if (null? ignored-interfaces) '()
2240 (list (string-append "--nointerfaces="
2241 (string-join ignored-interfaces ","))))
2242 #$@(if (null? phys) '()
2243 (list (string-append "--phys="
2244 (string-join phys ","))))
2245 #$@(if (null? ignored-phys) '()
2246 (list (string-append "--nophys="
2247 (string-join ignored-phys ",")))))
2248
2249 #:environment-variables
2250 #$(iwd-environment config)))
2251 (stop #~(make-kill-destructor))))))
2252
2253(define (iwd-etc-service config)
2254 `(("iwd/main.conf" ,(iwd-config-file config))))
2255
2256(define iwd-service-type
2257 (let ((add-iwd-package (compose list iwd-configuration-iwd)))
2258 (service-type (name 'iwd)
2259 (extensions
2260 (list (service-extension shepherd-root-service-type
2261 iwd-shepherd-service)
2262 (service-extension etc-service-type
2263 iwd-etc-service)
2264 (service-extension dbus-root-service-type
2265 add-iwd-package)
2266 (service-extension profile-service-type
2267 add-iwd-package)))
2268 (default-value (iwd-configuration))
2269 (description
2270 "Run the iNet Wireless Daemon,
2271@url{https://iwd.wiki.kernel.org/,iwd}, a network connection manager."))))
2272
2273
2274;;;
2275;;; Hostapd.
2276;;;
2277
2278(define-record-type* <hostapd-configuration>
2279 hostapd-configuration make-hostapd-configuration
2280 hostapd-configuration?
2281 (package hostapd-configuration-package
2282 (default hostapd))
2283 (interface hostapd-configuration-interface ;string
2284 (default "wlan0"))
2285 (ssid hostapd-configuration-ssid) ;string
2286 (broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean
2287 (default #t))
2288 (channel hostapd-configuration-channel ;integer
2289 (default 1))
2290 (driver hostapd-configuration-driver ;string
2291 (default "nl80211"))
2292 ;; See <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> for a list of
2293 ;; additional options we could add.
2294 (extra-settings hostapd-configuration-extra-settings ;string
2295 (default "")))
2296
2297(define (hostapd-configuration-file config)
2298 "Return the configuration file for CONFIG, a <hostapd-configuration>."
2299 (match-record config <hostapd-configuration>
2300 (interface ssid broadcast-ssid? channel driver extra-settings)
2301 (plain-file "hostapd.conf"
2302 (string-append "\
2303# Generated from your Guix configuration.
2304
2305interface=" interface "
2306ssid=" ssid "
2307ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") "
2308channel=" (number->string channel) "\n"
2309extra-settings "\n"))))
2310
2311(define* (hostapd-shepherd-services config #:key (requirement '()))
2312 "Return Shepherd services for hostapd."
2313 (list (shepherd-service
2314 (provision '(hostapd))
2315 (requirement `(user-processes ,@requirement))
2316 (documentation "Run the hostapd WiFi access point daemon.")
2317 (start #~(make-forkexec-constructor
2318 (list #$(file-append (hostapd-configuration-package config)
2319 "/sbin/hostapd")
2320 #$(hostapd-configuration-file config))
2321 #:log-file "/var/log/hostapd.log"))
2322 (stop #~(make-kill-destructor)))))
2323
2324(define hostapd-service-type
2325 (service-type
2326 (name 'hostapd)
2327 (extensions
2328 (list (service-extension shepherd-root-service-type
2329 hostapd-shepherd-services)))
2330 (description
2331 "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access
2332points and authentication servers.")))
2333
2334(define (simulated-wifi-shepherd-services config)
2335 "Return Shepherd services to run hostapd with CONFIG, a
2336<hostapd-configuration>, as well as services to set up WiFi hardware
2337simulation."
2338 (append (hostapd-shepherd-services config
2339 #:requirement
2340 '(unblocked-wifi
2341 kernel-module-loader))
2342 (list (shepherd-service
2343 (provision '(unblocked-wifi))
2344 (requirement '(file-systems kernel-module-loader))
2345 (documentation
2346 "Unblock WiFi devices for use by mac80211_hwsim.")
2347 (start #~(lambda _
2348 (invoke #$(file-append util-linux "/sbin/rfkill")
2349 "unblock" "0")
2350 (invoke #$(file-append util-linux "/sbin/rfkill")
2351 "unblock" "1")))
2352 (one-shot? #t)))))
2353
2354(define simulated-wifi-service-type
2355 (service-type
2356 (name 'simulated-wifi)
2357 (extensions
2358 (list (service-extension shepherd-root-service-type
2359 simulated-wifi-shepherd-services)
2360 (service-extension kernel-module-loader-service-type
2361 (const '("mac80211_hwsim")))))
2362 (default-value (hostapd-configuration
2363 (interface "wlan1")
2364 (ssid "Test Network")))
2365 (description "Run hostapd to simulate WiFi connectivity.")))
2366
2367
2368;;;
2369;;; Open vSwitch
2370;;;
2371
2372(define-record-type* <openvswitch-configuration>
2373 openvswitch-configuration make-openvswitch-configuration
2374 openvswitch-configuration?
2375 (package openvswitch-configuration-package
2376 (default openvswitch)))
2377
2378(define (openvswitch-activation config)
2379 (let ((ovsdb-tool (file-append (openvswitch-configuration-package config)
2380 "/bin/ovsdb-tool")))
2381 (with-imported-modules '((guix build utils))
2382 #~(begin
2383 (use-modules (guix build utils))
2384 (mkdir-p "/var/run/openvswitch")
2385 (mkdir-p "/var/lib/openvswitch")
2386 (let ((conf.db "/var/lib/openvswitch/conf.db"))
2387 (unless (file-exists? conf.db)
2388 (system* #$ovsdb-tool "create" conf.db)))))))
2389
2390(define (openvswitch-shepherd-service config)
2391 (let* ((package (openvswitch-configuration-package config))
2392 (ovsdb-server (file-append package "/sbin/ovsdb-server"))
2393 (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
2394 (list (shepherd-service
2395 (provision '(ovsdb))
2396 (requirement '(user-processes))
2397 (documentation "Run the Open vSwitch database server.")
2398 (start #~(make-forkexec-constructor
2399 (list #$ovsdb-server "--pidfile"
2400 "--remote=punix:/var/run/openvswitch/db.sock")
2401 #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
2402 (stop #~(make-kill-destructor)))
2403 (shepherd-service
2404 (provision '(vswitchd))
2405 (requirement '(user-processes ovsdb))
2406 (documentation "Run the Open vSwitch daemon.")
2407 (start #~(make-forkexec-constructor
2408 (list #$ovs-vswitchd "--pidfile")
2409 #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
2410 (stop #~(make-kill-destructor))))))
2411
2412(define openvswitch-service-type
2413 (service-type
2414 (name 'openvswitch)
2415 (extensions
2416 (list (service-extension activation-service-type
2417 openvswitch-activation)
2418 (service-extension profile-service-type
2419 (compose list openvswitch-configuration-package))
2420 (service-extension shepherd-root-service-type
2421 openvswitch-shepherd-service)))
2422 (description
2423 "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
2424switch designed to enable massive network automation through programmatic
2425extension.")
2426 (default-value (openvswitch-configuration))))
2427
2428;;;
2429;;; iptables
2430;;;
2431
2432(define %iptables-accept-all-rules
2433 (plain-file "iptables-accept-all.rules"
2434 "*filter
2435:INPUT ACCEPT
2436:FORWARD ACCEPT
2437:OUTPUT ACCEPT
2438COMMIT
2439"))
2440
2441(define-record-type* <iptables-configuration>
2442 iptables-configuration make-iptables-configuration iptables-configuration?
2443 (iptables iptables-configuration-iptables
2444 (default iptables))
2445 (ipv4-rules iptables-configuration-ipv4-rules
2446 (default %iptables-accept-all-rules))
2447 (ipv6-rules iptables-configuration-ipv6-rules
2448 (default %iptables-accept-all-rules)))
2449
2450(define (iptables-shepherd-service config)
2451 (match-record config <iptables-configuration>
2452 (iptables ipv4-rules ipv6-rules)
2453 (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
2454 (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
2455 (shepherd-service
2456 (documentation "Packet filtering framework")
2457 (provision '(iptables))
2458 (start #~(lambda _
2459 (invoke #$iptables-restore #$ipv4-rules)
2460 (invoke #$ip6tables-restore #$ipv6-rules)))
2461 (stop #~(lambda _
2462 (invoke #$iptables-restore #$%iptables-accept-all-rules)
2463 (invoke #$ip6tables-restore #$%iptables-accept-all-rules)))))))
2464
2465(define iptables-service-type
2466 (service-type
2467 (name 'iptables)
2468 (default-value (iptables-configuration))
2469 (description
2470 "Run @command{iptables-restore}, setting up the specified rules.")
2471 (extensions
2472 (list (service-extension shepherd-root-service-type
2473 (compose list iptables-shepherd-service))))))
2474
2475;;;
2476;;; nftables.
2477;;;
2478
2479(define %default-nftables-ruleset
2480 (plain-file "nftables.conf" "\
2481# A simple and safe firewall
2482table inet filter {
2483 chain input {
2484 type filter hook input priority 0; policy drop;
2485
2486 # early drop of invalid connections
2487 ct state invalid drop
2488
2489 # allow established/related connections
2490 ct state { established, related } accept
2491
2492 # allow from loopback
2493 iif lo accept
2494 # drop connections to lo not coming from lo
2495 iif != lo ip daddr 127.0.0.1/8 drop
2496 iif != lo ip6 daddr ::1/128 drop
2497
2498 # allow icmp
2499 ip protocol icmp accept
2500 ip6 nexthdr icmpv6 accept
2501
2502 # allow ssh
2503 tcp dport ssh accept
2504
2505 # reject everything else
2506 reject with icmpx type port-unreachable
2507 }
2508 chain forward {
2509 type filter hook forward priority 0; policy drop;
2510 }
2511 chain output {
2512 type filter hook output priority 0; policy accept;
2513 }
2514}
2515"))
2516
2517(define (debug-level? x)
2518 (member x '(scanner parser eval netlink mnl proto-ctx segtree all)))
2519
2520(define list-of-debug-levels?
2521 (list-of debug-level?))
2522
2523(define-maybe/no-serialization list-of-debug-levels)
2524
2525(define-configuration/no-serialization nftables-configuration
2526 (package
2527 (file-like nftables)
2528 "The @code{nftables} package to use.")
2529 (debug-levels
2530 maybe-list-of-debug-levels
2531 "A list of debug levels, for enabling debugging output. Valid debug level values
2532are the @samp{scanner}, @samp{parser}, @samp{eval}, @samp{netlink},
2533@samp{mnl}, @samp{proto-ctx}, @samp{segtree} or @samp{all} symbols.")
2534 (ruleset
2535 (file-like %default-nftables-ruleset)
2536 "A file-like object containing the complete nftables ruleset. The default
2537ruleset rejects all incoming connections except those to TCP port 22, with
2538connections from the loopback interface are allowed."))
2539
2540(define (nftables-shepherd-service config)
2541 (match-record config <nftables-configuration>
2542 (package debug-levels ruleset)
2543 (let ((nft (file-append package "/sbin/nft")))
2544 (shepherd-service
2545 (documentation "Packet filtering and classification")
2546 (actions (list (shepherd-configuration-action ruleset)))
2547 (provision '(nftables))
2548 (start #~(lambda _
2549 (invoke #$nft
2550 #$@(if (maybe-value-set? debug-levels)
2551 (list (format #f "--debug=~{~a~^,~}"
2552 debug-levels))
2553 #~())
2554 "--file" #$ruleset)))
2555 (stop #~(lambda _
2556 (invoke #$nft "flush" "ruleset")))))))
2557
2558(define nftables-service-type
2559 (service-type
2560 (name 'nftables)
2561 (description
2562 "Run @command{nft}, setting up the specified ruleset.")
2563 (extensions
2564 (list (service-extension shepherd-root-service-type
2565 (compose list nftables-shepherd-service))
2566 (service-extension profile-service-type
2567 (compose list nftables-configuration-package))))
2568 (default-value (nftables-configuration))))
2569
2570
2571;;;
2572;;; PageKite
2573;;;
2574
2575(define-record-type* <pagekite-configuration>
2576 pagekite-configuration
2577 make-pagekite-configuration
2578 pagekite-configuration?
2579 (package pagekite-configuration-package
2580 (default pagekite))
2581 (kitename pagekite-configuration-kitename
2582 (default #f))
2583 (kitesecret pagekite-configuration-kitesecret
2584 (default #f))
2585 (frontend pagekite-configuration-frontend
2586 (default #f))
2587 (kites pagekite-configuration-kites
2588 (default '("http:@kitename:localhost:80:@kitesecret")))
2589 (extra-file pagekite-configuration-extra-file
2590 (default #f)))
2591
2592(define (pagekite-configuration-file config)
2593 (match-record config <pagekite-configuration>
2594 (package kitename kitesecret frontend kites extra-file)
2595 (mixed-text-file "pagekite.rc"
2596 (if extra-file
2597 (string-append "optfile = " extra-file "\n")
2598 "")
2599 (if kitename
2600 (string-append "kitename = " kitename "\n")
2601 "")
2602 (if kitesecret
2603 (string-append "kitesecret = " kitesecret "\n")
2604 "")
2605 (if frontend
2606 (string-append "frontend = " frontend "\n")
2607 "defaults\n")
2608 (string-join (map (lambda (kite)
2609 (string-append "service_on = " kite))
2610 kites)
2611 "\n"
2612 'suffix))))
2613
2614(define (pagekite-shepherd-service config)
2615 (match-record config <pagekite-configuration>
2616 (package kitename kitesecret frontend kites extra-file)
2617 (let* ((config-file (pagekite-configuration-file config))
2618 (mappings (cons (file-system-mapping
2619 (source config-file)
2620 (target source))
2621 (if extra-file
2622 (list (file-system-mapping
2623 (source extra-file)
2624 (target source)))
2625 '())))
2626 (pagekite (least-authority-wrapper
2627 (file-append package "/bin/pagekite")
2628 #:name "pagekite"
2629 #:mappings mappings
2630 ;; 'pagekite' changes user IDs to it needs to run in the
2631 ;; global user namespace.
2632 #:namespaces (fold delq %namespaces '(net user)))))
2633 (shepherd-service
2634 (documentation "Run the PageKite service.")
2635 (provision '(pagekite))
2636 (requirement '(user-processes networking))
2637 (actions (list (shepherd-configuration-action config-file)))
2638 (start #~(make-forkexec-constructor
2639 (list #$pagekite
2640 "--clean"
2641 "--nullui"
2642 "--nocrashreport"
2643 "--runas=pagekite:pagekite"
2644 (string-append "--optfile=" #$config-file))
2645 #:log-file "/var/log/pagekite.log"))
2646 ;; SIGTERM doesn't always work for some reason.
2647 (stop #~(make-kill-destructor SIGINT))))))
2648
2649(define %pagekite-accounts
2650 (list (user-group (name "pagekite") (system? #t))
2651 (user-account
2652 (name "pagekite")
2653 (group "pagekite")
2654 (system? #t)
2655 (comment "PageKite user")
2656 (home-directory "/var/empty")
2657 (shell (file-append shadow "/sbin/nologin")))))
2658
2659(define pagekite-service-type
2660 (service-type
2661 (name 'pagekite)
2662 (default-value (pagekite-configuration))
2663 (extensions
2664 (list (service-extension shepherd-root-service-type
2665 (compose list pagekite-shepherd-service))
2666 (service-extension account-service-type
2667 (const %pagekite-accounts))))
2668 (description
2669 "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
2670local servers publicly accessible on the web, even behind NATs and firewalls.")))
2671
2672
2673;;;
2674;;; Yggdrasil
2675;;;
2676
2677(define-record-type* <yggdrasil-configuration>
2678 yggdrasil-configuration
2679 make-yggdrasil-configuration
2680 yggdrasil-configuration?
2681 (package yggdrasil-configuration-package
2682 (default yggdrasil))
2683 (json-config yggdrasil-configuration-json-config
2684 (default '()))
2685 (config-file yggdrasil-config-file
2686 (default "/etc/yggdrasil-private.conf"))
2687 (autoconf? yggdrasil-configuration-autoconf?
2688 (default #f))
2689 (log-level yggdrasil-configuration-log-level
2690 (default 'info))
2691 (log-to yggdrasil-configuration-log-to
2692 (default 'stdout)))
2693
2694(define (yggdrasil-configuration-file config)
2695 (define (scm->yggdrasil-json x)
2696 (define key-value?
2697 dotted-list?)
2698 (define (param->camel str)
2699 (string-concatenate
2700 (map string-capitalize
2701 (string-split str (cut eqv? <> #\-)))))
2702 (cond
2703 ((key-value? x)
2704 (let ((k (car x))
2705 (v (cdr x)))
2706 (cons
2707 (if (symbol? k)
2708 (param->camel (symbol->string k))
2709 k)
2710 v)))
2711 ((list? x) (map scm->yggdrasil-json x))
2712 ((vector? x) (vector-map scm->yggdrasil-json x))
2713 (else x)))
2714 (computed-file
2715 "yggdrasil.conf"
2716 #~(call-with-output-file #$output
2717 (lambda (port)
2718 ;; it's HJSON, so comments are a-okay
2719 (display "# Generated by yggdrasil-service\n" port)
2720 (display #$(scm->json-string
2721 (scm->yggdrasil-json
2722 (yggdrasil-configuration-json-config config)))
2723 port)))))
2724
2725(define (yggdrasil-shepherd-service config)
2726 "Return a <shepherd-service> for yggdrasil with CONFIG."
2727 (define yggdrasil-command
2728 #~(append
2729 (list (string-append
2730 #$(yggdrasil-configuration-package config)
2731 "/bin/yggdrasil")
2732 "-useconffile"
2733 #$(yggdrasil-configuration-file config))
2734 (if #$(yggdrasil-configuration-autoconf? config)
2735 '("-autoconf")
2736 '())
2737 (let ((extraconf #$(yggdrasil-config-file config)))
2738 (if extraconf
2739 (list "-extraconffile" extraconf)
2740 '()))
2741 (list "-loglevel"
2742 #$(symbol->string (yggdrasil-configuration-log-level config))
2743 "-logto"
2744 #$(symbol->string (yggdrasil-configuration-log-to config)))))
2745 (list (shepherd-service
2746 (documentation "Connect to the Yggdrasil mesh network")
2747 (provision '(yggdrasil))
2748 (requirement '(networking))
2749 (start #~(make-forkexec-constructor
2750 #$yggdrasil-command
2751 #:log-file "/var/log/yggdrasil.log"
2752 #:group "yggdrasil"))
2753 (stop #~(make-kill-destructor)))))
2754
2755(define %yggdrasil-accounts
2756 (list (user-group (name "yggdrasil") (system? #t))))
2757
2758(define yggdrasil-service-type
2759 (service-type
2760 (name 'yggdrasil)
2761 (description
2762 "Connect to the Yggdrasil mesh network.
2763See @command{yggdrasil -genconf} for config options.")
2764 (extensions
2765 (list (service-extension shepherd-root-service-type
2766 yggdrasil-shepherd-service)
2767 (service-extension account-service-type
2768 (const %yggdrasil-accounts))
2769 (service-extension profile-service-type
2770 (compose list yggdrasil-configuration-package))))))
2771
2772
2773;;;
2774;;; IPFS
2775;;;
2776
2777(define-record-type* <ipfs-configuration>
2778 ipfs-configuration
2779 make-ipfs-configuration
2780 ipfs-configuration?
2781 (package ipfs-configuration-package
2782 (default kubo))
2783 (gateway ipfs-configuration-gateway
2784 (default "/ip4/127.0.0.1/tcp/8082"))
2785 (api ipfs-configuration-api
2786 (default "/ip4/127.0.0.1/tcp/5001")))
2787
2788(define %ipfs-home "/var/lib/ipfs")
2789
2790(define %ipfs-accounts
2791 (list (user-account
2792 (name "ipfs")
2793 (group "ipfs")
2794 (system? #t)
2795 (comment "IPFS daemon user")
2796 (home-directory "/var/lib/ipfs")
2797 (shell (file-append shadow "/sbin/nologin")))
2798 (user-group
2799 (name "ipfs")
2800 (system? #t))))
2801
2802(define (ipfs-binary config)
2803 (define command
2804 (file-append (ipfs-configuration-package config) "/bin/ipfs"))
2805
2806 (least-authority-wrapper
2807 command
2808 #:name "ipfs"
2809 #:mappings (list %ipfs-home-mapping)
2810 #:namespaces (delq 'net %namespaces)))
2811
2812(define %ipfs-home-mapping
2813 (file-system-mapping
2814 (source %ipfs-home)
2815 (target %ipfs-home)
2816 (writable? #t)))
2817
2818(define %ipfs-environment
2819 #~(list #$(string-append "HOME=" %ipfs-home)))
2820
2821(define (ipfs-shepherd-service config)
2822 "Return a <shepherd-service> for IPFS with CONFIG."
2823 (define ipfs-daemon-command
2824 #~(list #$(ipfs-binary config) "daemon"))
2825
2826 (list (shepherd-service
2827 (provision '(ipfs))
2828 ;; While IPFS is most useful when the machine is connected
2829 ;; to the network, only loopback is required for starting
2830 ;; the service.
2831 (requirement '(user-processes loopback))
2832 (documentation "Connect to the IPFS network")
2833 (start #~(make-forkexec-constructor
2834 #$ipfs-daemon-command
2835 #:log-file "/var/log/ipfs.log"
2836 #:user "ipfs" #:group "ipfs"
2837 #:environment-variables #$%ipfs-environment))
2838 (stop #~(make-kill-destructor)))))
2839
2840(define (%ipfs-activation config)
2841 "Return an activation gexp for IPFS with CONFIG"
2842 (define (exec-command . args)
2843 ;; Exec the given ifps command with the right authority.
2844 #~(let ((pid (primitive-fork)))
2845 (if (zero? pid)
2846 (dynamic-wind
2847 (const #t)
2848 (lambda ()
2849 ;; Run ipfs init and ipfs config from a container,
2850 ;; in case the IPFS daemon was compromised at some point
2851 ;; and ~/.ipfs is now a symlink to somewhere outside
2852 ;; %ipfs-home.
2853 (let ((pw (getpwnam "ipfs")))
2854 (setgroups '#())
2855 (setgid (passwd:gid pw))
2856 (setuid (passwd:uid pw))
2857 (environ #$%ipfs-environment)
2858 (execl #$(ipfs-binary config) #$@args)))
2859 (lambda ()
2860 (primitive-exit 127)))
2861 (waitpid pid))))
2862
2863 (define settings
2864 `(("Addresses.API" ,(ipfs-configuration-api config))
2865 ("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
2866
2867 (define inner-gexp
2868 #~(begin
2869 (umask #o077)
2870 ;; Create $HOME/.ipfs structure
2871 #$(exec-command "ipfs" "init")
2872 ;; Apply settings
2873 #$@(map (match-lambda
2874 ((setting value)
2875 (exec-command "ipfs" "config" setting value)))
2876 settings)))
2877
2878 (define inner-script
2879 (program-file "ipfs-activation-inner" inner-gexp))
2880
2881 ;; The activation may happen from the initrd, which uses
2882 ;; a statically-linked guile, while the guix container
2883 ;; procedures require a working dynamic-link.
2884 #~(system* #$inner-script))
2885
2886(define ipfs-service-type
2887 (service-type
2888 (name 'ipfs)
2889 (extensions
2890 (list (service-extension account-service-type
2891 (const %ipfs-accounts))
2892 (service-extension activation-service-type
2893 %ipfs-activation)
2894 (service-extension shepherd-root-service-type
2895 ipfs-shepherd-service)))
2896 (default-value (ipfs-configuration))
2897 (description
2898 "Run @command{ipfs daemon}, the reference implementation
2899of the IPFS peer-to-peer storage network.")))
2900
2901
2902;;;
2903;;; Keepalived
2904;;;
2905
2906(define-record-type* <keepalived-configuration>
2907 keepalived-configuration make-keepalived-configuration
2908 keepalived-configuration?
2909 (keepalived keepalived-configuration-keepalived ;file-like
2910 (default keepalived))
2911 (config-file keepalived-configuration-config-file ;file-like
2912 (default #f))
2913 (shepherd-requirement keepalived-configuration-shepherd-requirement
2914 (default '(networking user-processes))))
2915
2916(define (keepalived-shepherd-service config)
2917 (match-record config <keepalived-configuration>
2918 (keepalived config-file shepherd-requirement)
2919 (list (shepherd-service
2920 (provision '(keepalived))
2921 (documentation "Run keepalived.")
2922 (requirement shepherd-requirement)
2923 (start #~(make-forkexec-constructor
2924 (list (string-append #$keepalived "/sbin/keepalived")
2925 "--dont-fork" "--log-console" "--log-detail"
2926 "--pid=/var/run/keepalived.pid"
2927 (string-append "--use-file=" #$config-file))
2928 #:pid-file "/var/run/keepalived.pid"
2929 #:log-file "/var/log/keepalived.log"))
2930 (respawn? #f)
2931 (stop #~(make-kill-destructor))))))
2932
2933(define keepalived-service-type
2934 (service-type (name 'keepalived)
2935 (extensions (list (service-extension shepherd-root-service-type
2936 keepalived-shepherd-service)))
2937 (description
2938 "Run @uref{https://www.keepalived.org/, Keepalived}
2939routing software.")))
2940
2941;;; networking.scm ends here