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