gnu/services/networking.scm

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