gnu/services/networking.scm

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