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-shepherd-service config)
 508   (match-record config <openntpd-configuration>
 509     (openntpd listen-on query-from sensor server servers constraint-from
 510               constraints-from allow-large-adjustment?)
 511     (let ()
 512       (define config
 513         (string-join
 514           (filter-map
 515             (lambda (field value)
 516               (string-join
 517                 (map (cut string-append field <> "\n")
 518                      value)))
 519             '("listen on " "query from " "sensor " "server " "servers "
 520               "constraint from ")
 521             (list listen-on query-from sensor server servers constraint-from))
 522           ;; The 'constraints from' field needs to be enclosed in double quotes.
 523           (string-join
 524             (map (cut string-append "constraints from \"" <> "\"\n")
 525                  constraints-from))))
 526
 527       (define ntpd.conf
 528         (plain-file "ntpd.conf" config))
 529
 530       (list (shepherd-service
 531               (provision '(ntpd))
 532               (documentation "Run the Network Time Protocol (NTP) daemon.")
 533               (requirement '(user-processes networking))
 534               (start #~(make-forkexec-constructor
 535                          (list (string-append #$openntpd "/sbin/ntpd")
 536                                "-f" #$ntpd.conf
 537                                "-d" ;; don't daemonize
 538                                #$@(if allow-large-adjustment?
 539                                     '("-s")
 540                                     '()))
 541                          ;; When ntpd is daemonized it repeatedly tries to respawn
 542                          ;; while running, leading shepherd to disable it.  To
 543                          ;; prevent spamming stderr, redirect output to logfile.
 544                          #:log-file "/var/log/ntpd"))
 545               (stop #~(make-kill-destructor)))))))
 546
 547 (define (openntpd-service-activation config)
 548   "Return the activation gexp for CONFIG."
 549   (with-imported-modules '((guix build utils))
 550     #~(begin
 551         (use-modules (guix build utils))
 552
 553         (mkdir-p "/var/db")
 554         (mkdir-p "/var/run")
 555         (unless (file-exists? "/var/db/ntpd.drift")
 556           (with-output-to-file "/var/db/ntpd.drift"
 557                                (lambda _
 558                                  (format #t "0.0")))))))
 559
 560 (define openntpd-service-type
 561   (service-type (name 'openntpd)
 562                 (extensions
 563                  (list (service-extension shepherd-root-service-type
 564                                           openntpd-shepherd-service)
 565                        (service-extension account-service-type
 566                                           (const %ntp-accounts))
 567                        (service-extension profile-service-type
 568                                           (compose list openntpd-configuration-openntpd))
 569                        (service-extension activation-service-type
 570                                           openntpd-service-activation)))
 571                 (default-value (openntpd-configuration))
 572                 (description
 573                  "Run the @command{ntpd}, the Network Time Protocol (NTP)
 574 daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}.  The
 575 daemon will keep the system clock synchronized with that of the given servers.")))
 576
 577 \f
 578 ;;;
 579 ;;; Inetd.
 580 ;;;
 581
 582 (define-record-type* <inetd-configuration> inetd-configuration
 583   make-inetd-configuration
 584   inetd-configuration?
 585   (program           inetd-configuration-program   ;file-like
 586                      (default (file-append inetutils "/libexec/inetd")))
 587   (entries           inetd-configuration-entries   ;list of <inetd-entry>
 588                      (default '())))
 589
 590 (define-record-type* <inetd-entry> inetd-entry make-inetd-entry
 591   inetd-entry?
 592   (node              inetd-entry-node         ;string or #f
 593                      (default #f))
 594   (name              inetd-entry-name)        ;string, from /etc/services
 595
 596   (socket-type       inetd-entry-socket-type) ;stream | dgram | raw |
 597                                               ;rdm | seqpacket
 598   (protocol          inetd-entry-protocol)    ;string, from /etc/protocols
 599
 600   (wait?             inetd-entry-wait?        ;Boolean
 601                      (default #t))
 602   (user              inetd-entry-user)        ;string
 603
 604   (program           inetd-entry-program      ;string or file-like object
 605                      (default "internal"))
 606   (arguments         inetd-entry-arguments    ;list of strings or file-like objects
 607                      (default '())))
 608
 609 (define (inetd-config-file entries)
 610   (apply mixed-text-file "inetd.conf"
 611          (map
 612           (lambda (entry)
 613             (let* ((node (inetd-entry-node entry))
 614                    (name (inetd-entry-name entry))
 615                    (socket
 616                     (if node (string-append node ":" name) name))
 617                    (type
 618                     (match (inetd-entry-socket-type entry)
 619                       ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
 620                        (symbol->string (inetd-entry-socket-type entry)))))
 621                    (protocol (inetd-entry-protocol entry))
 622                    (wait (if (inetd-entry-wait? entry) "wait" "nowait"))
 623                    (user (inetd-entry-user entry))
 624                    (program (inetd-entry-program entry))
 625                    (args (inetd-entry-arguments entry)))
 626               #~(string-append
 627                  (string-join
 628                   (list #$@(list socket type protocol wait user program) #$@args)
 629                   " ") "\n")))
 630           entries)))
 631
 632 (define inetd-shepherd-service
 633   (match-lambda
 634     (($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
 635     (($ <inetd-configuration> program entries)
 636      (list
 637       (shepherd-service
 638        (documentation "Run inetd.")
 639        (provision '(inetd))
 640        (requirement '(user-processes networking syslogd))
 641        (start #~(make-forkexec-constructor
 642                  (list #$program #$(inetd-config-file entries))
 643                  #:pid-file "/var/run/inetd.pid"))
 644        (stop #~(make-kill-destructor)))))))
 645
 646 (define-public inetd-service-type
 647   (service-type
 648    (name 'inetd)
 649    (extensions
 650     (list (service-extension shepherd-root-service-type
 651                              inetd-shepherd-service)))
 652
 653    ;; The service can be extended with additional lists of entries.
 654    (compose concatenate)
 655    (extend (lambda (config entries)
 656              (inetd-configuration
 657               (inherit config)
 658               (entries (append (inetd-configuration-entries config)
 659                                entries)))))
 660    (description
 661     "Start @command{inetd}, the @dfn{Internet superserver}.  It is responsible
 662 for listening on Internet sockets and spawning the corresponding services on
 663 demand.")))
 664
 665 \f
 666 ;;;
 667 ;;; Tor.
 668 ;;;
 669
 670 (define-record-type* <tor-configuration>
 671   tor-configuration make-tor-configuration
 672   tor-configuration?
 673   (tor              tor-configuration-tor
 674                     (default tor))
 675   (config-file      tor-configuration-config-file
 676                     (default (plain-file "empty" "")))
 677   (hidden-services  tor-configuration-hidden-services
 678                     (default '()))
 679   (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
 680                      (default 'tcp)))
 681
 682 (define %tor-accounts
 683   ;; User account and groups for Tor.
 684   (list (user-group (name "tor") (system? #t))
 685         (user-account
 686          (name "tor")
 687          (group "tor")
 688          (system? #t)
 689          (comment "Tor daemon user")
 690          (home-directory "/var/empty")
 691          (shell (file-append shadow "/sbin/nologin")))))
 692
 693 (define-record-type <hidden-service>
 694   (hidden-service name mapping)
 695   hidden-service?
 696   (name    hidden-service-name)                   ;string
 697   (mapping hidden-service-mapping))               ;list of port/address tuples
 698
 699 (define (tor-configuration->torrc config)
 700   "Return a 'torrc' file for CONFIG."
 701   (match config
 702     (($ <tor-configuration> tor config-file services socks-socket-type)
 703      (computed-file
 704       "torrc"
 705       (with-imported-modules '((guix build utils))
 706         #~(begin
 707             (use-modules (guix build utils)
 708                          (ice-9 match))
 709
 710             (call-with-output-file #$output
 711               (lambda (port)
 712                 (display "\
 713 ### These lines were generated from your system configuration:
 714 User tor
 715 DataDirectory /var/lib/tor
 716 PidFile /var/run/tor/tor.pid
 717 Log notice syslog\n" port)
 718                 (when (eq? 'unix '#$socks-socket-type)
 719                   (display "\
 720 SocksPort unix:/var/run/tor/socks-sock
 721 UnixSocksGroupWritable 1\n" port))
 722
 723                 (for-each (match-lambda
 724                             ((service (ports hosts) ...)
 725                              (format port "\
 726 HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
 727                                      service)
 728                              (for-each (lambda (tcp-port host)
 729                                          (format port "\
 730 HiddenServicePort ~a ~a~%"
 731                                                  tcp-port host))
 732                                        ports hosts)))
 733                           '#$(map (match-lambda
 734                                     (($ <hidden-service> name mapping)
 735                                      (cons name mapping)))
 736                                   services))
 737
 738                 (display "\
 739 ### End of automatically generated lines.\n\n" port)
 740
 741                 ;; Append the user's config file.
 742                 (call-with-input-file #$config-file
 743                   (lambda (input)
 744                     (dump-port input port)))
 745                 #t))))))))
 746
 747 (define (tor-shepherd-service config)
 748   "Return a <shepherd-service> running Tor."
 749   (match config
 750     (($ <tor-configuration> tor)
 751      (let ((torrc (tor-configuration->torrc config)))
 752        (with-imported-modules (source-module-closure
 753                                '((gnu build shepherd)
 754                                  (gnu system file-systems)))
 755          (list (shepherd-service
 756                 (provision '(tor))
 757
 758                 ;; Tor needs at least one network interface to be up, hence the
 759                 ;; dependency on 'loopback'.
 760                 (requirement '(user-processes loopback syslogd))
 761
 762                 (modules '((gnu build shepherd)
 763                            (gnu system file-systems)))
 764
 765                 (start #~(make-forkexec-constructor/container
 766                           (list #$(file-append tor "/bin/tor") "-f" #$torrc)
 767
 768                           #:mappings (list (file-system-mapping
 769                                             (source "/var/lib/tor")
 770                                             (target source)
 771                                             (writable? #t))
 772                                            (file-system-mapping
 773                                             (source "/dev/log") ;for syslog
 774                                             (target source))
 775                                            (file-system-mapping
 776                                             (source "/var/run/tor")
 777                                             (target source)
 778                                             (writable? #t)))
 779                           #:pid-file "/var/run/tor/tor.pid"))
 780                 (stop #~(make-kill-destructor))
 781                 (documentation "Run the Tor anonymous network overlay."))))))))
 782
 783 (define (tor-activation config)
 784   "Set up directories for Tor and its hidden services, if any."
 785   #~(begin
 786       (use-modules (guix build utils))
 787
 788       (define %user
 789         (getpw "tor"))
 790
 791       (define (initialize service)
 792         (let ((directory (string-append "/var/lib/tor/hidden-services/"
 793                                         service)))
 794           (mkdir-p directory)
 795           (chown directory (passwd:uid %user) (passwd:gid %user))
 796
 797           ;; The daemon bails out if we give wider permissions.
 798           (chmod directory #o700)))
 799
 800       ;; Allow Tor to write its PID file.
 801       (mkdir-p "/var/run/tor")
 802       (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
 803       ;; Set the group permissions to rw so that if the system administrator
 804       ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
 805       ;; of the "tor" group will be able to use the SOCKS socket.
 806       (chmod "/var/run/tor" #o750)
 807
 808       ;; Allow Tor to access the hidden services' directories.
 809       (mkdir-p "/var/lib/tor")
 810       (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
 811       (chmod "/var/lib/tor" #o700)
 812
 813       ;; Make sure /var/lib is accessible to the 'tor' user.
 814       (chmod "/var/lib" #o755)
 815
 816       (for-each initialize
 817                 '#$(map hidden-service-name
 818                         (tor-configuration-hidden-services config)))))
 819
 820 (define tor-service-type
 821   (service-type (name 'tor)
 822                 (extensions
 823                  (list (service-extension shepherd-root-service-type
 824                                           tor-shepherd-service)
 825                        (service-extension account-service-type
 826                                           (const %tor-accounts))
 827                        (service-extension activation-service-type
 828                                           tor-activation)))
 829
 830                 ;; This can be extended with hidden services.
 831                 (compose concatenate)
 832                 (extend (lambda (config services)
 833                           (tor-configuration
 834                            (inherit config)
 835                            (hidden-services
 836                             (append (tor-configuration-hidden-services config)
 837                                     services)))))
 838                 (default-value (tor-configuration))
 839                 (description
 840                  "Run the @uref{https://torproject.org, Tor} anonymous
 841 networking daemon.")))
 842
 843 (define-deprecated (tor-service #:optional
 844                                 (config-file (plain-file "empty" ""))
 845                                 #:key (tor tor))
 846   tor-service-type
 847   "Return a service to run the @uref{https://torproject.org, Tor} anonymous
 848 networking daemon.
 849
 850 The daemon runs as the @code{tor} unprivileged user.  It is passed
 851 @var{config-file}, a file-like object, with an additional @code{User tor} line
 852 and lines for hidden services added via @code{tor-hidden-service}.  Run
 853 @command{man tor} for information about the configuration file."
 854   (service tor-service-type
 855            (tor-configuration (tor tor)
 856                               (config-file config-file))))
 857
 858 (define tor-hidden-service-type
 859   ;; A type that extends Tor with hidden services.
 860   (service-type (name 'tor-hidden-service)
 861                 (extensions
 862                  (list (service-extension tor-service-type list)))
 863                 (description
 864                  "Define a new Tor @dfn{hidden service}.")))
 865
 866 (define (tor-hidden-service name mapping)
 867   "Define a new Tor @dfn{hidden service} called @var{name} and implementing
 868 @var{mapping}.  @var{mapping} is a list of port/host tuples, such as:
 869
 870 @example
 871  '((22 \"127.0.0.1:22\")
 872    (80 \"127.0.0.1:8080\"))
 873 @end example
 874
 875 In this example, port 22 of the hidden service is mapped to local port 22, and
 876 port 80 is mapped to local port 8080.
 877
 878 This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
 879 the @file{hostname} file contains the @code{.onion} host name for the hidden
 880 service.
 881
 882 See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
 883 project's documentation} for more information."
 884   (service tor-hidden-service-type
 885            (hidden-service name mapping)))
 886
 887 \f
 888 ;;;
 889 ;;; Wicd.
 890 ;;;
 891
 892 (define %wicd-activation
 893   ;; Activation gexp for Wicd.
 894   #~(begin
 895       (use-modules (guix build utils))
 896
 897       (mkdir-p "/etc/wicd")
 898       (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
 899         (unless (file-exists? file-name)
 900           (copy-file (string-append #$wicd file-name)
 901                      file-name)))
 902
 903       ;; Wicd invokes 'wpa_supplicant', which needs this directory for its
 904       ;; named socket files.
 905       (mkdir-p "/var/run/wpa_supplicant")
 906       (chmod "/var/run/wpa_supplicant" #o750)))
 907
 908 (define (wicd-shepherd-service wicd)
 909   "Return a shepherd service for WICD."
 910   (list (shepherd-service
 911          (documentation "Run the Wicd network manager.")
 912          (provision '(networking))
 913          (requirement '(user-processes dbus-system loopback))
 914          (start #~(make-forkexec-constructor
 915                    (list (string-append #$wicd "/sbin/wicd")
 916                          "--no-daemon")))
 917          (stop #~(make-kill-destructor)))))
 918
 919 (define wicd-service-type
 920   (service-type (name 'wicd)
 921                 (extensions
 922                  (list (service-extension shepherd-root-service-type
 923                                           wicd-shepherd-service)
 924                        (service-extension dbus-root-service-type
 925                                           list)
 926                        (service-extension activation-service-type
 927                                           (const %wicd-activation))
 928
 929                        ;; Add Wicd to the global profile.
 930                        (service-extension profile-service-type list)))
 931                 (description
 932                  "Run @url{https://launchpad.net/wicd,Wicd}, a network
 933 management daemon that aims to simplify wired and wireless networking.")))
 934
 935 (define* (wicd-service #:key (wicd wicd))
 936   "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
 937 management daemon that aims to simplify wired and wireless networking.
 938
 939 This service adds the @var{wicd} package to the global profile, providing
 940 several commands to interact with the daemon and configure networking:
 941 @command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
 942 and @command{wicd-curses} user interfaces."
 943   (service wicd-service-type wicd))
 944
 945 \f
 946 ;;;
 947 ;;; ModemManager
 948 ;;;
 949
 950 (define-record-type* <modem-manager-configuration>
 951   modem-manager-configuration make-modem-manager-configuration
 952   modem-manager-configuration?
 953   (modem-manager modem-manager-configuration-modem-manager
 954                    (default modem-manager)))
 955
 956 \f
 957 ;;;
 958 ;;; NetworkManager
 959 ;;;
 960
 961 (define-record-type* <network-manager-configuration>
 962   network-manager-configuration make-network-manager-configuration
 963   network-manager-configuration?
 964   (network-manager network-manager-configuration-network-manager
 965                    (default network-manager))
 966   (dns network-manager-configuration-dns
 967        (default "default"))
 968   (vpn-plugins network-manager-vpn-plugins        ;list of <package>
 969                (default '())))
 970
 971 (define network-manager-activation
 972   ;; Activation gexp for NetworkManager
 973   (match-lambda
 974     (($ <network-manager-configuration> network-manager dns vpn-plugins)
 975      #~(begin
 976          (use-modules (guix build utils))
 977          (mkdir-p "/etc/NetworkManager/system-connections")
 978          #$@(if (equal? dns "dnsmasq")
 979                 ;; create directory to store dnsmasq lease file
 980                 '((mkdir-p "/var/lib/misc"))
 981                 '())))))
 982
 983 (define (vpn-plugin-directory plugins)
 984   "Return a directory containing PLUGINS, the NM VPN plugins."
 985   (directory-union "network-manager-vpn-plugins" plugins))
 986
 987 (define network-manager-environment
 988   (match-lambda
 989     (($ <network-manager-configuration> network-manager dns vpn-plugins)
 990      ;; Define this variable in the global environment such that
 991      ;; "nmcli connection import type openvpn file foo.ovpn" works.
 992      `(("NM_VPN_PLUGIN_DIR"
 993         . ,(file-append (vpn-plugin-directory vpn-plugins)
 994                         "/lib/NetworkManager/VPN"))))))
 995
 996 (define network-manager-shepherd-service
 997   (match-lambda
 998     (($ <network-manager-configuration> network-manager dns vpn-plugins)
 999      (let ((conf (plain-file "NetworkManager.conf"
1000                              (string-append "[main]\ndns=" dns "\n")))
1001            (vpn  (vpn-plugin-directory vpn-plugins)))
1002        (list (shepherd-service
1003               (documentation "Run the NetworkManager.")
1004               (provision '(networking))
1005               (requirement '(user-processes dbus-system wpa-supplicant loopback))
1006               (start #~(make-forkexec-constructor
1007                         (list (string-append #$network-manager
1008                                              "/sbin/NetworkManager")
1009                               (string-append "--config=" #$conf)
1010                               "--no-daemon")
1011                         #:environment-variables
1012                         (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
1013                                              "/lib/NetworkManager/VPN")
1014                               ;; Override non-existent default users
1015                               "NM_OPENVPN_USER="
1016                               "NM_OPENVPN_GROUP=")))
1017               (stop #~(make-kill-destructor))))))))
1018
1019 (define network-manager-service-type
1020   (let
1021       ((config->packages
1022         (match-lambda
1023          (($ <network-manager-configuration> network-manager _ vpn-plugins)
1024           `(,network-manager ,@vpn-plugins)))))
1025
1026     (service-type
1027      (name 'network-manager)
1028      (extensions
1029       (list (service-extension shepherd-root-service-type
1030                                network-manager-shepherd-service)
1031             (service-extension dbus-root-service-type config->packages)
1032             (service-extension polkit-service-type
1033                                (compose
1034                                 list
1035                                 network-manager-configuration-network-manager))
1036             (service-extension activation-service-type
1037                                network-manager-activation)
1038             (service-extension session-environment-service-type
1039                                network-manager-environment)
1040             ;; Add network-manager to the system profile.
1041             (service-extension profile-service-type config->packages)))
1042      (default-value (network-manager-configuration))
1043      (description
1044       "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
1045 NetworkManager}, a network management daemon that aims to simplify wired and
1046 wireless networking."))))
1047
1048 \f
1049 ;;;
1050 ;;; Connman
1051 ;;;
1052
1053 (define-record-type* <connman-configuration>
1054   connman-configuration make-connman-configuration
1055   connman-configuration?
1056   (connman      connman-configuration-connman
1057                 (default connman))
1058   (disable-vpn? connman-configuration-disable-vpn?
1059                 (default #f)))
1060
1061 (define (connman-activation config)
1062   (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
1063     (with-imported-modules '((guix build utils))
1064       #~(begin
1065           (use-modules (guix build utils))
1066           (mkdir-p "/var/lib/connman/")
1067           (unless #$disable-vpn?
1068             (mkdir-p "/var/lib/connman-vpn/"))))))
1069
1070 (define (connman-shepherd-service config)
1071   "Return a shepherd service for Connman"
1072   (and
1073    (connman-configuration? config)
1074    (let ((connman      (connman-configuration-connman config))
1075          (disable-vpn? (connman-configuration-disable-vpn? config)))
1076      (list (shepherd-service
1077             (documentation "Run Connman")
1078             (provision '(networking))
1079             (requirement
1080              '(user-processes dbus-system loopback wpa-supplicant))
1081             (start #~(make-forkexec-constructor
1082                       (list (string-append #$connman
1083                                            "/sbin/connmand")
1084                             "-n" "-r"
1085                             #$@(if disable-vpn? '("--noplugin=vpn") '()))
1086
1087                       ;; As connman(8) notes, when passing '-n', connman
1088                       ;; "directs log output to the controlling terminal in
1089                       ;; addition to syslog."  Redirect stdout and stderr
1090                       ;; to avoid spamming the console (XXX: for some reason
1091                       ;; redirecting to /dev/null doesn't work.)
1092                       #:log-file "/var/log/connman.log"))
1093             (stop #~(make-kill-destructor)))))))
1094
1095 (define connman-service-type
1096   (let ((connman-package (compose list connman-configuration-connman)))
1097     (service-type (name 'connman)
1098                   (extensions
1099                    (list (service-extension shepherd-root-service-type
1100                                             connman-shepherd-service)
1101                          (service-extension polkit-service-type
1102                                             connman-package)
1103                          (service-extension dbus-root-service-type
1104                                             connman-package)
1105                          (service-extension activation-service-type
1106                                             connman-activation)
1107                          ;; Add connman to the system profile.
1108                          (service-extension profile-service-type
1109                                             connman-package)))
1110                   (default-value (connman-configuration))
1111                   (description
1112                    "Run @url{https://01.org/connman,Connman},
1113 a network connection manager."))))
1114
1115 \f
1116 ;;;
1117 ;;; Modem manager
1118 ;;;
1119
1120 (define modem-manager-service-type
1121   (let ((config->package
1122          (match-lambda
1123           (($ <modem-manager-configuration> modem-manager)
1124            (list modem-manager)))))
1125     (service-type (name 'modem-manager)
1126                   (extensions
1127                    (list (service-extension dbus-root-service-type
1128                                             config->package)
1129                          (service-extension udev-service-type
1130                                             config->package)
1131                          (service-extension polkit-service-type
1132                                             config->package)))
1133                   (default-value (modem-manager-configuration))
1134                   (description
1135                    "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
1136 ModemManager}, a modem management daemon that aims to simplify dialup
1137 networking."))))
1138
1139 \f
1140 ;;;
1141 ;;; USB_ModeSwitch
1142 ;;;
1143
1144 (define-record-type* <usb-modeswitch-configuration>
1145   usb-modeswitch-configuration make-usb-modeswitch-configuration
1146   usb-modeswitch-configuration?
1147   (usb-modeswitch      usb-modeswitch-configuration-usb-modeswitch
1148                        (default usb-modeswitch))
1149   (usb-modeswitch-data usb-modeswitch-configuration-usb-modeswitch-data
1150                        (default usb-modeswitch-data))
1151   (config-file         usb-modeswitch-configuration-config-file
1152                        (default #~(string-append #$usb-modeswitch:dispatcher
1153                                                  "/etc/usb_modeswitch.conf"))))
1154
1155 (define (usb-modeswitch-sh usb-modeswitch config-file)
1156   "Build a copy of usb_modeswitch.sh located in package USB-MODESWITCH,
1157 modified to pass the CONFIG-FILE in its calls to usb_modeswitch_dispatcher,
1158 and wrap it to actually find the dispatcher in USB-MODESWITCH.  The script
1159 will be run by USB_ModeSwitch’s udev rules file when a modeswitchable USB
1160 device is detected."
1161   (computed-file
1162    "usb_modeswitch-sh"
1163    (with-imported-modules '((guix build utils))
1164      #~(begin
1165          (use-modules (guix build utils))
1166          (let ((cfg-param
1167                 #$(if config-file
1168                       #~(string-append " --config-file=" #$config-file)
1169                       "")))
1170            (mkdir #$output)
1171            (install-file (string-append #$usb-modeswitch:dispatcher
1172                                         "/lib/udev/usb_modeswitch")
1173                          #$output)
1174
1175            ;; insert CFG-PARAM into usb_modeswitch_dispatcher command-lines
1176            (substitute* (string-append #$output "/usb_modeswitch")
1177              (("(exec usb_modeswitch_dispatcher .*)( 2>>)" _ left right)
1178               (string-append left cfg-param right))
1179              (("(exec usb_modeswitch_dispatcher .*)( &)" _ left right)
1180               (string-append left cfg-param right)))
1181
1182            ;; wrap-program needs bash in PATH:
1183            (putenv (string-append "PATH=" #$bash "/bin"))
1184            (wrap-program (string-append #$output "/usb_modeswitch")
1185              `("PATH" ":" = (,(string-append #$coreutils "/bin")
1186                              ,(string-append
1187                                #$usb-modeswitch:dispatcher
1188                                "/bin")))))))))
1189
1190 (define (usb-modeswitch-configuration->udev-rules config)
1191   "Build a rules file for extending udev-service-type from the rules in the
1192 usb-modeswitch package specified in CONFIG.  The rules file will invoke
1193 usb_modeswitch.sh from the usb-modeswitch package, modified to pass the right
1194 config file."
1195   (match config
1196     (($ <usb-modeswitch-configuration> usb-modeswitch data config-file)
1197      (computed-file
1198       "usb_modeswitch.rules"
1199       (with-imported-modules '((guix build utils))
1200         #~(begin
1201             (use-modules (guix build utils))
1202             (let ((in (string-append #$data "/udev/40-usb_modeswitch.rules"))
1203                   (out (string-append #$output "/lib/udev/rules.d"))
1204                   (script #$(usb-modeswitch-sh usb-modeswitch config-file)))
1205               (mkdir-p out)
1206               (chdir out)
1207               (install-file in out)
1208               (substitute* "40-usb_modeswitch.rules"
1209                 (("PROGRAM=\"usb_modeswitch")
1210                  (string-append "PROGRAM=\"" script "/usb_modeswitch"))
1211                 (("RUN\\+=\"usb_modeswitch")
1212                  (string-append "RUN+=\"" script "/usb_modeswitch"))))))))))
1213
1214 (define usb-modeswitch-service-type
1215   (service-type
1216    (name 'usb-modeswitch)
1217    (extensions
1218     (list
1219      (service-extension
1220       udev-service-type
1221       (lambda (config)
1222         (let ((rules (usb-modeswitch-configuration->udev-rules config)))
1223           (list rules))))))
1224    (default-value (usb-modeswitch-configuration))
1225    (description "Run @uref{http://www.draisberghof.de/usb_modeswitch/,
1226 USB_ModeSwitch}, a mode switching tool for controlling USB devices with
1227 multiple @dfn{modes}.  When plugged in for the first time many USB
1228 devices (primarily high-speed WAN modems) act like a flash storage containing
1229 installers for Windows drivers.  USB_ModeSwitch replays the sequence the
1230 Windows drivers would send to switch their mode from storage to modem (or
1231 whatever the thing is supposed to do).")))
1232
1233 \f
1234 ;;;
1235 ;;; WPA supplicant
1236 ;;;
1237
1238 (define-record-type* <wpa-supplicant-configuration>
1239   wpa-supplicant-configuration make-wpa-supplicant-configuration
1240   wpa-supplicant-configuration?
1241   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
1242                       (default wpa-supplicant))
1243   (pid-file           wpa-supplicant-configuration-pid-file       ;string
1244                       (default "/var/run/wpa_supplicant.pid"))
1245   (dbus?              wpa-supplicant-configuration-dbus?          ;Boolean
1246                       (default #t))
1247   (interface          wpa-supplicant-configuration-interface      ;#f | string
1248                       (default #f))
1249   (config-file        wpa-supplicant-configuration-config-file    ;#f | <file-like>
1250                       (default #f))
1251   (extra-options      wpa-supplicant-configuration-extra-options  ;list of strings
1252                       (default '())))
1253
1254 (define wpa-supplicant-shepherd-service
1255   (match-lambda
1256     (($ <wpa-supplicant-configuration> wpa-supplicant pid-file dbus? interface
1257                                        config-file extra-options)
1258      (list (shepherd-service
1259             (documentation "Run the WPA supplicant daemon")
1260             (provision '(wpa-supplicant))
1261             (requirement '(user-processes dbus-system loopback syslogd))
1262             (start #~(make-forkexec-constructor
1263                       (list (string-append #$wpa-supplicant
1264                                            "/sbin/wpa_supplicant")
1265                             (string-append "-P" #$pid-file)
1266                             "-B"        ;run in background
1267                             "-s"        ;log to syslogd
1268                             #$@(if dbus?
1269                                    #~("-u")
1270                                    #~())
1271                             #$@(if interface
1272                                    #~((string-append "-i" #$interface))
1273                                    #~())
1274                             #$@(if config-file
1275                                    #~((string-append "-c" #$config-file))
1276                                    #~())
1277                             #$@extra-options)
1278                       #:pid-file #$pid-file))
1279             (stop #~(make-kill-destructor)))))))
1280
1281 (define wpa-supplicant-service-type
1282   (let ((config->package
1283          (match-lambda
1284            (($ <wpa-supplicant-configuration> wpa-supplicant)
1285             (list wpa-supplicant)))))
1286     (service-type (name 'wpa-supplicant)
1287                   (extensions
1288                    (list (service-extension shepherd-root-service-type
1289                                             wpa-supplicant-shepherd-service)
1290                          (service-extension dbus-root-service-type config->package)
1291                          (service-extension profile-service-type config->package)))
1292                   (description "Run the WPA Supplicant daemon, a service that
1293 implements authentication, key negotiation and more for wireless networks.")
1294                   (default-value (wpa-supplicant-configuration)))))
1295
1296 \f
1297 ;;;
1298 ;;; Open vSwitch
1299 ;;;
1300
1301 (define-record-type* <openvswitch-configuration>
1302   openvswitch-configuration make-openvswitch-configuration
1303   openvswitch-configuration?
1304   (package openvswitch-configuration-package
1305            (default openvswitch)))
1306
1307 (define openvswitch-activation
1308   (match-lambda
1309     (($ <openvswitch-configuration> package)
1310      (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
1311        (with-imported-modules '((guix build utils))
1312          #~(begin
1313              (use-modules (guix build utils))
1314              (mkdir-p "/var/run/openvswitch")
1315              (mkdir-p "/var/lib/openvswitch")
1316              (let ((conf.db "/var/lib/openvswitch/conf.db"))
1317                (unless (file-exists? conf.db)
1318                  (system* #$ovsdb-tool "create" conf.db)))))))))
1319
1320 (define openvswitch-shepherd-service
1321   (match-lambda
1322     (($ <openvswitch-configuration> package)
1323      (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
1324            (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
1325        (list
1326         (shepherd-service
1327          (provision '(ovsdb))
1328          (documentation "Run the Open vSwitch database server.")
1329          (start #~(make-forkexec-constructor
1330                    (list #$ovsdb-server "--pidfile"
1331                          "--remote=punix:/var/run/openvswitch/db.sock")
1332                    #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
1333          (stop #~(make-kill-destructor)))
1334         (shepherd-service
1335          (provision '(vswitchd))
1336          (requirement '(ovsdb))
1337          (documentation "Run the Open vSwitch daemon.")
1338          (start #~(make-forkexec-constructor
1339                    (list #$ovs-vswitchd "--pidfile")
1340                    #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
1341          (stop #~(make-kill-destructor))))))))
1342
1343 (define openvswitch-service-type
1344   (service-type
1345    (name 'openvswitch)
1346    (extensions
1347     (list (service-extension activation-service-type
1348                              openvswitch-activation)
1349           (service-extension profile-service-type
1350                              (compose list openvswitch-configuration-package))
1351           (service-extension shepherd-root-service-type
1352                              openvswitch-shepherd-service)))
1353    (description
1354     "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
1355 switch designed to enable massive network automation through programmatic
1356 extension.")
1357    (default-value (openvswitch-configuration))))
1358
1359 ;;;
1360 ;;; iptables
1361 ;;;
1362
1363 (define %iptables-accept-all-rules
1364   (plain-file "iptables-accept-all.rules"
1365               "*filter
1366 :INPUT ACCEPT
1367 :FORWARD ACCEPT
1368 :OUTPUT ACCEPT
1369 COMMIT
1370 "))
1371
1372 (define-record-type* <iptables-configuration>
1373   iptables-configuration make-iptables-configuration iptables-configuration?
1374   (iptables iptables-configuration-iptables
1375             (default iptables))
1376   (ipv4-rules iptables-configuration-ipv4-rules
1377               (default %iptables-accept-all-rules))
1378   (ipv6-rules iptables-configuration-ipv6-rules
1379               (default %iptables-accept-all-rules)))
1380
1381 (define iptables-shepherd-service
1382   (match-lambda
1383     (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
1384      (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
1385            (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
1386        (shepherd-service
1387         (documentation "Packet filtering framework")
1388         (provision '(iptables))
1389         (start #~(lambda _
1390                    (invoke #$iptables-restore #$ipv4-rules)
1391                    (invoke #$ip6tables-restore #$ipv6-rules)))
1392         (stop #~(lambda _
1393                   (invoke #$iptables-restore #$%iptables-accept-all-rules)
1394                   (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
1395
1396 (define iptables-service-type
1397   (service-type
1398    (name 'iptables)
1399    (description
1400     "Run @command{iptables-restore}, setting up the specified rules.")
1401    (extensions
1402     (list (service-extension shepherd-root-service-type
1403                              (compose list iptables-shepherd-service))))))
1404
1405 ;;; networking.scm ends here