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