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