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