services: tor: Add control-socket? option.
[jackhill/guix/guix.git] / gnu / services / networking.scm
index 348dc36..231a9f6 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>
@@ -13,6 +13,9 @@
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +36,7 @@
   #: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)
@@ -40,6 +44,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)
@@ -59,7 +64,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
             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
+
+            keepalived-configuration
+            keepalived-configuration?
+            keepalived-service-type))
 
 ;;; Commentary:
 ;;;
@@ -263,7 +284,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
@@ -538,9 +561,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)
 
@@ -572,8 +593,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)))
@@ -585,10 +605,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.
@@ -728,7 +745,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.
@@ -750,7 +769,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))
@@ -770,6 +790,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) ...)
@@ -1161,7 +1186,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
@@ -1321,7 +1347,7 @@ whatever the thing is supposed to do).")))
   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
                       (default wpa-supplicant))
   (requirement        wpa-supplicant-configuration-requirement    ;list of symbols
-                      (default '(user-processes dbus-system loopback syslogd)))
+                      (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
@@ -1340,7 +1366,9 @@ whatever the thing is supposed to do).")))
      (list (shepherd-service
             (documentation "Run the WPA supplicant daemon")
             (provision '(wpa-supplicant))
-            (requirement requirement)
+            (requirement (if dbus?
+                             (cons 'dbus-system requirement)
+                             requirement))
             (start #~(make-forkexec-constructor
                       (list (string-append #$wpa-supplicant
                                            "/sbin/wpa_supplicant")
@@ -1442,10 +1470,10 @@ simulation."
   (append (hostapd-shepherd-services config
                                      #:requirement
                                      '(unblocked-wifi
-                                       mac-simulation-module))
+                                       kernel-module-loader))
           (list (shepherd-service
                  (provision '(unblocked-wifi))
-                 (requirement '(file-systems mac-simulation-module))
+                 (requirement '(file-systems kernel-module-loader))
                  (documentation
                   "Unblock WiFi devices for use by mac80211_hwsim.")
                  (start #~(lambda _
@@ -1453,21 +1481,6 @@ simulation."
                                     "unblock" "0")
                             (invoke #$(file-append util-linux "/sbin/rfkill")
                                     "unblock" "1")))
-                 (one-shot? #t))
-                (shepherd-service
-                 (provision '(mac-simulation-module))
-                 (requirement '(file-systems))
-                 (modules '((guix build utils)))
-                 (documentation
-                  "Load the mac80211_hwsim Linux kernel module.")
-                 (start (with-imported-modules '((guix build utils))
-                          #~(lambda _
-                              ;; XXX: We can't use 'load-linux-module*' here because it
-                              ;; expects a flat module directory.
-                              (setenv "LINUX_MODULE_DIRECTORY"
-                                      "/run/booted-system/kernel/lib/modules")
-                              (invoke #$(file-append kmod "/bin/modprobe")
-                                      "mac80211_hwsim"))))
                  (one-shot? #t)))))
 
 (define simulated-wifi-service-type
@@ -1475,7 +1488,9 @@ simulation."
    (name 'simulated-wifi)
    (extensions
     (list (service-extension shepherd-root-service-type
-                             simulated-wifi-shepherd-services)))
+                             simulated-wifi-shepherd-services)
+          (service-extension kernel-module-loader-service-type
+                             (const '("mac80211_hwsim")))))
    (default-value (hostapd-configuration
                    (interface "wlan1")
                    (ssid "Test Network")))
@@ -1758,4 +1773,146 @@ 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
+;;;
+;;; 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