X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/e52b953434b255f53e61125c7fd3653adcebdab8..c135096b23634595206a65ceef4cfdd3599f2656:/gnu/services/networking.scm diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 93d9b6a15e..761820ad2e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver -;;; Copyright © 2016, 2018 Efraim Flashner +;;; Copyright © 2016, 2018, 2020 Efraim Flashner ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2017 Thomas Danckaert @@ -12,6 +12,11 @@ ;;; Copyright © 2019 Florian Pelz ;;; Copyright © 2019 Maxim Cournoyer ;;; Copyright © 2019 Sou Bunnbu +;;; Copyright © 2019 Alex Griffin +;;; Copyright © 2020 Brice Waegeneire +;;; Copyright © 2021 Oleg Pykhalov +;;; Copyright © 2021 Christopher Lemmer Webber +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +36,8 @@ (define-module (gnu services networking) #:use-module (gnu services) #:use-module (gnu services base) + #:use-module (gnu services configuration) + #:use-module (gnu services linux) #:use-module (gnu services shepherd) #:use-module (gnu services dbus) #:use-module (gnu system shadow) @@ -38,6 +45,7 @@ #:use-module (gnu packages admin) #:use-module (gnu packages base) #:use-module (gnu packages bash) + #:use-module (gnu packages cluster) #:use-module (gnu packages connman) #:use-module (gnu packages freedesktop) #:use-module (gnu packages linux) @@ -48,6 +56,8 @@ #:use-module (gnu packages ntp) #:use-module (gnu packages wicd) #:use-module (gnu packages gnome) + #:use-module (gnu packages ipfs) + #:use-module (gnu build linux-container) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix modules) @@ -57,7 +67,9 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-43) #:use-module (ice-9 match) + #:use-module (json) #:re-export (static-networking-service static-networking-service-type) #:export (%facebook-host-aliases @@ -128,10 +140,10 @@ usb-modeswitch-configuration-usb-modeswitch-data usb-modeswitch-service-type - wpa-supplicant-configuration wpa-supplicant-configuration? wpa-supplicant-configuration-wpa-supplicant + wpa-supplicant-configuration-requirement wpa-supplicant-configuration-pid-file wpa-supplicant-configuration-dbus? wpa-supplicant-configuration-interface @@ -139,6 +151,18 @@ wpa-supplicant-configuration-extra-options wpa-supplicant-service-type + hostapd-configuration + hostapd-configuration? + hostapd-configuration-package + hostapd-configuration-interface + hostapd-configuration-ssid + hostapd-configuration-broadcast-ssid? + hostapd-configuration-channel + hostapd-configuration-driver + hostapd-service-type + + simulated-wifi-service-type + openvswitch-service-type openvswitch-configuration @@ -154,7 +178,38 @@ nftables-configuration? nftables-configuration-package nftables-configuration-ruleset - %default-nftables-ruleset)) + %default-nftables-ruleset + + pagekite-service-type + pagekite-configuration + pagekite-configuration? + pagekite-configuration-package + pagekite-configuration-kitename + pagekite-configuration-kitesecret + pagekite-configuration-frontend + pagekite-configuration-kites + pagekite-configuration-extra-file + + yggdrasil-service-type + yggdrasil-configuration + yggdrasil-configuration? + yggdrasil-configuration-autoconf? + yggdrasil-configuration-config-file + yggdrasil-configuration-log-level + yggdrasil-configuration-log-to + yggdrasil-configuration-json-config + yggdrasil-configuration-package + + ipfs-service-type + ipfs-configuration + ipfs-configuration? + ipfs-configuration-package + ipfs-configuration-gateway + ipfs-configuration-api + + keepalived-configuration + keepalived-configuration? + keepalived-service-type)) ;;; Commentary: ;;; @@ -223,14 +278,15 @@ fe80::1%lo0 apps.facebook.com\n") (define valid? (lambda (interface) (and (arp-network-interface? interface) - (not (loopback-network-interface? interface))))) + (not (loopback-network-interface? interface)) + ;; XXX: Make sure the interfaces are up so that + ;; 'dhclient' can actually send/receive over them. + ;; Ignore those that cannot be activated. + (false-if-exception + (set-network-interface-up interface))))) (define ifaces (filter valid? (all-network-interface-names))) - ;; XXX: Make sure the interfaces are up so that 'dhclient' can - ;; actually send/receive over them. - (for-each set-network-interface-up ifaces) - (false-if-exception (delete-file #$pid-file)) (let ((pid (fork+exec-command (cons* #$dhclient "-nw" @@ -238,7 +294,9 @@ fe80::1%lo0 apps.facebook.com\n") (and (zero? (cdr (waitpid pid))) (read-pid-file #$pid-file))))) (stop #~(make-kill-destructor)))) - isc-dhcp)) + isc-dhcp + (description "Run @command{dhcp}, a Dynamic Host Configuration +Protocol (DHCP) client, on all the non-loopback network interfaces."))) (define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp)) dhcp-client-service-type @@ -301,7 +359,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." (with-output-to-file #$lease-file (lambda _ (display "")))) ;; Validate the config. - (invoke + (invoke/quiet #$(file-append package "/sbin/dhcpd") "-t" "-cf" #$config-file)))))) @@ -310,7 +368,9 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." (name 'dhcpd) (extensions (list (service-extension shepherd-root-service-type dhcpd-shepherd-service) - (service-extension activation-service-type dhcpd-activation))))) + (service-extension activation-service-type dhcpd-activation))) + (description "Run a DHCP (Dynamic Host Configuration Protocol) daemon. The +daemon is responsible for allocating IP addresses to its client."))) ;;; @@ -345,7 +405,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces." (res '())) (if (list? x) (fold loop res x) - (cons (format #f "~s" x) res))))) + (cons (format #f "~a" x) res))))) (match ntp-server (($ type address options) @@ -394,15 +454,16 @@ deprecated. Please use records instead.\n") ntp-servers)))) (define ntp-shepherd-service - (match-lambda - (($ ntp servers allow-large-adjustment?) - (let () - ;; TODO: Add authentication support. - (define config - (string-append "driftfile /var/run/ntpd/ntp.drift\n" - (string-join (map ntp-server->string servers) - "\n") - " + (lambda (config) + (match config + (($ ntp servers allow-large-adjustment?) + (let ((servers (ntp-configuration-servers config))) + ;; TODO: Add authentication support. + (define config + (string-append "driftfile /var/run/ntpd/ntp.drift\n" + (string-join (map ntp-server->string servers) + "\n") + " # Disable status queries as a workaround for CVE-2013-5211: # . restrict default kod nomodify notrap nopeer noquery limited @@ -416,20 +477,20 @@ restrict -6 ::1 # option by default, as documented in the 'ntp.conf' manual. restrict source notrap nomodify noquery\n")) - (define ntpd.conf - (plain-file "ntpd.conf" config)) + (define ntpd.conf + (plain-file "ntpd.conf" config)) - (list (shepherd-service - (provision '(ntpd)) - (documentation "Run the Network Time Protocol (NTP) daemon.") - (requirement '(user-processes networking)) - (start #~(make-forkexec-constructor - (list (string-append #$ntp "/bin/ntpd") "-n" - "-c" #$ntpd.conf "-u" "ntpd" - #$@(if allow-large-adjustment? - '("-g") - '())))) - (stop #~(make-kill-destructor)))))))) + (list (shepherd-service + (provision '(ntpd)) + (documentation "Run the Network Time Protocol (NTP) daemon.") + (requirement '(user-processes networking)) + (start #~(make-forkexec-constructor + (list (string-append #$ntp "/bin/ntpd") "-n" + "-c" #$ntpd.conf "-u" "ntpd" + #$@(if allow-large-adjustment? + '("-g") + '())))) + (stop #~(make-kill-destructor))))))))) (define %ntp-accounts (list (user-account @@ -510,9 +571,7 @@ make an initial adjustment of more than 1,000 seconds." (constraint-from openntpd-constraint-from (default '())) (constraints-from openntpd-constraints-from - (default '())) - (allow-large-adjustment? openntpd-allow-large-adjustment? - (default #f))) ; upstream default + (default '()))) (define (openntpd-configuration->string config) @@ -544,8 +603,7 @@ make an initial adjustment of more than 1,000 seconds." "\n"))) ;add a trailing newline (define (openntpd-shepherd-service config) - (let ((openntpd (openntpd-configuration-openntpd config)) - (allow-large-adjustment? (openntpd-allow-large-adjustment? config))) + (let ((openntpd (openntpd-configuration-openntpd config))) (define ntpd.conf (plain-file "ntpd.conf" (openntpd-configuration->string config))) @@ -557,10 +615,7 @@ make an initial adjustment of more than 1,000 seconds." (start #~(make-forkexec-constructor (list (string-append #$openntpd "/sbin/ntpd") "-f" #$ntpd.conf - "-d" ;; don't daemonize - #$@(if allow-large-adjustment? - '("-s") - '())) + "-d") ;; don't daemonize ;; When ntpd is daemonized it repeatedly tries to respawn ;; while running, leading shepherd to disable it. To ;; prevent spamming stderr, redirect output to logfile. @@ -700,7 +755,9 @@ demand."))) (hidden-services tor-configuration-hidden-services (default '())) (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix - (default 'tcp))) + (default 'tcp)) + (control-socket? tor-control-socket-path + (default #f))) (define %tor-accounts ;; User account and groups for Tor. @@ -722,7 +779,8 @@ demand."))) (define (tor-configuration->torrc config) "Return a 'torrc' file for CONFIG." (match config - (($ tor config-file services socks-socket-type) + (($ tor config-file services + socks-socket-type control-socket?) (computed-file "torrc" (with-imported-modules '((guix build utils)) @@ -742,6 +800,11 @@ Log notice syslog\n" port) (display "\ SocksPort unix:/var/run/tor/socks-sock UnixSocksGroupWritable 1\n" port)) + (when #$control-socket? + (display "\ +ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck +ControlSocketsGroupWritable 1\n" + port)) (for-each (match-lambda ((service (ports hosts) ...) @@ -1133,7 +1196,8 @@ wireless networking.")))) (start #~(make-forkexec-constructor (list (string-append #$connman "/sbin/connmand") - "-n" "-r" + "--nodaemon" + "--nodnsproxy" #$@(if disable-vpn? '("--noplugin=vpn") '())) ;; As connman(8) notes, when passing '-n', connman @@ -1292,6 +1356,8 @@ whatever the thing is supposed to do)."))) wpa-supplicant-configuration? (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ; (default wpa-supplicant)) + (requirement wpa-supplicant-configuration-requirement ;list of symbols + (default '(user-processes loopback syslogd))) (pid-file wpa-supplicant-configuration-pid-file ;string (default "/var/run/wpa_supplicant.pid")) (dbus? wpa-supplicant-configuration-dbus? ;Boolean @@ -1305,12 +1371,14 @@ whatever the thing is supposed to do)."))) (define wpa-supplicant-shepherd-service (match-lambda - (($ wpa-supplicant pid-file dbus? interface - config-file extra-options) + (($ wpa-supplicant requirement pid-file dbus? + interface config-file extra-options) (list (shepherd-service (documentation "Run the WPA supplicant daemon") (provision '(wpa-supplicant)) - (requirement '(user-processes dbus-system loopback syslogd)) + (requirement (if dbus? + (cons 'dbus-system requirement) + requirement)) (start #~(make-forkexec-constructor (list (string-append #$wpa-supplicant "/sbin/wpa_supplicant") @@ -1346,6 +1414,99 @@ implements authentication, key negotiation and more for wireless networks.") (default-value (wpa-supplicant-configuration))))) +;;; +;;; Hostapd. +;;; + +(define-record-type* + hostapd-configuration make-hostapd-configuration + hostapd-configuration? + (package hostapd-configuration-package + (default hostapd)) + (interface hostapd-configuration-interface ;string + (default "wlan0")) + (ssid hostapd-configuration-ssid) ;string + (broadcast-ssid? hostapd-configuration-broadcast-ssid? ;Boolean + (default #t)) + (channel hostapd-configuration-channel ;integer + (default 1)) + (driver hostapd-configuration-driver ;string + (default "nl80211")) + ;; See for a list of + ;; additional options we could add. + (extra-settings hostapd-configuration-extra-settings ;string + (default ""))) + +(define (hostapd-configuration-file config) + "Return the configuration file for CONFIG, a ." + (match-record config + (interface ssid broadcast-ssid? channel driver extra-settings) + (plain-file "hostapd.conf" + (string-append "\ +# Generated from your Guix configuration. + +interface=" interface " +ssid=" ssid " +ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") " +channel=" (number->string channel) "\n" +extra-settings "\n")))) + +(define* (hostapd-shepherd-services config #:key (requirement '())) + "Return Shepherd services for hostapd." + (list (shepherd-service + (provision '(hostapd)) + (requirement `(user-processes ,@requirement)) + (documentation "Run the hostapd WiFi access point daemon.") + (start #~(make-forkexec-constructor + (list #$(file-append hostapd "/sbin/hostapd") + #$(hostapd-configuration-file config)) + #:log-file "/var/log/hostapd.log")) + (stop #~(make-kill-destructor))))) + +(define hostapd-service-type + (service-type + (name 'hostapd) + (extensions + (list (service-extension shepherd-root-service-type + hostapd-shepherd-services))) + (description + "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access +points and authentication servers."))) + +(define (simulated-wifi-shepherd-services config) + "Return Shepherd services to run hostapd with CONFIG, a +, as well as services to set up WiFi hardware +simulation." + (append (hostapd-shepherd-services config + #:requirement + '(unblocked-wifi + kernel-module-loader)) + (list (shepherd-service + (provision '(unblocked-wifi)) + (requirement '(file-systems kernel-module-loader)) + (documentation + "Unblock WiFi devices for use by mac80211_hwsim.") + (start #~(lambda _ + (invoke #$(file-append util-linux "/sbin/rfkill") + "unblock" "0") + (invoke #$(file-append util-linux "/sbin/rfkill") + "unblock" "1"))) + (one-shot? #t))))) + +(define simulated-wifi-service-type + (service-type + (name 'simulated-wifi) + (extensions + (list (service-extension shepherd-root-service-type + simulated-wifi-shepherd-services) + (service-extension kernel-module-loader-service-type + (const '("mac80211_hwsim"))))) + (default-value (hostapd-configuration + (interface "wlan1") + (ssid "Test Network"))) + (description "Run hostapd to simulate WiFi connectivity."))) + + ;;; ;;; Open vSwitch ;;; @@ -1526,4 +1687,373 @@ table inet filter { (compose list nftables-configuration-package)))) (default-value (nftables-configuration)))) + +;;; +;;; PageKite +;;; + +(define-record-type* + pagekite-configuration + make-pagekite-configuration + pagekite-configuration? + (package pagekite-configuration-package + (default pagekite)) + (kitename pagekite-configuration-kitename + (default #f)) + (kitesecret pagekite-configuration-kitesecret + (default #f)) + (frontend pagekite-configuration-frontend + (default #f)) + (kites pagekite-configuration-kites + (default '("http:@kitename:localhost:80:@kitesecret"))) + (extra-file pagekite-configuration-extra-file + (default #f))) + +(define (pagekite-configuration-file config) + (match-record config + (package kitename kitesecret frontend kites extra-file) + (mixed-text-file "pagekite.rc" + (if extra-file + (string-append "optfile = " extra-file "\n") + "") + (if kitename + (string-append "kitename = " kitename "\n") + "") + (if kitesecret + (string-append "kitesecret = " kitesecret "\n") + "") + (if frontend + (string-append "frontend = " frontend "\n") + "defaults\n") + (string-join (map (lambda (kite) + (string-append "service_on = " kite)) + kites) + "\n" + 'suffix)))) + +(define (pagekite-shepherd-service config) + (match-record config + (package kitename kitesecret frontend kites extra-file) + (with-imported-modules (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + (shepherd-service + (documentation "Run the PageKite service.") + (provision '(pagekite)) + (requirement '(networking)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start #~(make-forkexec-constructor/container + (list #$(file-append package "/bin/pagekite") + "--clean" + "--nullui" + "--nocrashreport" + "--runas=pagekite:pagekite" + (string-append "--optfile=" + #$(pagekite-configuration-file config))) + #:log-file "/var/log/pagekite.log" + #:mappings #$(if extra-file + #~(list (file-system-mapping + (source #$extra-file) + (target source))) + #~'()))) + ;; SIGTERM doesn't always work for some reason. + (stop #~(make-kill-destructor SIGINT)))))) + +(define %pagekite-accounts + (list (user-group (name "pagekite") (system? #t)) + (user-account + (name "pagekite") + (group "pagekite") + (system? #t) + (comment "PageKite user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define pagekite-service-type + (service-type + (name 'pagekite) + (default-value (pagekite-configuration)) + (extensions + (list (service-extension shepherd-root-service-type + (compose list pagekite-shepherd-service)) + (service-extension account-service-type + (const %pagekite-accounts)))) + (description + "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make +local servers publicly accessible on the web, even behind NATs and firewalls."))) + + +;;; +;;; Yggdrasil +;;; + +(define-record-type* + yggdrasil-configuration + make-yggdrasil-configuration + yggdrasil-configuration? + (package yggdrasil-configuration-package + (default yggdrasil)) + (json-config yggdrasil-configuration-json-config + (default '())) + (config-file yggdrasil-config-file + (default "/etc/yggdrasil-private.conf")) + (autoconf? yggdrasil-configuration-autoconf? + (default #f)) + (log-level yggdrasil-configuration-log-level + (default 'info)) + (log-to yggdrasil-configuration-log-to + (default 'stdout))) + +(define (yggdrasil-configuration-file config) + (define (scm->yggdrasil-json x) + (define key-value? + dotted-list?) + (define (param->camel str) + (string-concatenate + (map + string-capitalize + (string-split str (cut eqv? <> #\-))))) + (cond + ((key-value? x) + (let ((k (car x)) + (v (cdr x))) + (cons + (if (symbol? k) + (param->camel (symbol->string k)) + k) + v))) + ((list? x) (map scm->yggdrasil-json x)) + ((vector? x) (vector-map scm->yggdrasil-json x)) + (else x))) + (computed-file + "yggdrasil.conf" + #~(call-with-output-file #$output + (lambda (port) + ;; it's HJSON, so comments are a-okay + (display "# Generated by yggdrasil-service\n" port) + (display #$(scm->json-string + (scm->yggdrasil-json + (yggdrasil-configuration-json-config config))) + port))))) + +(define (yggdrasil-shepherd-service config) + "Return a for yggdrasil with CONFIG." + (define yggdrasil-command + #~(append + (list (string-append + #$(yggdrasil-configuration-package config) + "/bin/yggdrasil") + "-useconffile" + #$(yggdrasil-configuration-file config)) + (if #$(yggdrasil-configuration-autoconf? config) + '("-autoconf") + '()) + (let ((extraconf #$(yggdrasil-config-file config))) + (if extraconf + (list "-extraconffile" extraconf) + '())) + (list "-loglevel" + #$(symbol->string + (yggdrasil-configuration-log-level config)) + "-logto" + #$(symbol->string + (yggdrasil-configuration-log-to config))))) + (list (shepherd-service + (documentation "Connect to the Yggdrasil mesh network") + (provision '(yggdrasil)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + #$yggdrasil-command + #:log-file "/var/log/yggdrasil.log" + #:group "yggdrasil")) + (stop #~(make-kill-destructor))))) + +(define %yggdrasil-accounts + (list (user-group (name "yggdrasil") (system? #t)))) + +(define yggdrasil-service-type + (service-type + (name 'yggdrasil) + (description + "Connect to the Yggdrasil mesh network. +See yggdrasil -genconf for config options.") + (extensions + (list (service-extension shepherd-root-service-type + yggdrasil-shepherd-service) + (service-extension account-service-type + (const %yggdrasil-accounts)) + (service-extension profile-service-type + (compose list yggdrasil-configuration-package)))))) + + +;;; +;;; IPFS +;;; + +(define-record-type* + ipfs-configuration + make-ipfs-configuration + ipfs-configuration? + (package ipfs-configuration-package + (default go-ipfs)) + (gateway ipfs-configuration-gateway + (default "/ip4/127.0.0.1/tcp/8082")) + (api ipfs-configuration-api + (default "/ip4/127.0.0.1/tcp/5001"))) + +(define %ipfs-home "/var/lib/ipfs") + +(define %ipfs-accounts + (list (user-account + (name "ipfs") + (group "ipfs") + (system? #t) + (comment "IPFS daemon user") + (home-directory "/var/lib/ipfs") + (shell (file-append shadow "/sbin/nologin"))) + (user-group + (name "ipfs") + (system? #t)))) + +(define (ipfs-binary config) + (file-append (ipfs-configuration-package config) "/bin/ipfs")) + +(define %ipfs-home-mapping + #~(file-system-mapping + (source #$%ipfs-home) + (target #$%ipfs-home) + (writable? #t))) + +(define %ipfs-environment + #~(list #$(string-append "HOME=" %ipfs-home))) + +(define (ipfs-shepherd-service config) + "Return a for IPFS with CONFIG." + (define ipfs-daemon-command + #~(list #$(ipfs-binary config) "daemon")) + (list + (with-imported-modules (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + (shepherd-service + (provision '(ipfs)) + ;; While IPFS is most useful when the machine is connected + ;; to the network, only loopback is required for starting + ;; the service. + (requirement '(loopback)) + (documentation "Connect to the IPFS network") + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start #~(make-forkexec-constructor/container + #$ipfs-daemon-command + #:namespaces '#$(fold delq %namespaces '(user net)) + #:mappings (list #$%ipfs-home-mapping) + #:log-file "/var/log/ipfs.log" + #:user "ipfs" + #:group "ipfs" + #:environment-variables #$%ipfs-environment)) + (stop #~(make-kill-destructor)))))) + +(define (%ipfs-activation config) + "Return an activation gexp for IPFS with CONFIG" + (define (ipfs-config-command setting value) + #~(#$(ipfs-binary config) "config" #$setting #$value)) + (define (set-config!-gexp setting value) + #~(system* #$@(ipfs-config-command setting value))) + (define settings + `(("Addresses.API" ,(ipfs-configuration-api config)) + ("Addresses.Gateway" ,(ipfs-configuration-gateway config)))) + (define inner-gexp + #~(begin + (umask #o077) + ;; Create $HOME/.ipfs structure + (system* #$(ipfs-binary config) "init") + ;; Apply settings + #$@(map (cute apply set-config!-gexp <>) settings))) + (define inner-script + (program-file "ipfs-activation-inner" inner-gexp)) + ;; Run ipfs init and ipfs config from a container, + ;; in case the IPFS daemon was compromised at some point + ;; and ~/.ipfs is now a symlink to somewhere outside + ;; %ipfs-home. + (define container-gexp + (with-extensions (list shepherd) + (with-imported-modules (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + #~(begin + (use-modules (gnu build shepherd) + (gnu system file-systems)) + (let* ((constructor + (make-forkexec-constructor/container + (list #$inner-script) + #:namespaces '#$(fold delq %namespaces '(user)) + #:mappings (list #$%ipfs-home-mapping) + #:user "ipfs" + #:group "ipfs" + #:environment-variables #$%ipfs-environment)) + (pid (constructor))) + (waitpid pid)))))) + ;; The activation may happen from the initrd, which uses + ;; a statically-linked guile, while the guix container + ;; procedures require a working dynamic-link. + (define container-script + (program-file "ipfs-activation-container" container-gexp)) + #~(system* #$container-script)) + +(define ipfs-service-type + (service-type + (name 'ipfs) + (extensions + (list (service-extension account-service-type + (const %ipfs-accounts)) + (service-extension activation-service-type + %ipfs-activation) + (service-extension shepherd-root-service-type + ipfs-shepherd-service))) + (default-value (ipfs-configuration)) + (description + "Run @command{ipfs daemon}, the reference implementation +of the IPFS peer-to-peer storage network."))) + + +;;; +;;; Keepalived +;;; + +(define-record-type* + keepalived-configuration make-keepalived-configuration + keepalived-configuration? + (keepalived keepalived-configuration-keepalived ; + (default keepalived)) + (config-file keepalived-configuration-config-file ;file-like + (default #f))) + +(define keepalived-shepherd-service + (match-lambda + (($ keepalived config-file) + (list + (shepherd-service + (provision '(keepalived)) + (documentation "Run keepalived.") + (requirement '(loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$keepalived "/sbin/keepalived") + "--dont-fork" "--log-console" "--log-detail" + "--pid=/var/run/keepalived.pid" + (string-append "--use-file=" #$config-file)) + #:pid-file "/var/run/keepalived.pid" + #:log-file "/var/log/keepalived.log")) + (respawn? #f) + (stop #~(make-kill-destructor))))))) + +(define keepalived-service-type + (service-type (name 'keepalived) + (extensions (list (service-extension shepherd-root-service-type + keepalived-shepherd-service))) + (description + "Run @uref{https://www.keepalived.org/, Keepalived} +routing software."))) + ;;; networking.scm ends here