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