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