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