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