services: Add ipfs-service-type
[jackhill/guix/guix.git] / gnu / services / networking.scm
index 618dd95..6e93b56 100644 (file)
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,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)
@@ -39,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)
@@ -49,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)
@@ -58,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
             usb-modeswitch-configuration-usb-modeswitch-data
             usb-modeswitch-service-type
 
-            <wpa-supplicant-configuration>
             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
             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
 
             pagekite-configuration-kitesecret
             pagekite-configuration-frontend
             pagekite-configuration-kites
-            pagekite-configuration-extra-file))
+            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:
 ;;;
@@ -250,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
@@ -322,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.")))
 
 \f
 ;;;
@@ -523,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)
 
@@ -557,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)))
@@ -570,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.
@@ -713,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.
@@ -735,7 +779,8 @@ demand.")))
 (define (tor-configuration->torrc config)
   "Return a 'torrc' file for CONFIG."
   (match config
-    (($ <tor-configuration> tor config-file services socks-socket-type)
+    (($ <tor-configuration> tor config-file services
+                            socks-socket-type control-socket?)
      (computed-file
       "torrc"
       (with-imported-modules '((guix build utils))
@@ -755,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) ...)
@@ -1146,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
@@ -1305,6 +1356,8 @@ whatever the thing is supposed to do).")))
   wpa-supplicant-configuration?
   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
                       (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
@@ -1318,12 +1371,14 @@ whatever the thing is supposed to do).")))
 
 (define wpa-supplicant-shepherd-service
   (match-lambda
-    (($ <wpa-supplicant-configuration> wpa-supplicant pid-file dbus? interface
-                                       config-file extra-options)
+    (($ <wpa-supplicant-configuration> 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")
@@ -1359,6 +1414,99 @@ implements authentication, key negotiation and more for wireless networks.")
                   (default-value (wpa-supplicant-configuration)))))
 
 \f
+;;;
+;;; Hostapd.
+;;;
+
+(define-record-type* <hostapd-configuration>
+  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 <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> 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 <hostapd-configuration>."
+  (match-record config <hostapd-configuration>
+    (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
+<hostapd-configuration>, 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.")))
+
+\f
 ;;;
 ;;; Open vSwitch
 ;;;
@@ -1635,4 +1783,277 @@ table inet filter {
     "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
 local servers publicly accessible on the web, even behind NATs and firewalls.")))
 
+\f
+;;;
+;;; Yggdrasil
+;;;
+
+(define-record-type* <yggdrasil-configuration>
+  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 <shepherd-service> 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))))))
+
+\f
+;;;
+;;; IPFS
+;;;
+
+(define-record-type* <ipfs-configuration>
+  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 <shepherd-service> 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 p2p storage network.")))
+
+\f
+;;;
+;;; Keepalived
+;;;
+
+(define-record-type* <keepalived-configuration>
+  keepalived-configuration make-keepalived-configuration
+  keepalived-configuration?
+  (keepalived  keepalived-configuration-keepalived  ;<package>
+               (default keepalived))
+  (config-file keepalived-configuration-config-file ;file-like
+               (default #f)))
+
+(define keepalived-shepherd-service
+  (match-lambda
+    (($ <keepalived-configuration> 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