gnu/services/networking.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
   5 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
   6 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   7 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
   8 ;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
   9 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
  10 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
  11 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
  12 ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
  13 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
  14 ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
  15 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
  16 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
  17 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
  18 ;;;
  19 ;;; This file is part of GNU Guix.
  20 ;;;
  21 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  22 ;;; under the terms of the GNU General Public License as published by
  23 ;;; the Free Software Foundation; either version 3 of the License, or (at
  24 ;;; your option) any later version.
  25 ;;;
  26 ;;; GNU Guix is distributed in the hope that it will be useful, but
  27 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  28 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  29 ;;; GNU General Public License for more details.
  30 ;;;
  31 ;;; You should have received a copy of the GNU General Public License
  32 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  33
  34 (define-module (gnu services networking)
  35   #:use-module (gnu services)
  36   #:use-module (gnu services base)
  37   #:use-module (gnu services configuration)
  38   #:use-module (gnu services linux)
  39   #:use-module (gnu services shepherd)
  40   #:use-module (gnu services dbus)
  41   #:use-module (gnu system shadow)
  42   #:use-module (gnu system pam)
  43   #:use-module (gnu packages admin)
  44   #:use-module (gnu packages base)
  45   #:use-module (gnu packages bash)
  46   #:use-module (gnu packages cluster)
  47   #:use-module (gnu packages connman)
  48   #:use-module (gnu packages freedesktop)
  49   #:use-module (gnu packages linux)
  50   #:use-module (gnu packages tor)
  51   #:use-module (gnu packages usb-modeswitch)
  52   #:use-module (gnu packages messaging)
  53   #:use-module (gnu packages networking)
  54   #:use-module (gnu packages ntp)
  55   #:use-module (gnu packages wicd)
  56   #:use-module (gnu packages gnome)
  57   #:use-module (guix gexp)
  58   #:use-module (guix records)
  59   #:use-module (guix modules)
  60   #:use-module (guix packages)
  61   #:use-module (guix deprecation)
  62   #:use-module (rnrs enums)
  63   #:use-module (srfi srfi-1)
  64   #:use-module (srfi srfi-9)
  65   #:use-module (srfi srfi-26)
  66   #:use-module (srfi srfi-43)
  67   #:use-module (ice-9 match)
  68   #:use-module (json)
  69   #:re-export (static-networking-service
  70                static-networking-service-type)
  71   #:export (%facebook-host-aliases
  72             dhcp-client-service
  73             dhcp-client-service-type
  74
  75             dhcpd-service-type
  76             dhcpd-configuration
  77             dhcpd-configuration?
  78             dhcpd-configuration-package
  79             dhcpd-configuration-config-file
  80             dhcpd-configuration-version
  81             dhcpd-configuration-run-directory
  82             dhcpd-configuration-lease-file
  83             dhcpd-configuration-pid-file
  84             dhcpd-configuration-interfaces
  85
  86             ntp-configuration
  87             ntp-configuration?
  88             ntp-configuration-ntp
  89             ntp-configuration-servers
  90             ntp-allow-large-adjustment?
  91
  92             %ntp-servers
  93             ntp-server
  94             ntp-server-type
  95             ntp-server-address
  96             ntp-server-options
  97
  98             ntp-service
  99             ntp-service-type
 100
 101             %openntpd-servers
 102             openntpd-configuration
 103             openntpd-configuration?
 104             openntpd-service-type
 105
 106             inetd-configuration
 107             inetd-entry
 108             inetd-service-type
 109
 110             tor-configuration
 111             tor-configuration?
 112             tor-hidden-service
 113             tor-service
 114             tor-service-type
 115
 116             wicd-service-type
 117             wicd-service
 118
 119             network-manager-configuration
 120             network-manager-configuration?
 121             network-manager-configuration-dns
 122             network-manager-configuration-vpn-plugins
 123             network-manager-service-type
 124
 125             connman-configuration
 126             connman-configuration?
 127             connman-service-type
 128
 129             modem-manager-configuration
 130             modem-manager-configuration?
 131             modem-manager-service-type
 132
 133             usb-modeswitch-configuration
 134             usb-modeswitch-configuration?
 135             usb-modeswitch-configuration-usb-modeswitch
 136             usb-modeswitch-configuration-usb-modeswitch-data
 137             usb-modeswitch-service-type
 138
 139             wpa-supplicant-configuration
 140             wpa-supplicant-configuration?
 141             wpa-supplicant-configuration-wpa-supplicant
 142             wpa-supplicant-configuration-requirement
 143             wpa-supplicant-configuration-pid-file
 144             wpa-supplicant-configuration-dbus?
 145             wpa-supplicant-configuration-interface
 146             wpa-supplicant-configuration-config-file
 147             wpa-supplicant-configuration-extra-options
 148             wpa-supplicant-service-type
 149
 150             hostapd-configuration
 151             hostapd-configuration?
 152             hostapd-configuration-package
 153             hostapd-configuration-interface
 154             hostapd-configuration-ssid
 155             hostapd-configuration-broadcast-ssid?
 156             hostapd-configuration-channel
 157             hostapd-configuration-driver
 158             hostapd-service-type
 159
 160             simulated-wifi-service-type
 161
 162             openvswitch-service-type
 163             openvswitch-configuration
 164
 165             iptables-configuration
 166             iptables-configuration?
 167             iptables-configuration-iptables
 168             iptables-configuration-ipv4-rules
 169             iptables-configuration-ipv6-rules
 170             iptables-service-type
 171
 172             nftables-service-type
 173             nftables-configuration
 174             nftables-configuration?
 175             nftables-configuration-package
 176             nftables-configuration-ruleset
 177             %default-nftables-ruleset
 178
 179             pagekite-service-type
 180             pagekite-configuration
 181             pagekite-configuration?
 182             pagekite-configuration-package
 183             pagekite-configuration-kitename
 184             pagekite-configuration-kitesecret
 185             pagekite-configuration-frontend
 186             pagekite-configuration-kites
 187             pagekite-configuration-extra-file
 188
 189             yggdrasil-service-type
 190             yggdrasil-configuration
 191             yggdrasil-configuration?
 192             yggdrasil-configuration-autoconf?
 193             yggdrasil-configuration-config-file
 194             yggdrasil-configuration-log-level
 195             yggdrasil-configuration-log-to
 196             yggdrasil-configuration-json-config
 197             yggdrasil-configuration-package
 198
 199             keepalived-configuration
 200             keepalived-configuration?
 201             keepalived-service-type))
 202
 203 ;;; Commentary:
 204 ;;;
 205 ;;; Networking services.
 206 ;;;
 207 ;;; Code:
 208
 209 (define %facebook-host-aliases
 210   ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
 211   ;; are to block it.
 212   "\
 213 # Block Facebook IPv4.
 214 127.0.0.1   www.facebook.com
 215 127.0.0.1   facebook.com
 216 127.0.0.1   login.facebook.com
 217 127.0.0.1   www.login.facebook.com
 218 127.0.0.1   fbcdn.net
 219 127.0.0.1   www.fbcdn.net
 220 127.0.0.1   fbcdn.com
 221 127.0.0.1   www.fbcdn.com
 222 127.0.0.1   static.ak.fbcdn.net
 223 127.0.0.1   static.ak.connect.facebook.com
 224 127.0.0.1   connect.facebook.net
 225 127.0.0.1   www.connect.facebook.net
 226 127.0.0.1   apps.facebook.com
 227
 228 # Block Facebook IPv6.
 229 fe80::1%lo0 facebook.com
 230 fe80::1%lo0 login.facebook.com
 231 fe80::1%lo0 www.login.facebook.com
 232 fe80::1%lo0 fbcdn.net
 233 fe80::1%lo0 www.fbcdn.net
 234 fe80::1%lo0 fbcdn.com
 235 fe80::1%lo0 www.fbcdn.com
 236 fe80::1%lo0 static.ak.fbcdn.net
 237 fe80::1%lo0 static.ak.connect.facebook.com
 238 fe80::1%lo0 connect.facebook.net
 239 fe80::1%lo0 www.connect.facebook.net
 240 fe80::1%lo0 apps.facebook.com\n")
 241
 242 (define dhcp-client-service-type
 243   (shepherd-service-type
 244    'dhcp-client
 245    (lambda (dhcp)
 246      (define dhclient
 247        (file-append dhcp "/sbin/dhclient"))
 248
 249      (define pid-file
 250        "/var/run/dhclient.pid")
 251
 252      (shepherd-service
 253       (documentation "Set up networking via DHCP.")
 254       (requirement '(user-processes udev))
 255
 256       ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
 257       ;; networking is unavailable, but also means that the interface is not up
 258       ;; yet when 'start' completes.  To wait for the interface to be ready, one
 259       ;; should instead monitor udev events.
 260       (provision '(networking))
 261
 262       (start #~(lambda _
 263                  ;; When invoked without any arguments, 'dhclient' discovers all
 264                  ;; non-loopback interfaces *that are up*.  However, the relevant
 265                  ;; interfaces are typically down at this point.  Thus we perform
 266                  ;; our own interface discovery here.
 267                  (define valid?
 268                    (lambda (interface)
 269                      (and (arp-network-interface? interface)
 270                           (not (loopback-network-interface? interface))
 271                           ;; XXX: Make sure the interfaces are up so that
 272                           ;; 'dhclient' can actually send/receive over them.
 273                           ;; Ignore those that cannot be activated.
 274                           (false-if-exception
 275                            (set-network-interface-up interface)))))
 276                  (define ifaces
 277                    (filter valid? (all-network-interface-names)))
 278
 279                  (false-if-exception (delete-file #$pid-file))
 280                  (let ((pid (fork+exec-command
 281                              (cons* #$dhclient "-nw"
 282                                     "-pf" #$pid-file ifaces))))
 283                    (and (zero? (cdr (waitpid pid)))
 284                         (read-pid-file #$pid-file)))))
 285       (stop #~(make-kill-destructor))))
 286    isc-dhcp
 287    (description "Run @command{dhcp}, a Dynamic Host Configuration
 288 Protocol (DHCP) client, on all the non-loopback network interfaces.")))
 289
 290 (define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp))
 291   dhcp-client-service-type
 292   "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
 293 Protocol (DHCP) client, on all the non-loopback network interfaces."
 294   (service dhcp-client-service-type dhcp))
 295
 296 (define-record-type* <dhcpd-configuration>
 297   dhcpd-configuration make-dhcpd-configuration
 298   dhcpd-configuration?
 299   (package   dhcpd-configuration-package ;<package>
 300              (default isc-dhcp))
 301   (config-file   dhcpd-configuration-config-file ;file-like
 302                  (default #f))
 303   (version dhcpd-configuration-version ;"4", "6", or "4o6"
 304               (default "4"))
 305   (run-directory dhcpd-configuration-run-directory
 306                  (default "/run/dhcpd"))
 307   (lease-file dhcpd-configuration-lease-file
 308               (default "/var/db/dhcpd.leases"))
 309   (pid-file dhcpd-configuration-pid-file
 310             (default "/run/dhcpd/dhcpd.pid"))
 311   ;; list of strings, e.g. (list "enp0s25")
 312   (interfaces dhcpd-configuration-interfaces
 313               (default '())))
 314
 315 (define dhcpd-shepherd-service
 316   (match-lambda
 317     (($ <dhcpd-configuration> package config-file version run-directory
 318                               lease-file pid-file interfaces)
 319      (unless config-file
 320        (error "Must supply a config-file"))
 321      (list (shepherd-service
 322             ;; Allow users to easily run multiple versions simultaneously.
 323             (provision (list (string->symbol
 324                               (string-append "dhcpv" version "-daemon"))))
 325             (documentation (string-append "Run the DHCPv" version " daemon"))
 326             (requirement '(networking))
 327             (start #~(make-forkexec-constructor
 328                       '(#$(file-append package "/sbin/dhcpd")
 329                         #$(string-append "-" version)
 330                         "-lf" #$lease-file
 331                         "-pf" #$pid-file
 332                         "-cf" #$config-file
 333                         #$@interfaces)
 334                       #:pid-file #$pid-file))
 335             (stop #~(make-kill-destructor)))))))
 336
 337 (define dhcpd-activation
 338   (match-lambda
 339     (($ <dhcpd-configuration> package config-file version run-directory
 340                               lease-file pid-file interfaces)
 341      (with-imported-modules '((guix build utils))
 342        #~(begin
 343            (unless (file-exists? #$run-directory)
 344              (mkdir #$run-directory))
 345            ;; According to the DHCP manual (man dhcpd.leases), the lease
 346            ;; database must be present for dhcpd to start successfully.
 347            (unless (file-exists? #$lease-file)
 348              (with-output-to-file #$lease-file
 349                (lambda _ (display ""))))
 350            ;; Validate the config.
 351            (invoke/quiet
 352             #$(file-append package "/sbin/dhcpd") "-t" "-cf"
 353             #$config-file))))))
 354
 355 (define dhcpd-service-type
 356   (service-type
 357    (name 'dhcpd)
 358    (extensions
 359     (list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
 360           (service-extension activation-service-type dhcpd-activation)))
 361    (description "Run a DHCP (Dynamic Host Configuration Protocol) daemon.  The
 362 daemon is responsible for allocating IP addresses to its client.")))
 363
 364 \f
 365 ;;;
 366 ;;; NTP.
 367 ;;;
 368
 369 (define ntp-server-types (make-enumeration
 370                           '(pool
 371                             server
 372                             peer
 373                             broadcast
 374                             manycastclient)))
 375
 376 (define-record-type* <ntp-server>
 377   ntp-server make-ntp-server
 378   ntp-server?
 379   ;; The type can be one of the symbols of the NTP-SERVER-TYPE? enumeration.
 380   (type ntp-server-type
 381         (default 'server))
 382   (address ntp-server-address)    ; a string
 383   ;; The list of options can contain single option names or tuples in the form
 384   ;; '(name value).
 385   (options ntp-server-options
 386            (default '())))
 387
 388 (define (ntp-server->string ntp-server)
 389   ;; Serialize the NTP server object as a string, ready to use in the NTP
 390   ;; configuration file.
 391   (define (flatten lst)
 392     (reverse
 393      (let loop ((x lst)
 394                 (res '()))
 395        (if (list? x)
 396            (fold loop res x)
 397            (cons (format #f "~a" x) res)))))
 398
 399   (match ntp-server
 400     (($ <ntp-server> type address options)
 401      ;; XXX: It'd be neater if fields were validated at the syntax level (for
 402      ;; static ones at least).  Perhaps the Guix record type could support a
 403      ;; predicate property on a field?
 404      (unless (enum-set-member? type ntp-server-types)
 405        (error "Invalid NTP server type" type))
 406      (string-join (cons* (symbol->string type)
 407                          address
 408                          (flatten options))))))
 409
 410 (define %ntp-servers
 411   ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
 412   ;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact
 413   ;; for this NTP pool "zone".
 414   (list
 415    (ntp-server
 416     (type 'pool)
 417     (address "0.guix.pool.ntp.org")
 418     (options '("iburst")))))               ;as recommended in the ntpd manual
 419
 420 (define-record-type* <ntp-configuration>
 421   ntp-configuration make-ntp-configuration
 422   ntp-configuration?
 423   (ntp      ntp-configuration-ntp
 424             (default ntp))
 425   (servers  %ntp-configuration-servers   ;list of <ntp-server> objects
 426             (default %ntp-servers))
 427   (allow-large-adjustment? ntp-allow-large-adjustment?
 428                            (default #t))) ;as recommended in the ntpd manual
 429
 430 (define (ntp-configuration-servers ntp-configuration)
 431   ;; A wrapper to support the deprecated form of this field.
 432   (let ((ntp-servers (%ntp-configuration-servers ntp-configuration)))
 433     (match ntp-servers
 434       (((? string?) (? string?) ...)
 435        (format (current-error-port) "warning: Defining NTP servers as strings is \
 436 deprecated.  Please use <ntp-server> records instead.\n")
 437        (map (lambda (addr)
 438               (ntp-server
 439                (type 'server)
 440                (address addr)
 441                (options '()))) ntp-servers))
 442       ((($ <ntp-server>) ($ <ntp-server>) ...)
 443        ntp-servers))))
 444
 445 (define ntp-shepherd-service
 446   (lambda (config)
 447     (match config
 448       (($ <ntp-configuration> ntp servers allow-large-adjustment?)
 449        (let ((servers (ntp-configuration-servers config)))
 450          ;; TODO: Add authentication support.
 451          (define config
 452            (string-append "driftfile /var/run/ntpd/ntp.drift\n"
 453                           (string-join (map ntp-server->string servers)
 454                                        "\n")
 455                           "
 456 # Disable status queries as a workaround for CVE-2013-5211:
 457 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 458 restrict default kod nomodify notrap nopeer noquery limited
 459 restrict -6 default kod nomodify notrap nopeer noquery limited
 460
 461 # Yet, allow use of the local 'ntpq'.
 462 restrict 127.0.0.1
 463 restrict -6 ::1
 464
 465 # This is required to use servers from a pool directive when using the 'nopeer'
 466 # option by default, as documented in the 'ntp.conf' manual.
 467 restrict source notrap nomodify noquery\n"))
 468
 469          (define ntpd.conf
 470            (plain-file "ntpd.conf" config))
 471
 472          (list (shepherd-service
 473                 (provision '(ntpd))
 474                 (documentation "Run the Network Time Protocol (NTP) daemon.")
 475                 (requirement '(user-processes networking))
 476                 (start #~(make-forkexec-constructor
 477                           (list (string-append #$ntp "/bin/ntpd") "-n"
 478                                 "-c" #$ntpd.conf "-u" "ntpd"
 479                                 #$@(if allow-large-adjustment?
 480                                        '("-g")
 481                                        '()))))
 482                 (stop #~(make-kill-destructor)))))))))
 483
 484 (define %ntp-accounts
 485   (list (user-account
 486          (name "ntpd")
 487          (group "nogroup")
 488          (system? #t)
 489          (comment "NTP daemon user")
 490          (home-directory "/var/empty")
 491          (shell (file-append shadow "/sbin/nologin")))))
 492
 493
 494 (define (ntp-service-activation config)
 495   "Return the activation gexp for CONFIG."
 496   (with-imported-modules '((guix build utils))
 497     #~(begin
 498         (use-modules (guix build utils))
 499         (define %user
 500           (getpw "ntpd"))
 501
 502         (let ((directory "/var/run/ntpd"))
 503           (mkdir-p directory)
 504           (chown directory (passwd:uid %user) (passwd:gid %user))))))
 505
 506 (define ntp-service-type
 507   (service-type (name 'ntp)
 508                 (extensions
 509                  (list (service-extension shepherd-root-service-type
 510                                           ntp-shepherd-service)
 511                        (service-extension account-service-type
 512                                           (const %ntp-accounts))
 513                        (service-extension activation-service-type
 514                                           ntp-service-activation)))
 515                 (description
 516                  "Run the @command{ntpd}, the Network Time Protocol (NTP)
 517 daemon of the @uref{http://www.ntp.org, Network Time Foundation}.  The daemon
 518 will keep the system clock synchronized with that of the given servers.")
 519                 (default-value (ntp-configuration))))
 520
 521 (define-deprecated (ntp-service #:key (ntp ntp)
 522                                 (servers %ntp-servers)
 523                                 allow-large-adjustment?)
 524   ntp-service-type
 525   "Return a service that runs the daemon from @var{ntp}, the
 526 @uref{http://www.ntp.org, Network Time Protocol package}.  The daemon will
 527 keep the system clock synchronized with that of @var{servers}.
 528 @var{allow-large-adjustment?} determines whether @command{ntpd} is allowed to
 529 make an initial adjustment of more than 1,000 seconds."
 530   (service ntp-service-type
 531            (ntp-configuration (ntp ntp)
 532                               (servers servers)
 533                               (allow-large-adjustment?
 534                                allow-large-adjustment?))))
 535
 536 \f
 537 ;;;
 538 ;;; OpenNTPD.
 539 ;;;
 540
 541 (define %openntpd-servers
 542   (map ntp-server-address %ntp-servers))
 543
 544 (define-record-type* <openntpd-configuration>
 545   openntpd-configuration make-openntpd-configuration
 546   openntpd-configuration?
 547   (openntpd                openntpd-configuration-openntpd
 548                            (default openntpd))
 549   (listen-on               openntpd-listen-on
 550                            (default '("127.0.0.1"
 551                                       "::1")))
 552   (query-from              openntpd-query-from
 553                            (default '()))
 554   (sensor                  openntpd-sensor
 555                            (default '()))
 556   (server                  openntpd-server
 557                            (default '()))
 558   (servers                 openntpd-servers
 559                            (default %openntpd-servers))
 560   (constraint-from         openntpd-constraint-from
 561                            (default '()))
 562   (constraints-from        openntpd-constraints-from
 563                            (default '())))
 564
 565 (define (openntpd-configuration->string config)
 566
 567   (define (quote-field? name)
 568     (member name '("constraints from")))
 569
 570   (match-record config <openntpd-configuration>
 571     (listen-on query-from sensor server servers constraint-from
 572                constraints-from)
 573     (string-append
 574      (string-join
 575       (concatenate
 576        (filter-map (lambda (field values)
 577                      (match values
 578                        (() #f)          ;discard entry with filter-map
 579                        ((val ...)       ;validate value type
 580                         (map (lambda (value)
 581                                (if (quote-field? field)
 582                                    (format #f "~a \"~a\"" field value)
 583                                    (format #f "~a ~a" field value)))
 584                              values))))
 585                    ;; The entry names.
 586                    '("listen on" "query from" "sensor" "server" "servers"
 587                      "constraint from" "constraints from")
 588                    ;; The corresponding entry values.
 589                    (list listen-on query-from sensor server servers
 590                          constraint-from constraints-from)))
 591       "\n")
 592      "\n")))                              ;add a trailing newline
 593
 594 (define (openntpd-shepherd-service config)
 595   (let ((openntpd (openntpd-configuration-openntpd config)))
 596
 597     (define ntpd.conf
 598       (plain-file "ntpd.conf" (openntpd-configuration->string config)))
 599
 600     (list (shepherd-service
 601            (provision '(ntpd))
 602            (documentation "Run the Network Time Protocol (NTP) daemon.")
 603            (requirement '(user-processes networking))
 604            (start #~(make-forkexec-constructor
 605                      (list (string-append #$openntpd "/sbin/ntpd")
 606                            "-f" #$ntpd.conf
 607                            "-d") ;; don't daemonize
 608                      ;; When ntpd is daemonized it repeatedly tries to respawn
 609                      ;; while running, leading shepherd to disable it.  To
 610                      ;; prevent spamming stderr, redirect output to logfile.
 611                      #:log-file "/var/log/ntpd"))
 612            (stop #~(make-kill-destructor))))))
 613
 614 (define (openntpd-service-activation config)
 615   "Return the activation gexp for CONFIG."
 616   (with-imported-modules '((guix build utils))
 617     #~(begin
 618         (use-modules (guix build utils))
 619
 620         (mkdir-p "/var/db")
 621         (mkdir-p "/var/run")
 622         (unless (file-exists? "/var/db/ntpd.drift")
 623           (with-output-to-file "/var/db/ntpd.drift"
 624                                (lambda _
 625                                  (format #t "0.0")))))))
 626
 627 (define openntpd-service-type
 628   (service-type (name 'openntpd)
 629                 (extensions
 630                  (list (service-extension shepherd-root-service-type
 631                                           openntpd-shepherd-service)
 632                        (service-extension account-service-type
 633                                           (const %ntp-accounts))
 634                        (service-extension profile-service-type
 635                                           (compose list openntpd-configuration-openntpd))
 636                        (service-extension activation-service-type
 637                                           openntpd-service-activation)))
 638                 (default-value (openntpd-configuration))
 639                 (description
 640                  "Run the @command{ntpd}, the Network Time Protocol (NTP)
 641 daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}.  The
 642 daemon will keep the system clock synchronized with that of the given servers.")))
 643
 644 \f
 645 ;;;
 646 ;;; Inetd.
 647 ;;;
 648
 649 (define-record-type* <inetd-configuration> inetd-configuration
 650   make-inetd-configuration
 651   inetd-configuration?
 652   (program           inetd-configuration-program   ;file-like
 653                      (default (file-append inetutils "/libexec/inetd")))
 654   (entries           inetd-configuration-entries   ;list of <inetd-entry>
 655                      (default '())))
 656
 657 (define-record-type* <inetd-entry> inetd-entry make-inetd-entry
 658   inetd-entry?
 659   (node              inetd-entry-node         ;string or #f
 660                      (default #f))
 661   (name              inetd-entry-name)        ;string, from /etc/services
 662
 663   (socket-type       inetd-entry-socket-type) ;stream | dgram | raw |
 664                                               ;rdm | seqpacket
 665   (protocol          inetd-entry-protocol)    ;string, from /etc/protocols
 666
 667   (wait?             inetd-entry-wait?        ;Boolean
 668                      (default #t))
 669   (user              inetd-entry-user)        ;string
 670
 671   (program           inetd-entry-program      ;string or file-like object
 672                      (default "internal"))
 673   (arguments         inetd-entry-arguments    ;list of strings or file-like objects
 674                      (default '())))
 675
 676 (define (inetd-config-file entries)
 677   (apply mixed-text-file "inetd.conf"
 678          (map
 679           (lambda (entry)
 680             (let* ((node (inetd-entry-node entry))
 681                    (name (inetd-entry-name entry))
 682                    (socket
 683                     (if node (string-append node ":" name) name))
 684                    (type
 685                     (match (inetd-entry-socket-type entry)
 686                       ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
 687                        (symbol->string (inetd-entry-socket-type entry)))))
 688                    (protocol (inetd-entry-protocol entry))
 689                    (wait (if (inetd-entry-wait? entry) "wait" "nowait"))
 690                    (user (inetd-entry-user entry))
 691                    (program (inetd-entry-program entry))
 692                    (args (inetd-entry-arguments entry)))
 693               #~(string-append
 694                  (string-join
 695                   (list #$@(list socket type protocol wait user program) #$@args)
 696                   " ") "\n")))
 697           entries)))
 698
 699 (define inetd-shepherd-service
 700   (match-lambda
 701     (($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
 702     (($ <inetd-configuration> program entries)
 703      (list
 704       (shepherd-service
 705        (documentation "Run inetd.")
 706        (provision '(inetd))
 707        (requirement '(user-processes networking syslogd))
 708        (start #~(make-forkexec-constructor
 709                  (list #$program #$(inetd-config-file entries))
 710                  #:pid-file "/var/run/inetd.pid"))
 711        (stop #~(make-kill-destructor)))))))
 712
 713 (define-public inetd-service-type
 714   (service-type
 715    (name 'inetd)
 716    (extensions
 717     (list (service-extension shepherd-root-service-type
 718                              inetd-shepherd-service)))
 719
 720    ;; The service can be extended with additional lists of entries.
 721    (compose concatenate)
 722    (extend (lambda (config entries)
 723              (inetd-configuration
 724               (inherit config)
 725               (entries (append (inetd-configuration-entries config)
 726                                entries)))))
 727    (description
 728     "Start @command{inetd}, the @dfn{Internet superserver}.  It is responsible
 729 for listening on Internet sockets and spawning the corresponding services on
 730 demand.")))
 731
 732 \f
 733 ;;;
 734 ;;; Tor.
 735 ;;;
 736
 737 (define-record-type* <tor-configuration>
 738   tor-configuration make-tor-configuration
 739   tor-configuration?
 740   (tor              tor-configuration-tor
 741                     (default tor))
 742   (config-file      tor-configuration-config-file
 743                     (default (plain-file "empty" "")))
 744   (hidden-services  tor-configuration-hidden-services
 745                     (default '()))
 746   (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
 747                      (default 'tcp)))
 748
 749 (define %tor-accounts
 750   ;; User account and groups for Tor.
 751   (list (user-group (name "tor") (system? #t))
 752         (user-account
 753          (name "tor")
 754          (group "tor")
 755          (system? #t)
 756          (comment "Tor daemon user")
 757          (home-directory "/var/empty")
 758          (shell (file-append shadow "/sbin/nologin")))))
 759
 760 (define-record-type <hidden-service>
 761   (hidden-service name mapping)
 762   hidden-service?
 763   (name    hidden-service-name)                   ;string
 764   (mapping hidden-service-mapping))               ;list of port/address tuples
 765
 766 (define (tor-configuration->torrc config)
 767   "Return a 'torrc' file for CONFIG."
 768   (match config
 769     (($ <tor-configuration> tor config-file services socks-socket-type)
 770      (computed-file
 771       "torrc"
 772       (with-imported-modules '((guix build utils))
 773         #~(begin
 774             (use-modules (guix build utils)
 775                          (ice-9 match))
 776
 777             (call-with-output-file #$output
 778               (lambda (port)
 779                 (display "\
 780 ### These lines were generated from your system configuration:
 781 User tor
 782 DataDirectory /var/lib/tor
 783 PidFile /var/run/tor/tor.pid
 784 Log notice syslog\n" port)
 785                 (when (eq? 'unix '#$socks-socket-type)
 786                   (display "\
 787 SocksPort unix:/var/run/tor/socks-sock
 788 UnixSocksGroupWritable 1\n" port))
 789
 790                 (for-each (match-lambda
 791                             ((service (ports hosts) ...)
 792                              (format port "\
 793 HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
 794                                      service)
 795                              (for-each (lambda (tcp-port host)
 796                                          (format port "\
 797 HiddenServicePort ~a ~a~%"
 798                                                  tcp-port host))
 799                                        ports hosts)))
 800                           '#$(map (match-lambda
 801                                     (($ <hidden-service> name mapping)
 802                                      (cons name mapping)))
 803                                   services))
 804
 805                 (display "\
 806 ### End of automatically generated lines.\n\n" port)
 807
 808                 ;; Append the user's config file.
 809                 (call-with-input-file #$config-file
 810                   (lambda (input)
 811                     (dump-port input port)))
 812                 #t))))))))
 813
 814 (define (tor-shepherd-service config)
 815   "Return a <shepherd-service> running Tor."
 816   (match config
 817     (($ <tor-configuration> tor)
 818      (let ((torrc (tor-configuration->torrc config)))
 819        (with-imported-modules (source-module-closure
 820                                '((gnu build shepherd)
 821                                  (gnu system file-systems)))
 822          (list (shepherd-service
 823                 (provision '(tor))
 824
 825                 ;; Tor needs at least one network interface to be up, hence the
 826                 ;; dependency on 'loopback'.
 827                 (requirement '(user-processes loopback syslogd))
 828
 829                 (modules '((gnu build shepherd)
 830                            (gnu system file-systems)))
 831
 832                 (start #~(make-forkexec-constructor/container
 833                           (list #$(file-append tor "/bin/tor") "-f" #$torrc)
 834
 835                           #:mappings (list (file-system-mapping
 836                                             (source "/var/lib/tor")
 837                                             (target source)
 838                                             (writable? #t))
 839                                            (file-system-mapping
 840                                             (source "/dev/log") ;for syslog
 841                                             (target source))
 842                                            (file-system-mapping
 843                                             (source "/var/run/tor")
 844                                             (target source)
 845                                             (writable? #t)))
 846                           #:pid-file "/var/run/tor/tor.pid"))
 847                 (stop #~(make-kill-destructor))
 848                 (documentation "Run the Tor anonymous network overlay."))))))))
 849
 850 (define (tor-activation config)
 851   "Set up directories for Tor and its hidden services, if any."
 852   #~(begin
 853       (use-modules (guix build utils))
 854
 855       (define %user
 856         (getpw "tor"))
 857
 858       (define (initialize service)
 859         (let ((directory (string-append "/var/lib/tor/hidden-services/"
 860                                         service)))
 861           (mkdir-p directory)
 862           (chown directory (passwd:uid %user) (passwd:gid %user))
 863
 864           ;; The daemon bails out if we give wider permissions.
 865           (chmod directory #o700)))
 866
 867       ;; Allow Tor to write its PID file.
 868       (mkdir-p "/var/run/tor")
 869       (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
 870       ;; Set the group permissions to rw so that if the system administrator
 871       ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
 872       ;; of the "tor" group will be able to use the SOCKS socket.
 873       (chmod "/var/run/tor" #o750)
 874
 875       ;; Allow Tor to access the hidden services' directories.
 876       (mkdir-p "/var/lib/tor")
 877       (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
 878       (chmod "/var/lib/tor" #o700)
 879
 880       ;; Make sure /var/lib is accessible to the 'tor' user.
 881       (chmod "/var/lib" #o755)
 882
 883       (for-each initialize
 884                 '#$(map hidden-service-name
 885                         (tor-configuration-hidden-services config)))))
 886
 887 (define tor-service-type
 888   (service-type (name 'tor)
 889                 (extensions
 890                  (list (service-extension shepherd-root-service-type
 891                                           tor-shepherd-service)
 892                        (service-extension account-service-type
 893                                           (const %tor-accounts))
 894                        (service-extension activation-service-type
 895                                           tor-activation)))
 896
 897                 ;; This can be extended with hidden services.
 898                 (compose concatenate)
 899                 (extend (lambda (config services)
 900                           (tor-configuration
 901                            (inherit config)
 902                            (hidden-services
 903                             (append (tor-configuration-hidden-services config)
 904                                     services)))))
 905                 (default-value (tor-configuration))
 906                 (description
 907                  "Run the @uref{https://torproject.org, Tor} anonymous
 908 networking daemon.")))
 909
 910 (define-deprecated (tor-service #:optional
 911                                 (config-file (plain-file "empty" ""))
 912                                 #:key (tor tor))
 913   tor-service-type
 914   "Return a service to run the @uref{https://torproject.org, Tor} anonymous
 915 networking daemon.
 916
 917 The daemon runs as the @code{tor} unprivileged user.  It is passed
 918 @var{config-file}, a file-like object, with an additional @code{User tor} line
 919 and lines for hidden services added via @code{tor-hidden-service}.  Run
 920 @command{man tor} for information about the configuration file."
 921   (service tor-service-type
 922            (tor-configuration (tor tor)
 923                               (config-file config-file))))
 924
 925 (define tor-hidden-service-type
 926   ;; A type that extends Tor with hidden services.
 927   (service-type (name 'tor-hidden-service)
 928                 (extensions
 929                  (list (service-extension tor-service-type list)))
 930                 (description
 931                  "Define a new Tor @dfn{hidden service}.")))
 932
 933 (define (tor-hidden-service name mapping)
 934   "Define a new Tor @dfn{hidden service} called @var{name} and implementing
 935 @var{mapping}.  @var{mapping} is a list of port/host tuples, such as:
 936
 937 @example
 938  '((22 \"127.0.0.1:22\")
 939    (80 \"127.0.0.1:8080\"))
 940 @end example
 941
 942 In this example, port 22 of the hidden service is mapped to local port 22, and
 943 port 80 is mapped to local port 8080.
 944
 945 This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
 946 the @file{hostname} file contains the @code{.onion} host name for the hidden
 947 service.
 948
 949 See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
 950 project's documentation} for more information."
 951   (service tor-hidden-service-type
 952            (hidden-service name mapping)))
 953
 954 \f
 955 ;;;
 956 ;;; Wicd.
 957 ;;;
 958
 959 (define %wicd-activation
 960   ;; Activation gexp for Wicd.
 961   #~(begin
 962       (use-modules (guix build utils))
 963
 964       (mkdir-p "/etc/wicd")
 965       (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
 966         (unless (file-exists? file-name)
 967           (copy-file (string-append #$wicd file-name)
 968                      file-name)))
 969
 970       ;; Wicd invokes 'wpa_supplicant', which needs this directory for its
 971       ;; named socket files.
 972       (mkdir-p "/var/run/wpa_supplicant")
 973       (chmod "/var/run/wpa_supplicant" #o750)))
 974
 975 (define (wicd-shepherd-service wicd)
 976   "Return a shepherd service for WICD."
 977   (list (shepherd-service
 978          (documentation "Run the Wicd network manager.")
 979          (provision '(networking))
 980          (requirement '(user-processes dbus-system loopback))
 981          (start #~(make-forkexec-constructor
 982                    (list (string-append #$wicd "/sbin/wicd")
 983                          "--no-daemon")))
 984          (stop #~(make-kill-destructor)))))
 985
 986 (define wicd-service-type
 987   (service-type (name 'wicd)
 988                 (extensions
 989                  (list (service-extension shepherd-root-service-type
 990                                           wicd-shepherd-service)
 991                        (service-extension dbus-root-service-type
 992                                           list)
 993                        (service-extension activation-service-type
 994                                           (const %wicd-activation))
 995
 996                        ;; Add Wicd to the global profile.
 997                        (service-extension profile-service-type list)))
 998                 (description
 999                  "Run @url{https://launchpad.net/wicd,Wicd}, a network
1000 management daemon that aims to simplify wired and wireless networking.")))
1001
1002 (define* (wicd-service #:key (wicd wicd))
1003   "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
1004 management daemon that aims to simplify wired and wireless networking.
1005
1006 This service adds the @var{wicd} package to the global profile, providing
1007 several commands to interact with the daemon and configure networking:
1008 @command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
1009 and @command{wicd-curses} user interfaces."
1010   (service wicd-service-type wicd))
1011
1012 \f
1013 ;;;
1014 ;;; ModemManager
1015 ;;;
1016
1017 (define-record-type* <modem-manager-configuration>
1018   modem-manager-configuration make-modem-manager-configuration
1019   modem-manager-configuration?
1020   (modem-manager modem-manager-configuration-modem-manager
1021                    (default modem-manager)))
1022
1023 \f
1024 ;;;
1025 ;;; NetworkManager
1026 ;;;
1027
1028 (define-record-type* <network-manager-configuration>
1029   network-manager-configuration make-network-manager-configuration
1030   network-manager-configuration?
1031   (network-manager network-manager-configuration-network-manager
1032                    (default network-manager))
1033   (dns network-manager-configuration-dns
1034        (default "default"))
1035   (vpn-plugins network-manager-configuration-vpn-plugins ;list of <package>
1036                (default '())))
1037
1038 (define network-manager-activation
1039   ;; Activation gexp for NetworkManager
1040   (match-lambda
1041     (($ <network-manager-configuration> network-manager dns vpn-plugins)
1042      #~(begin
1043          (use-modules (guix build utils))
1044          (mkdir-p "/etc/NetworkManager/system-connections")
1045          #$@(if (equal? dns "dnsmasq")
1046                 ;; create directory to store dnsmasq lease file
1047                 '((mkdir-p "/var/lib/misc"))
1048                 '())))))
1049
1050 (define (vpn-plugin-directory plugins)
1051   "Return a directory containing PLUGINS, the NM VPN plugins."
1052   (directory-union "network-manager-vpn-plugins" plugins))
1053
1054 (define (network-manager-accounts config)
1055   "Return the list of <user-account> and <user-group> for CONFIG."
1056   (define nologin
1057     (file-append shadow "/sbin/nologin"))
1058
1059   (define accounts
1060     (append-map (lambda (package)
1061                   (map (lambda (name)
1062                          (user-account (system? #t)
1063                                        (name name)
1064                                        (group "network-manager")
1065                                        (comment "NetworkManager helper")
1066                                        (home-directory "/var/empty")
1067                                        (create-home-directory? #f)
1068                                        (shell nologin)))
1069                        (or (assoc-ref (package-properties package)
1070                                       'user-accounts)
1071                            '())))
1072                 (network-manager-configuration-vpn-plugins config)))
1073
1074   (match accounts
1075     (()
1076      '())
1077     (_
1078      (cons (user-group (name "network-manager") (system? #t))
1079            accounts))))
1080
1081 (define network-manager-environment
1082   (match-lambda
1083     (($ <network-manager-configuration> network-manager dns vpn-plugins)
1084      ;; Define this variable in the global environment such that
1085      ;; "nmcli connection import type openvpn file foo.ovpn" works.
1086      `(("NM_VPN_PLUGIN_DIR"
1087         . ,(file-append (vpn-plugin-directory vpn-plugins)
1088                         "/lib/NetworkManager/VPN"))))))
1089
1090 (define network-manager-shepherd-service
1091   (match-lambda
1092     (($ <network-manager-configuration> network-manager dns vpn-plugins)
1093      (let ((conf (plain-file "NetworkManager.conf"
1094                              (string-append "[main]\ndns=" dns "\n")))
1095            (vpn  (vpn-plugin-directory vpn-plugins)))
1096        (list (shepherd-service
1097               (documentation "Run the NetworkManager.")
1098               (provision '(networking))
1099               (requirement '(user-processes dbus-system wpa-supplicant loopback))
1100               (start #~(make-forkexec-constructor
1101                         (list (string-append #$network-manager
1102                                              "/sbin/NetworkManager")
1103                               (string-append "--config=" #$conf)
1104                               "--no-daemon")
1105                         #:environment-variables
1106                         (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
1107                                              "/lib/NetworkManager/VPN")
1108                               ;; Override non-existent default users
1109                               "NM_OPENVPN_USER="
1110                               "NM_OPENVPN_GROUP=")))
1111               (stop #~(make-kill-destructor))))))))
1112
1113 (define network-manager-service-type
1114   (let
1115       ((config->packages
1116         (match-lambda
1117          (($ <network-manager-configuration> network-manager _ vpn-plugins)
1118           `(,network-manager ,@vpn-plugins)))))
1119
1120     (service-type
1121      (name 'network-manager)
1122      (extensions
1123       (list (service-extension shepherd-root-service-type
1124                                network-manager-shepherd-service)
1125             (service-extension dbus-root-service-type config->packages)
1126             (service-extension polkit-service-type
1127                                (compose
1128                                 list
1129                                 network-manager-configuration-network-manager))
1130             (service-extension account-service-type
1131                                network-manager-accounts)
1132             (service-extension activation-service-type
1133                                network-manager-activation)
1134             (service-extension session-environment-service-type
1135                                network-manager-environment)
1136             ;; Add network-manager to the system profile.
1137             (service-extension profile-service-type config->packages)))
1138      (default-value (network-manager-configuration))
1139      (description
1140       "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
1141 NetworkManager}, a network management daemon that aims to simplify wired and
1142 wireless networking."))))
1143
1144 \f
1145 ;;;
1146 ;;; Connman
1147 ;;;
1148
1149 (define-record-type* <connman-configuration>
1150   connman-configuration make-connman-configuration
1151   connman-configuration?
1152   (connman      connman-configuration-connman
1153                 (default connman))
1154   (disable-vpn? connman-configuration-disable-vpn?
1155                 (default #f)))
1156
1157 (define (connman-activation config)
1158   (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
1159     (with-imported-modules '((guix build utils))
1160       #~(begin
1161           (use-modules (guix build utils))
1162           (mkdir-p "/var/lib/connman/")
1163           (unless #$disable-vpn?
1164             (mkdir-p "/var/lib/connman-vpn/"))))))
1165
1166 (define (connman-shepherd-service config)
1167   "Return a shepherd service for Connman"
1168   (and
1169    (connman-configuration? config)
1170    (let ((connman      (connman-configuration-connman config))
1171          (disable-vpn? (connman-configuration-disable-vpn? config)))
1172      (list (shepherd-service
1173             (documentation "Run Connman")
1174             (provision '(networking))
1175             (requirement
1176              '(user-processes dbus-system loopback wpa-supplicant))
1177             (start #~(make-forkexec-constructor
1178                       (list (string-append #$connman
1179                                            "/sbin/connmand")
1180                             "--nodaemon"
1181                             "--nodnsproxy"
1182                             #$@(if disable-vpn? '("--noplugin=vpn") '()))
1183
1184                       ;; As connman(8) notes, when passing '-n', connman
1185                       ;; "directs log output to the controlling terminal in
1186                       ;; addition to syslog."  Redirect stdout and stderr
1187                       ;; to avoid spamming the console (XXX: for some reason
1188                       ;; redirecting to /dev/null doesn't work.)
1189                       #:log-file "/var/log/connman.log"))
1190             (stop #~(make-kill-destructor)))))))
1191
1192 (define connman-service-type
1193   (let ((connman-package (compose list connman-configuration-connman)))
1194     (service-type (name 'connman)
1195                   (extensions
1196                    (list (service-extension shepherd-root-service-type
1197                                             connman-shepherd-service)
1198                          (service-extension polkit-service-type
1199                                             connman-package)
1200                          (service-extension dbus-root-service-type
1201                                             connman-package)
1202                          (service-extension activation-service-type
1203                                             connman-activation)
1204                          ;; Add connman to the system profile.
1205                          (service-extension profile-service-type
1206                                             connman-package)))
1207                   (default-value (connman-configuration))
1208                   (description
1209                    "Run @url{https://01.org/connman,Connman},
1210 a network connection manager."))))
1211
1212 \f
1213 ;;;
1214 ;;; Modem manager
1215 ;;;
1216
1217 (define modem-manager-service-type
1218   (let ((config->package
1219          (match-lambda
1220           (($ <modem-manager-configuration> modem-manager)
1221            (list modem-manager)))))
1222     (service-type (name 'modem-manager)
1223                   (extensions
1224                    (list (service-extension dbus-root-service-type
1225                                             config->package)
1226                          (service-extension udev-service-type
1227                                             config->package)
1228                          (service-extension polkit-service-type
1229                                             config->package)))
1230                   (default-value (modem-manager-configuration))
1231                   (description
1232                    "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
1233 ModemManager}, a modem management daemon that aims to simplify dialup
1234 networking."))))
1235
1236 \f
1237 ;;;
1238 ;;; USB_ModeSwitch
1239 ;;;
1240
1241 (define-record-type* <usb-modeswitch-configuration>
1242   usb-modeswitch-configuration make-usb-modeswitch-configuration
1243   usb-modeswitch-configuration?
1244   (usb-modeswitch      usb-modeswitch-configuration-usb-modeswitch
1245                        (default usb-modeswitch))
1246   (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
1247                        (default usb-modeswitch-data))
1248   (config-file         usb-modeswitch-configuration-config-file
1249                        (default #~(string-append #$usb-modeswitch:dispatcher
1250                                                  "/etc/usb_modeswitch.conf"))))
1251
1252 (define (usb-modeswitch-sh usb-modeswitch config-file)
1253   "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
1254 modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
1255 and wrap it to actually find the dispatcher in USB-MODESWITCH.  The script
1256 will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
1257 device is detected."
1258   (computed-file
1259    "usb_modeswitch-sh"
1260    (with-imported-modules '((guix build utils))
1261      #~(begin
1262          (use-modules (guix build utils))
1263          (let ((cfg-param
1264                 #$(if config-file
1265                       #~(string-append " --config-file=" #$config-file)
1266                       "")))
1267            (mkdir #$output)
1268            (install-file (string-append #$usb-modeswitch:dispatcher
1269                                         "/lib/udev/usb_modeswitch")
1270                          #$output)
1271
1272            ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
1273            (substitute* (string-append #$output "/usb_modeswitch")
1274              (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
1275               (string-append left cfg-param right))
1276              (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
1277               (string-append left cfg-param right)))
1278
1279            ;; wrap-program needs bash in PATH:
1280            (putenv (string-append "PATH=" #$bash "/bin"))
1281            (wrap-program (string-append #$output "/usb_modeswitch")
1282              `("PATH" ":" = (,(string-append #$coreutils "/bin")
1283                              ,(string-append
1284                                #$usb-modeswitch:dispatcher
1285                                "/bin")))))))))
1286
1287 (define (usb-modeswitch-configuration->udev-rules config)
1288   "Build a rules file for extending udev-service-type from the rules in the
1289 usb-modeswitch package specified in CONFIG.  The rules file will invoke
1290 usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
1291 config file."
1292   (match config
1293     (($ <usb-modeswitch-configuration> usb-modeswitch data config-file)
1294      (computed-file
1295       "usb_modeswitch.rules"
1296       (with-imported-modules '((guix build utils))
1297         #~(begin
1298             (use-modules (guix build utils))
1299             (let ((in (string-append #$data "/udev/40-usb_modeswitch.rules"))
1300                   (out (string-append #$output "/lib/udev/rules.d"))
1301                   (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
1302               (mkdir-p out)
1303               (chdir out)
1304               (install-file in out)
1305               (substitute* "40-usb_modeswitch.rules"
1306                 (("PROGRAM=\"usb_modeswitch")
1307                  (string-append "PROGRAM=\"" script "/usb_modeswitch"))
1308                 (("RUN\\+=\"usb_modeswitch")
1309                  (string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
1310
1311 (define usb-modeswitch-service-type
1312   (service-type
1313    (name 'usb-modeswitch)
1314    (extensions
1315     (list
1316      (service-extension
1317       udev-service-type
1318       (lambda (config)
1319         (let ((rules (usb-modeswitch-configuration->udev-rules config)))
1320           (list rules))))))
1321    (default-value (usb-modeswitch-configuration))
1322    (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
1323 USB_ModeSwitch}, a mode switching tool for controlling USB devices with
1324 multiple @dfn{modes}.  When plugged in for the first time many USB
1325 devices (primarily high-speed WAN modems) act like a flash storage containing
1326 installers for Windows drivers.  USB_ModeSwitch replays the sequence the
1327 Windows drivers would send to switch their mode from storage to modem (or
1328 whatever the thing is supposed to do).")))
1329
1330 \f
1331 ;;;
1332 ;;; WPA supplicant
1333 ;;;
1334
1335 (define-record-type* <wpa-supplicant-configuration>
1336   wpa-supplicant-configuration make-wpa-supplicant-configuration
1337   wpa-supplicant-configuration?
1338   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
1339                       (default wpa-supplicant))
1340   (requirement        wpa-supplicant-configuration-requirement    ;list of symbols
1341                       (default '(user-processes loopback syslogd)))
1342   (pid-file           wpa-supplicant-configuration-pid-file       ;string
1343                       (default "/var/run/wpa_supplicant.pid"))
1344   (dbus?              wpa-supplicant-configuration-dbus?          ;Boolean
1345                       (default #t))
1346   (interface          wpa-supplicant-configuration-interface      ;#f | string
1347                       (default #f))
1348   (config-file        wpa-supplicant-configuration-config-file    ;#f | <file-like>
1349                       (default #f))
1350   (extra-options      wpa-supplicant-configuration-extra-options  ;list of strings
1351                       (default '())))
1352
1353 (define wpa-supplicant-shepherd-service
1354   (match-lambda
1355     (($ <wpa-supplicant-configuration> wpa-supplicant requirement pid-file dbus?
1356                                        interface config-file extra-options)
1357      (list (shepherd-service
1358             (documentation "Run the WPA supplicant daemon")
1359             (provision '(wpa-supplicant))
1360             (requirement (if dbus?
1361                              (cons 'dbus-system requirement)
1362                              requirement))
1363             (start #~(make-forkexec-constructor
1364                       (list (string-append #$wpa-supplicant
1365                                            "/sbin/wpa_supplicant")
1366                             (string-append "-P" #$pid-file)
1367                             "-B"        ;run in background
1368                             "-s"        ;log to syslogd
1369                             #$@(if dbus?
1370                                    #~("-u")
1371                                    #~())
1372                             #$@(if interface
1373                                    #~((string-append "-i" #$interface))
1374                                    #~())
1375                             #$@(if config-file
1376                                    #~((string-append "-c" #$config-file))
1377                                    #~())
1378                             #$@extra-options)
1379                       #:pid-file #$pid-file))
1380             (stop #~(make-kill-destructor)))))))
1381
1382 (define wpa-supplicant-service-type
1383   (let ((config->package
1384          (match-lambda
1385            (($ <wpa-supplicant-configuration> wpa-supplicant)
1386             (list wpa-supplicant)))))
1387     (service-type (name 'wpa-supplicant)
1388                   (extensions
1389                    (list (service-extension shepherd-root-service-type
1390                                             wpa-supplicant-shepherd-service)
1391                          (service-extension dbus-root-service-type config->package)
1392                          (service-extension profile-service-type config->package)))
1393                   (description "Run the WPA Supplicant daemon, a service that
1394 implements authentication, key negotiation and more for wireless networks.")
1395                   (default-value (wpa-supplicant-configuration)))))
1396
1397 \f
1398 ;;;
1399 ;;; Hostapd.
1400 ;;;
1401
1402 (define-record-type* <hostapd-configuration>
1403   hostapd-configuration make-hostapd-configuration
1404   hostapd-configuration?
1405   (package           hostapd-configuration-package
1406                      (default hostapd))
1407   (interface         hostapd-configuration-interface ;string
1408                      (default "wlan0"))
1409   (ssid              hostapd-configuration-ssid)  ;string
1410   (broadcast-ssid?   hostapd-configuration-broadcast-ssid? ;Boolean
1411                      (default #t))
1412   (channel           hostapd-configuration-channel ;integer
1413                      (default 1))
1414   (driver            hostapd-configuration-driver ;string
1415                      (default "nl80211"))
1416   ;; See <https://w1.fi/cgit/hostap/plain/hostapd/hostapd.conf> for a list of
1417   ;; additional options we could add.
1418   (extra-settings    hostapd-configuration-extra-settings ;string
1419                      (default "")))
1420
1421 (define (hostapd-configuration-file config)
1422   "Return the configuration file for CONFIG, a <hostapd-configuration>."
1423   (match-record config <hostapd-configuration>
1424     (interface ssid broadcast-ssid? channel driver extra-settings)
1425     (plain-file "hostapd.conf"
1426                 (string-append "\
1427 # Generated from your Guix configuration.
1428
1429 interface=" interface "
1430 ssid=" ssid "
1431 ignore_broadcast_ssid=" (if broadcast-ssid? "0" "1") "
1432 channel=" (number->string channel) "\n"
1433 extra-settings "\n"))))
1434
1435 (define* (hostapd-shepherd-services config #:key (requirement '()))
1436   "Return Shepherd services for hostapd."
1437   (list (shepherd-service
1438          (provision '(hostapd))
1439          (requirement `(user-processes ,@requirement))
1440          (documentation "Run the hostapd WiFi access point daemon.")
1441          (start #~(make-forkexec-constructor
1442                    (list #$(file-append hostapd "/sbin/hostapd")
1443                          #$(hostapd-configuration-file config))
1444                    #:log-file "/var/log/hostapd.log"))
1445          (stop #~(make-kill-destructor)))))
1446
1447 (define hostapd-service-type
1448   (service-type
1449    (name 'hostapd)
1450    (extensions
1451     (list (service-extension shepherd-root-service-type
1452                              hostapd-shepherd-services)))
1453    (description
1454     "Run the @uref{https://w1.fi/hostapd/, hostapd} daemon for Wi-Fi access
1455 points and authentication servers.")))
1456
1457 (define (simulated-wifi-shepherd-services config)
1458   "Return Shepherd services to run hostapd with CONFIG, a
1459 <hostapd-configuration>, as well as services to set up WiFi hardware
1460 simulation."
1461   (append (hostapd-shepherd-services config
1462                                      #:requirement
1463                                      '(unblocked-wifi
1464                                        kernel-module-loader))
1465           (list (shepherd-service
1466                  (provision '(unblocked-wifi))
1467                  (requirement '(file-systems kernel-module-loader))
1468                  (documentation
1469                   "Unblock WiFi devices for use by mac80211_hwsim.")
1470                  (start #~(lambda _
1471                             (invoke #$(file-append util-linux "/sbin/rfkill")
1472                                     "unblock" "0")
1473                             (invoke #$(file-append util-linux "/sbin/rfkill")
1474                                     "unblock" "1")))
1475                  (one-shot? #t)))))
1476
1477 (define simulated-wifi-service-type
1478   (service-type
1479    (name 'simulated-wifi)
1480    (extensions
1481     (list (service-extension shepherd-root-service-type
1482                              simulated-wifi-shepherd-services)
1483           (service-extension kernel-module-loader-service-type
1484                              (const '("mac80211_hwsim")))))
1485    (default-value (hostapd-configuration
1486                    (interface "wlan1")
1487                    (ssid "Test Network")))
1488    (description "Run hostapd to simulate WiFi connectivity.")))
1489
1490 \f
1491 ;;;
1492 ;;; Open vSwitch
1493 ;;;
1494
1495 (define-record-type* <openvswitch-configuration>
1496   openvswitch-configuration make-openvswitch-configuration
1497   openvswitch-configuration?
1498   (package openvswitch-configuration-package
1499            (default openvswitch)))
1500
1501 (define openvswitch-activation
1502   (match-lambda
1503     (($ <openvswitch-configuration> package)
1504      (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
1505        (with-imported-modules '((guix build utils))
1506          #~(begin
1507              (use-modules (guix build utils))
1508              (mkdir-p "/var/run/openvswitch")
1509              (mkdir-p "/var/lib/openvswitch")
1510              (let ((conf.db "/var/lib/openvswitch/conf.db"))
1511                (unless (file-exists? conf.db)
1512                  (system* #$ovsdb-tool "create" conf.db)))))))))
1513
1514 (define openvswitch-shepherd-service
1515   (match-lambda
1516     (($ <openvswitch-configuration> package)
1517      (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
1518            (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
1519        (list
1520         (shepherd-service
1521          (provision '(ovsdb))
1522          (documentation "Run the Open vSwitch database server.")
1523          (start #~(make-forkexec-constructor
1524                    (list #$ovsdb-server "--pidfile"
1525                          "--remote=punix:/var/run/openvswitch/db.sock")
1526                    #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
1527          (stop #~(make-kill-destructor)))
1528         (shepherd-service
1529          (provision '(vswitchd))
1530          (requirement '(ovsdb))
1531          (documentation "Run the Open vSwitch daemon.")
1532          (start #~(make-forkexec-constructor
1533                    (list #$ovs-vswitchd "--pidfile")
1534                    #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
1535          (stop #~(make-kill-destructor))))))))
1536
1537 (define openvswitch-service-type
1538   (service-type
1539    (name 'openvswitch)
1540    (extensions
1541     (list (service-extension activation-service-type
1542                              openvswitch-activation)
1543           (service-extension profile-service-type
1544                              (compose list openvswitch-configuration-package))
1545           (service-extension shepherd-root-service-type
1546                              openvswitch-shepherd-service)))
1547    (description
1548     "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
1549 switch designed to enable massive network automation through programmatic
1550 extension.")
1551    (default-value (openvswitch-configuration))))
1552
1553 ;;;
1554 ;;; iptables
1555 ;;;
1556
1557 (define %iptables-accept-all-rules
1558   (plain-file "iptables-accept-all.rules"
1559               "*filter
1560 :INPUT ACCEPT
1561 :FORWARD ACCEPT
1562 :OUTPUT ACCEPT
1563 COMMIT
1564 "))
1565
1566 (define-record-type* <iptables-configuration>
1567   iptables-configuration make-iptables-configuration iptables-configuration?
1568   (iptables iptables-configuration-iptables
1569             (default iptables))
1570   (ipv4-rules iptables-configuration-ipv4-rules
1571               (default %iptables-accept-all-rules))
1572   (ipv6-rules iptables-configuration-ipv6-rules
1573               (default %iptables-accept-all-rules)))
1574
1575 (define iptables-shepherd-service
1576   (match-lambda
1577     (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
1578      (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
1579            (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
1580        (shepherd-service
1581         (documentation "Packet filtering framework")
1582         (provision '(iptables))
1583         (start #~(lambda _
1584                    (invoke #$iptables-restore #$ipv4-rules)
1585                    (invoke #$ip6tables-restore #$ipv6-rules)))
1586         (stop #~(lambda _
1587                   (invoke #$iptables-restore #$%iptables-accept-all-rules)
1588                   (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
1589
1590 (define iptables-service-type
1591   (service-type
1592    (name 'iptables)
1593    (description
1594     "Run @command{iptables-restore}, setting up the specified rules.")
1595    (extensions
1596     (list (service-extension shepherd-root-service-type
1597                              (compose list iptables-shepherd-service))))))
1598
1599 ;;;
1600 ;;; nftables
1601 ;;;
1602
1603 (define %default-nftables-ruleset
1604   (plain-file "nftables.conf"
1605               "# A simple and safe firewall
1606 table inet filter {
1607   chain input {
1608     type filter hook input priority 0; policy drop;
1609
1610     # early drop of invalid connections
1611     ct state invalid drop
1612
1613     # allow established/related connections
1614     ct state { established, related } accept
1615
1616     # allow from loopback
1617     iifname lo accept
1618
1619     # allow icmp
1620     ip protocol icmp accept
1621     ip6 nexthdr icmpv6 accept
1622
1623     # allow ssh
1624     tcp dport ssh accept
1625
1626     # reject everything else
1627     reject with icmpx type port-unreachable
1628   }
1629   chain forward {
1630     type filter hook forward priority 0; policy drop;
1631   }
1632   chain output {
1633     type filter hook output priority 0; policy accept;
1634   }
1635 }
1636 "))
1637
1638 (define-record-type* <nftables-configuration>
1639   nftables-configuration
1640   make-nftables-configuration
1641   nftables-configuration?
1642   (package nftables-configuration-package
1643            (default nftables))
1644   (ruleset nftables-configuration-ruleset ; file-like object
1645            (default %default-nftables-ruleset)))
1646
1647 (define nftables-shepherd-service
1648   (match-lambda
1649     (($ <nftables-configuration> package ruleset)
1650      (let ((nft (file-append package "/sbin/nft")))
1651        (shepherd-service
1652         (documentation "Packet filtering and classification")
1653         (provision '(nftables))
1654         (start #~(lambda _
1655                    (invoke #$nft "--file" #$ruleset)))
1656         (stop #~(lambda _
1657                   (invoke #$nft "flush" "ruleset"))))))))
1658
1659 (define nftables-service-type
1660   (service-type
1661    (name 'nftables)
1662    (description
1663     "Run @command{nft}, setting up the specified ruleset.")
1664    (extensions
1665     (list (service-extension shepherd-root-service-type
1666                              (compose list nftables-shepherd-service))
1667           (service-extension profile-service-type
1668                              (compose list nftables-configuration-package))))
1669    (default-value (nftables-configuration))))
1670
1671 \f
1672 ;;;
1673 ;;; PageKite
1674 ;;;
1675
1676 (define-record-type* <pagekite-configuration>
1677   pagekite-configuration
1678   make-pagekite-configuration
1679   pagekite-configuration?
1680   (package pagekite-configuration-package
1681            (default pagekite))
1682   (kitename pagekite-configuration-kitename
1683             (default #f))
1684   (kitesecret pagekite-configuration-kitesecret
1685               (default #f))
1686   (frontend pagekite-configuration-frontend
1687             (default #f))
1688   (kites pagekite-configuration-kites
1689          (default '("http:@kitename:localhost:80:@kitesecret")))
1690   (extra-file pagekite-configuration-extra-file
1691               (default #f)))
1692
1693 (define (pagekite-configuration-file config)
1694   (match-record config <pagekite-configuration>
1695     (package kitename kitesecret frontend kites extra-file)
1696     (mixed-text-file "pagekite.rc"
1697                      (if extra-file
1698                          (string-append "optfile = " extra-file "\n")
1699                          "")
1700                      (if kitename
1701                          (string-append "kitename = " kitename "\n")
1702                          "")
1703                      (if kitesecret
1704                          (string-append "kitesecret = " kitesecret "\n")
1705                          "")
1706                      (if frontend
1707                          (string-append "frontend = " frontend "\n")
1708                          "defaults\n")
1709                      (string-join (map (lambda (kite)
1710                                          (string-append "service_on = " kite))
1711                                        kites)
1712                                   "\n"
1713                                   'suffix))))
1714
1715 (define (pagekite-shepherd-service config)
1716   (match-record config <pagekite-configuration>
1717     (package kitename kitesecret frontend kites extra-file)
1718     (with-imported-modules (source-module-closure
1719                             '((gnu build shepherd)
1720                               (gnu system file-systems)))
1721       (shepherd-service
1722        (documentation "Run the PageKite service.")
1723        (provision '(pagekite))
1724        (requirement '(networking))
1725        (modules '((gnu build shepherd)
1726                   (gnu system file-systems)))
1727        (start #~(make-forkexec-constructor/container
1728                  (list #$(file-append package "/bin/pagekite")
1729                        "--clean"
1730                        "--nullui"
1731                        "--nocrashreport"
1732                        "--runas=pagekite:pagekite"
1733                        (string-append "--optfile="
1734                                       #$(pagekite-configuration-file config)))
1735                  #:log-file "/var/log/pagekite.log"
1736                  #:mappings #$(if extra-file
1737                                   #~(list (file-system-mapping
1738                                            (source #$extra-file)
1739                                            (target source)))
1740                                   #~'())))
1741        ;; SIGTERM doesn't always work for some reason.
1742        (stop #~(make-kill-destructor SIGINT))))))
1743
1744 (define %pagekite-accounts
1745   (list (user-group (name "pagekite") (system? #t))
1746         (user-account
1747          (name "pagekite")
1748          (group "pagekite")
1749          (system? #t)
1750          (comment "PageKite user")
1751          (home-directory "/var/empty")
1752          (shell (file-append shadow "/sbin/nologin")))))
1753
1754 (define pagekite-service-type
1755   (service-type
1756    (name 'pagekite)
1757    (default-value (pagekite-configuration))
1758    (extensions
1759     (list (service-extension shepherd-root-service-type
1760                              (compose list pagekite-shepherd-service))
1761           (service-extension account-service-type
1762                              (const %pagekite-accounts))))
1763    (description
1764     "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
1765 local servers publicly accessible on the web, even behind NATs and firewalls.")))
1766
1767 \f
1768 ;;;
1769 ;;; Yggdrasil
1770 ;;;
1771
1772 (define-record-type* <yggdrasil-configuration>
1773   yggdrasil-configuration
1774   make-yggdrasil-configuration
1775   yggdrasil-configuration?
1776   (package yggdrasil-configuration-package
1777            (default yggdrasil))
1778   (json-config yggdrasil-configuration-json-config
1779                (default '()))
1780   (config-file yggdrasil-config-file
1781                (default "/etc/yggdrasil-private.conf"))
1782   (autoconf? yggdrasil-configuration-autoconf?
1783              (default #f))
1784   (log-level yggdrasil-configuration-log-level
1785              (default 'info))
1786   (log-to yggdrasil-configuration-log-to
1787           (default 'stdout)))
1788
1789 (define (yggdrasil-configuration-file config)
1790   (define (scm->yggdrasil-json x)
1791     (define key-value?
1792       dotted-list?)
1793     (define (param->camel str)
1794       (string-concatenate
1795        (map
1796         string-capitalize
1797         (string-split str (cut eqv? <> #\-)))))
1798     (cond
1799      ((key-value? x)
1800       (let ((k (car x))
1801             (v (cdr x)))
1802         (cons
1803          (if (symbol? k)
1804              (param->camel (symbol->string k))
1805              k)
1806          v)))
1807      ((list? x) (map scm->yggdrasil-json x))
1808      ((vector? x) (vector-map scm->yggdrasil-json x))
1809      (else x)))
1810   (computed-file
1811    "yggdrasil.conf"
1812    #~(call-with-output-file #$output
1813        (lambda (port)
1814          ;; it's HJSON, so comments are a-okay
1815          (display "# Generated by yggdrasil-service\n" port)
1816          (display #$(scm->json-string
1817                      (scm->yggdrasil-json
1818                       (yggdrasil-configuration-json-config config)))
1819                   port)))))
1820
1821 (define (yggdrasil-shepherd-service config)
1822   "Return a <shepherd-service> for yggdrasil with CONFIG."
1823   (define yggdrasil-command
1824     #~(append
1825        (list (string-append
1826               #$(yggdrasil-configuration-package config)
1827               "/bin/yggdrasil")
1828              "-useconffile"
1829              #$(yggdrasil-configuration-file config))
1830        (if #$(yggdrasil-configuration-autoconf? config)
1831            '("-autoconf")
1832            '())
1833        (let ((extraconf #$(yggdrasil-config-file config)))
1834          (if extraconf
1835              (list "-extraconffile" extraconf)
1836              '()))
1837        (list "-loglevel"
1838              #$(symbol->string
1839                 (yggdrasil-configuration-log-level config))
1840              "-logto"
1841              #$(symbol->string
1842                 (yggdrasil-configuration-log-to config)))))
1843   (list (shepherd-service
1844          (documentation "Connect to the Yggdrasil mesh network")
1845          (provision '(yggdrasil))
1846          (requirement '(networking))
1847          (start #~(make-forkexec-constructor
1848                    #$yggdrasil-command
1849                    #:log-file "/var/log/yggdrasil.log"
1850                    #:group "yggdrasil"))
1851          (stop #~(make-kill-destructor)))))
1852
1853 (define %yggdrasil-accounts
1854   (list (user-group (name "yggdrasil") (system? #t))))
1855
1856 (define yggdrasil-service-type
1857   (service-type
1858    (name 'yggdrasil)
1859    (description
1860     "Connect to the Yggdrasil mesh network.
1861 See yggdrasil -genconf for config options.")
1862    (extensions
1863     (list (service-extension shepherd-root-service-type
1864                              yggdrasil-shepherd-service)
1865           (service-extension account-service-type
1866                              (const %yggdrasil-accounts))
1867           (service-extension profile-service-type
1868                              (compose list yggdrasil-configuration-package))))))
1869
1870 \f
1871 ;;;
1872 ;;; Keepalived
1873 ;;;
1874
1875 (define-record-type* <keepalived-configuration>
1876   keepalived-configuration make-keepalived-configuration
1877   keepalived-configuration?
1878   (keepalived  keepalived-configuration-keepalived  ;<package>
1879                (default keepalived))
1880   (config-file keepalived-configuration-config-file ;file-like
1881                (default #f)))
1882
1883 (define keepalived-shepherd-service
1884   (match-lambda
1885     (($ <keepalived-configuration> keepalived config-file)
1886      (list
1887       (shepherd-service
1888        (provision '(keepalived))
1889        (documentation "Run keepalived.")
1890        (requirement '(loopback))
1891        (start #~(make-forkexec-constructor
1892                  (list (string-append #$keepalived "/sbin/keepalived")
1893                        "--dont-fork" "--log-console" "--log-detail"
1894                        "--pid=/var/run/keepalived.pid"
1895                        (string-append "--use-file=" #$config-file))
1896                  #:pid-file "/var/run/keepalived.pid"
1897                  #:log-file "/var/log/keepalived.log"))
1898        (respawn? #f)
1899        (stop #~(make-kill-destructor)))))))
1900
1901 (define keepalived-service-type
1902   (service-type (name 'keepalived)
1903                 (extensions (list (service-extension shepherd-root-service-type
1904                                                      keepalived-shepherd-service)))
1905                 (description
1906                  "Run @uref{https://www.keepalived.org/, Keepalived}
1907 routing software.")))
1908
1909 ;;; networking.scm ends here