gnu/services/networking.scm

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