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