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