gnu/services/networking.scm

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