gnu/services/networking.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
   5 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
   6 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   7 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
   8 ;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
   9 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
  10 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
  11 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
  12 ;;;
  13 ;;; This file is part of GNU Guix.
  14 ;;;
  15 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  16 ;;; under the terms of the GNU General Public License as published by
  17 ;;; the Free Software Foundation; either version 3 of the License, or (at
  18 ;;; your option) any later version.
  19 ;;;
  20 ;;; GNU Guix is distributed in the hope that it will be useful, but
  21 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;;; GNU General Public License for more details.
  24 ;;;
  25 ;;; You should have received a copy of the GNU General Public License
  26 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 (define-module (gnu services networking)
  29   #:use-module (gnu services)
  30   #:use-module (gnu services base)
  31   #:use-module (gnu services shepherd)
  32   #:use-module (gnu services dbus)
  33   #:use-module (gnu system shadow)
  34   #:use-module (gnu system pam)
  35   #:use-module (gnu packages admin)
  36   #:use-module (gnu packages connman)
  37   #:use-module (gnu packages freedesktop)
  38   #:use-module (gnu packages linux)
  39   #:use-module (gnu packages tor)
  40   #:use-module (gnu packages messaging)
  41   #:use-module (gnu packages networking)
  42   #:use-module (gnu packages ntp)
  43   #:use-module (gnu packages wicd)
  44   #:use-module (gnu packages gnome)
  45   #:use-module (guix gexp)
  46   #:use-module (guix records)
  47   #:use-module (guix modules)
  48   #:use-module (guix deprecation)
  49   #:use-module (srfi srfi-1)
  50   #:use-module (srfi srfi-9)
  51   #:use-module (srfi srfi-26)
  52   #:use-module (ice-9 match)
  53   #:re-export (static-networking-service
  54                static-networking-service-type)
  55   #:export (%facebook-host-aliases
  56             dhcp-client-service
  57             dhcp-client-service-type
  58
  59             dhcpd-service-type
  60             dhcpd-configuration
  61             dhcpd-configuration?
  62             dhcpd-configuration-package
  63             dhcpd-configuration-config-file
  64             dhcpd-configuration-version
  65             dhcpd-configuration-run-directory
  66             dhcpd-configuration-lease-file
  67             dhcpd-configuration-pid-file
  68             dhcpd-configuration-interfaces
  69
  70             %ntp-servers
  71
  72             ntp-configuration
  73             ntp-configuration?
  74             ntp-service
  75             ntp-service-type
  76
  77             openntpd-configuration
  78             openntpd-configuration?
  79             openntpd-service-type
  80
  81             inetd-configuration
  82             inetd-entry
  83             inetd-service-type
  84
  85             tor-configuration
  86             tor-configuration?
  87             tor-hidden-service
  88             tor-service
  89             tor-service-type
  90
  91             wicd-service-type
  92             wicd-service
  93
  94             network-manager-configuration
  95             network-manager-configuration?
  96             network-manager-configuration-dns
  97             network-manager-service-type
  98
  99             connman-configuration
 100             connman-configuration?
 101             connman-service-type
 102
 103             modem-manager-configuration
 104             modem-manager-configuration?
 105             modem-manager-service-type
 106
 107             <wpa-supplicant-configuration>
 108             wpa-supplicant-configuration
 109             wpa-supplicant-configuration?
 110             wpa-supplicant-configuration-wpa-supplicant
 111             wpa-supplicant-configuration-pid-file
 112             wpa-supplicant-configuration-dbus?
 113             wpa-supplicant-configuration-interface
 114             wpa-supplicant-configuration-config-file
 115             wpa-supplicant-configuration-extra-options
 116             wpa-supplicant-service-type
 117
 118             openvswitch-service-type
 119             openvswitch-configuration
 120
 121             iptables-configuration
 122             iptables-configuration?
 123             iptables-configuration-iptables
 124             iptables-configuration-ipv4-rules
 125             iptables-configuration-ipv6-rules
 126             iptables-service-type))
 127
 128 ;;; Commentary:
 129 ;;;
 130 ;;; Networking services.
 131 ;;;
 132 ;;; Code:
 133
 134 (define %facebook-host-aliases
 135   ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
 136   ;; are to block it.
 137   "\
 138 # Block Facebook IPv4.
 139 127.0.0.1   www.facebook.com
 140 127.0.0.1   facebook.com
 141 127.0.0.1   login.facebook.com
 142 127.0.0.1   www.login.facebook.com
 143 127.0.0.1   fbcdn.net
 144 127.0.0.1   www.fbcdn.net
 145 127.0.0.1   fbcdn.com
 146 127.0.0.1   www.fbcdn.com
 147 127.0.0.1   static.ak.fbcdn.net
 148 127.0.0.1   static.ak.connect.facebook.com
 149 127.0.0.1   connect.facebook.net
 150 127.0.0.1   www.connect.facebook.net
 151 127.0.0.1   apps.facebook.com
 152
 153 # Block Facebook IPv6.
 154 fe80::1%lo0 facebook.com
 155 fe80::1%lo0 login.facebook.com
 156 fe80::1%lo0 www.login.facebook.com
 157 fe80::1%lo0 fbcdn.net
 158 fe80::1%lo0 www.fbcdn.net
 159 fe80::1%lo0 fbcdn.com
 160 fe80::1%lo0 www.fbcdn.com
 161 fe80::1%lo0 static.ak.fbcdn.net
 162 fe80::1%lo0 static.ak.connect.facebook.com
 163 fe80::1%lo0 connect.facebook.net
 164 fe80::1%lo0 www.connect.facebook.net
 165 fe80::1%lo0 apps.facebook.com\n")
 166
 167 (define dhcp-client-service-type
 168   (shepherd-service-type
 169    'dhcp-client
 170    (lambda (dhcp)
 171      (define dhclient
 172        (file-append dhcp "/sbin/dhclient"))
 173
 174      (define pid-file
 175        "/var/run/dhclient.pid")
 176
 177      (shepherd-service
 178       (documentation "Set up networking via DHCP.")
 179       (requirement '(user-processes udev))
 180
 181       ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
 182       ;; networking is unavailable, but also means that the interface is not up
 183       ;; yet when 'start' completes.  To wait for the interface to be ready, one
 184       ;; should instead monitor udev events.
 185       (provision '(networking))
 186
 187       (start #~(lambda _
 188                  ;; When invoked without any arguments, 'dhclient' discovers all
 189                  ;; non-loopback interfaces *that are up*.  However, the relevant
 190                  ;; interfaces are typically down at this point.  Thus we perform
 191                  ;; our own interface discovery here.
 192                  (define valid?
 193                    (negate loopback-network-interface?))
 194                  (define ifaces
 195                    (filter valid? (all-network-interface-names)))
 196
 197                  ;; XXX: Make sure the interfaces are up so that 'dhclient' can
 198                  ;; actually send/receive over them.
 199                  (for-each set-network-interface-up ifaces)
 200
 201                  (false-if-exception (delete-file #$pid-file))
 202                  (let ((pid (fork+exec-command
 203                              (cons* #$dhclient "-nw"
 204                                     "-pf" #$pid-file ifaces))))
 205                    (and (zero? (cdr (waitpid pid)))
 206                         (read-pid-file #$pid-file)))))
 207       (stop #~(make-kill-destructor))))
 208    isc-dhcp))
 209
 210 (define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp))
 211   dhcp-client-service-type
 212   "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
 213 Protocol (DHCP) client, on all the non-loopback network interfaces."
 214   (service dhcp-client-service-type dhcp))
 215
 216 (define-record-type* <dhcpd-configuration>
 217   dhcpd-configuration make-dhcpd-configuration
 218   dhcpd-configuration?
 219   (package   dhcpd-configuration-package ;<package>
 220              (default isc-dhcp))
 221   (config-file   dhcpd-configuration-config-file ;file-like
 222                  (default #f))
 223   (version dhcpd-configuration-version ;"4", "6", or "4o6"
 224               (default "4"))
 225   (run-directory dhcpd-configuration-run-directory
 226                  (default "/run/dhcpd"))
 227   (lease-file dhcpd-configuration-lease-file
 228               (default "/var/db/dhcpd.leases"))
 229   (pid-file dhcpd-configuration-pid-file
 230             (default "/run/dhcpd/dhcpd.pid"))
 231   ;; list of strings, e.g. (list "enp0s25")
 232   (interfaces dhcpd-configuration-interfaces
 233               (default '())))
 234
 235 (define dhcpd-shepherd-service
 236   (match-lambda
 237     (($ <dhcpd-configuration> package config-file version run-directory
 238                               lease-file pid-file interfaces)
 239      (unless config-file
 240        (error "Must supply a config-file"))
 241      (list (shepherd-service
 242             ;; Allow users to easily run multiple versions simultaneously.
 243             (provision (list (string->symbol
 244                               (string-append "dhcpv" version "-daemon"))))
 245             (documentation (string-append "Run the DHCPv" version " daemon"))
 246             (requirement '(networking))
 247             (start #~(make-forkexec-constructor
 248                       '(#$(file-append package "/sbin/dhcpd")
 249                         #$(string-append "-" version)
 250                         "-lf" #$lease-file
 251                         "-pf" #$pid-file
 252                         "-cf" #$config-file
 253                         #$@interfaces)
 254                       #:pid-file #$pid-file))
 255             (stop #~(make-kill-destructor)))))))
 256
 257 (define dhcpd-activation
 258   (match-lambda
 259     (($ <dhcpd-configuration> package config-file version run-directory
 260                               lease-file pid-file interfaces)
 261      (with-imported-modules '((guix build utils))
 262        #~(begin
 263            (unless (file-exists? #$run-directory)
 264              (mkdir #$run-directory))
 265            ;; According to the DHCP manual (man dhcpd.leases), the lease
 266            ;; database must be present for dhcpd to start successfully.
 267            (unless (file-exists? #$lease-file)
 268              (with-output-to-file #$lease-file
 269                (lambda _ (display ""))))
 270            ;; Validate the config.
 271            (invoke
 272             #$(file-append package "/sbin/dhcpd") "-t" "-cf"
 273             #$config-file))))))
 274
 275 (define dhcpd-service-type
 276   (service-type
 277    (name 'dhcpd)
 278    (extensions
 279     (list (service-extension shepherd-root-service-type dhcpd-shepherd-service)
 280           (service-extension activation-service-type dhcpd-activation)))))
 281
 282 (define %ntp-servers
 283   ;; Default set of NTP servers. These URLs are managed by the NTP Pool project.
 284   ;; Within Guix, Leo Famulari <leo@famulari.name> is the administrative contact
 285   ;; for this NTP pool "zone".
 286   '("0.guix.pool.ntp.org"
 287     "1.guix.pool.ntp.org"
 288     "2.guix.pool.ntp.org"
 289     "3.guix.pool.ntp.org"))
 290
 291 \f
 292 ;;;
 293 ;;; NTP.
 294 ;;;
 295
 296 ;; TODO: Export.
 297 (define-record-type* <ntp-configuration>
 298   ntp-configuration make-ntp-configuration
 299   ntp-configuration?
 300   (ntp      ntp-configuration-ntp
 301             (default ntp))
 302   (servers  ntp-configuration-servers
 303             (default %ntp-servers))
 304   (allow-large-adjustment? ntp-allow-large-adjustment?
 305                            (default #f)))
 306
 307 (define ntp-shepherd-service
 308   (match-lambda
 309     (($ <ntp-configuration> ntp servers allow-large-adjustment?)
 310      (let ()
 311        ;; TODO: Add authentication support.
 312        (define config
 313          (string-append "driftfile /var/run/ntpd/ntp.drift\n"
 314                         (string-join (map (cut string-append "server " <>)
 315                                           servers)
 316                                      "\n")
 317                         "
 318 # Disable status queries as a workaround for CVE-2013-5211:
 319 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 320 restrict default kod nomodify notrap nopeer noquery
 321 restrict -6 default kod nomodify notrap nopeer noquery
 322
 323 # Yet, allow use of the local 'ntpq'.
 324 restrict 127.0.0.1
 325 restrict -6 ::1\n"))
 326
 327        (define ntpd.conf
 328          (plain-file "ntpd.conf" config))
 329
 330        (list (shepherd-service
 331               (provision '(ntpd))
 332               (documentation "Run the Network Time Protocol (NTP) daemon.")
 333               (requirement '(user-processes networking))
 334               (start #~(make-forkexec-constructor
 335                         (list (string-append #$ntp "/bin/ntpd") "-n"
 336                               "-c" #$ntpd.conf "-u" "ntpd"
 337                               #$@(if allow-large-adjustment?
 338                                      '("-g")
 339                                      '()))))
 340               (stop #~(make-kill-destructor))))))))
 341
 342 (define %ntp-accounts
 343   (list (user-account
 344          (name "ntpd")
 345          (group "nogroup")
 346          (system? #t)
 347          (comment "NTP daemon user")
 348          (home-directory "/var/empty")
 349          (shell (file-append shadow "/sbin/nologin")))))
 350
 351
 352 (define (ntp-service-activation config)
 353   "Return the activation gexp for CONFIG."
 354   (with-imported-modules '((guix build utils))
 355     #~(begin
 356         (use-modules (guix build utils))
 357         (define %user
 358           (getpw "ntpd"))
 359
 360         (let ((directory "/var/run/ntpd"))
 361           (mkdir-p directory)
 362           (chown directory (passwd:uid %user) (passwd:gid %user))))))
 363
 364 (define ntp-service-type
 365   (service-type (name 'ntp)
 366                 (extensions
 367                  (list (service-extension shepherd-root-service-type
 368                                           ntp-shepherd-service)
 369                        (service-extension account-service-type
 370                                           (const %ntp-accounts))
 371                        (service-extension activation-service-type
 372                                           ntp-service-activation)))
 373                 (description
 374                  "Run the @command{ntpd}, the Network Time Protocol (NTP)
 375 daemon of the @uref{http://www.ntp.org, Network Time Foundation}.  The daemon
 376 will keep the system clock synchronized with that of the given servers.")
 377                 (default-value (ntp-configuration))))
 378
 379 (define-deprecated (ntp-service #:key (ntp ntp)
 380                                 (servers %ntp-servers)
 381                                 allow-large-adjustment?)
 382   ntp-service-type
 383   "Return a service that runs the daemon from @var{ntp}, the
 384 @uref{http://www.ntp.org, Network Time Protocol package}.  The daemon will
 385 keep the system clock synchronized with that of @var{servers}.
 386 @var{allow-large-adjustment?} determines whether @command{ntpd} is allowed to
 387 make an initial adjustment of more than 1,000 seconds."
 388   (service ntp-service-type
 389            (ntp-configuration (ntp ntp)
 390                               (servers servers)
 391                               (allow-large-adjustment?
 392                                allow-large-adjustment?))))
 393
 394 \f
 395 ;;;
 396 ;;; OpenNTPD.
 397 ;;;
 398
 399 (define-record-type* <openntpd-configuration>
 400   openntpd-configuration make-openntpd-configuration
 401   openntpd-configuration?
 402   (openntpd                openntpd-configuration-openntpd
 403                            (default openntpd))
 404   (listen-on               openntpd-listen-on
 405                            (default '("127.0.0.1"
 406                                       "::1")))
 407   (query-from              openntpd-query-from
 408                            (default '()))
 409   (sensor                  openntpd-sensor
 410                            (default '()))
 411   (server                  openntpd-server
 412                            (default %ntp-servers))
 413   (servers                 openntpd-servers
 414                            (default '()))
 415   (constraint-from         openntpd-constraint-from
 416                            (default '()))
 417   (constraints-from        openntpd-constraints-from
 418                            (default '()))
 419   (allow-large-adjustment? openntpd-allow-large-adjustment?
 420                            (default #f))) ; upstream default
 421
 422 (define (openntpd-shepherd-service config)
 423   (match-record config <openntpd-configuration>
 424     (openntpd listen-on query-from sensor server servers constraint-from
 425               constraints-from allow-large-adjustment?)
 426     (let ()
 427       (define config
 428         (string-join
 429           (filter-map
 430             (lambda (field value)
 431               (string-join
 432                 (map (cut string-append field <> "\n")
 433                      value)))
 434             '("listen on " "query from " "sensor " "server " "servers "
 435               "constraint from ")
 436             (list listen-on query-from sensor server servers constraint-from))
 437           ;; The 'constraints from' field needs to be enclosed in double quotes.
 438           (string-join
 439             (map (cut string-append "constraints from \"" <> "\"\n")
 440                  constraints-from))))
 441
 442       (define ntpd.conf
 443         (plain-file "ntpd.conf" config))
 444
 445       (list (shepherd-service
 446               (provision '(ntpd))
 447               (documentation "Run the Network Time Protocol (NTP) daemon.")
 448               (requirement '(user-processes networking))
 449               (start #~(make-forkexec-constructor
 450                          (list (string-append #$openntpd "/sbin/ntpd")
 451                                "-f" #$ntpd.conf
 452                                "-d" ;; don't daemonize
 453                                #$@(if allow-large-adjustment?
 454                                     '("-s")
 455                                     '()))
 456                          ;; When ntpd is daemonized it repeatedly tries to respawn
 457                          ;; while running, leading shepherd to disable it.  To
 458                          ;; prevent spamming stderr, redirect output to logfile.
 459                          #:log-file "/var/log/ntpd"))
 460               (stop #~(make-kill-destructor)))))))
 461
 462 (define (openntpd-service-activation config)
 463   "Return the activation gexp for CONFIG."
 464   (with-imported-modules '((guix build utils))
 465     #~(begin
 466         (use-modules (guix build utils))
 467
 468         (mkdir-p "/var/db")
 469         (mkdir-p "/var/run")
 470         (unless (file-exists? "/var/db/ntpd.drift")
 471           (with-output-to-file "/var/db/ntpd.drift"
 472                                (lambda _
 473                                  (format #t "0.0")))))))
 474
 475 (define openntpd-service-type
 476   (service-type (name 'openntpd)
 477                 (extensions
 478                  (list (service-extension shepherd-root-service-type
 479                                           openntpd-shepherd-service)
 480                        (service-extension account-service-type
 481                                           (const %ntp-accounts))
 482                        (service-extension profile-service-type
 483                                           (compose list openntpd-configuration-openntpd))
 484                        (service-extension activation-service-type
 485                                           openntpd-service-activation)))
 486                 (default-value (openntpd-configuration))
 487                 (description
 488                  "Run the @command{ntpd}, the Network Time Protocol (NTP)
 489 daemon, as implemented by @uref{http://www.openntpd.org, OpenNTPD}.  The
 490 daemon will keep the system clock synchronized with that of the given servers.")))
 491
 492 \f
 493 ;;;
 494 ;;; Inetd.
 495 ;;;
 496
 497 (define-record-type* <inetd-configuration> inetd-configuration
 498   make-inetd-configuration
 499   inetd-configuration?
 500   (program           inetd-configuration-program   ;file-like
 501                      (default (file-append inetutils "/libexec/inetd")))
 502   (entries           inetd-configuration-entries   ;list of <inetd-entry>
 503                      (default '())))
 504
 505 (define-record-type* <inetd-entry> inetd-entry make-inetd-entry
 506   inetd-entry?
 507   (node              inetd-entry-node         ;string or #f
 508                      (default #f))
 509   (name              inetd-entry-name)        ;string, from /etc/services
 510
 511   (socket-type       inetd-entry-socket-type) ;stream | dgram | raw |
 512                                               ;rdm | seqpacket
 513   (protocol          inetd-entry-protocol)    ;string, from /etc/protocols
 514
 515   (wait?             inetd-entry-wait?        ;Boolean
 516                      (default #t))
 517   (user              inetd-entry-user)        ;string
 518
 519   (program           inetd-entry-program      ;string or file-like object
 520                      (default "internal"))
 521   (arguments         inetd-entry-arguments    ;list of strings or file-like objects
 522                      (default '())))
 523
 524 (define (inetd-config-file entries)
 525   (apply mixed-text-file "inetd.conf"
 526          (map
 527           (lambda (entry)
 528             (let* ((node (inetd-entry-node entry))
 529                    (name (inetd-entry-name entry))
 530                    (socket
 531                     (if node (string-append node ":" name) name))
 532                    (type
 533                     (match (inetd-entry-socket-type entry)
 534                       ((or 'stream 'dgram 'raw 'rdm 'seqpacket)
 535                        (symbol->string (inetd-entry-socket-type entry)))))
 536                    (protocol (inetd-entry-protocol entry))
 537                    (wait (if (inetd-entry-wait? entry) "wait" "nowait"))
 538                    (user (inetd-entry-user entry))
 539                    (program (inetd-entry-program entry))
 540                    (args (inetd-entry-arguments entry)))
 541               #~(string-append
 542                  (string-join
 543                   (list #$@(list socket type protocol wait user program) #$@args)
 544                   " ") "\n")))
 545           entries)))
 546
 547 (define inetd-shepherd-service
 548   (match-lambda
 549     (($ <inetd-configuration> program ()) '()) ; empty list of entries -> do nothing
 550     (($ <inetd-configuration> program entries)
 551      (list
 552       (shepherd-service
 553        (documentation "Run inetd.")
 554        (provision '(inetd))
 555        (requirement '(user-processes networking syslogd))
 556        (start #~(make-forkexec-constructor
 557                  (list #$program #$(inetd-config-file entries))
 558                  #:pid-file "/var/run/inetd.pid"))
 559        (stop #~(make-kill-destructor)))))))
 560
 561 (define-public inetd-service-type
 562   (service-type
 563    (name 'inetd)
 564    (extensions
 565     (list (service-extension shepherd-root-service-type
 566                              inetd-shepherd-service)))
 567
 568    ;; The service can be extended with additional lists of entries.
 569    (compose concatenate)
 570    (extend (lambda (config entries)
 571              (inetd-configuration
 572               (inherit config)
 573               (entries (append (inetd-configuration-entries config)
 574                                entries)))))
 575    (description
 576     "Start @command{inetd}, the @dfn{Internet superserver}.  It is responsible
 577 for listening on Internet sockets and spawning the corresponding services on
 578 demand.")))
 579
 580 \f
 581 ;;;
 582 ;;; Tor.
 583 ;;;
 584
 585 (define-record-type* <tor-configuration>
 586   tor-configuration make-tor-configuration
 587   tor-configuration?
 588   (tor              tor-configuration-tor
 589                     (default tor))
 590   (config-file      tor-configuration-config-file
 591                     (default (plain-file "empty" "")))
 592   (hidden-services  tor-configuration-hidden-services
 593                     (default '()))
 594   (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
 595                      (default 'tcp)))
 596
 597 (define %tor-accounts
 598   ;; User account and groups for Tor.
 599   (list (user-group (name "tor") (system? #t))
 600         (user-account
 601          (name "tor")
 602          (group "tor")
 603          (system? #t)
 604          (comment "Tor daemon user")
 605          (home-directory "/var/empty")
 606          (shell (file-append shadow "/sbin/nologin")))))
 607
 608 (define-record-type <hidden-service>
 609   (hidden-service name mapping)
 610   hidden-service?
 611   (name    hidden-service-name)                   ;string
 612   (mapping hidden-service-mapping))               ;list of port/address tuples
 613
 614 (define (tor-configuration->torrc config)
 615   "Return a 'torrc' file for CONFIG."
 616   (match config
 617     (($ <tor-configuration> tor config-file services socks-socket-type)
 618      (computed-file
 619       "torrc"
 620       (with-imported-modules '((guix build utils))
 621         #~(begin
 622             (use-modules (guix build utils)
 623                          (ice-9 match))
 624
 625             (call-with-output-file #$output
 626               (lambda (port)
 627                 (display "\
 628 ### These lines were generated from your system configuration:
 629 User tor
 630 DataDirectory /var/lib/tor
 631 PidFile /var/run/tor/tor.pid
 632 Log notice syslog\n" port)
 633                 (when (eq? 'unix '#$socks-socket-type)
 634                   (display "\
 635 SocksPort unix:/var/run/tor/socks-sock
 636 UnixSocksGroupWritable 1\n" port))
 637
 638                 (for-each (match-lambda
 639                             ((service (ports hosts) ...)
 640                              (format port "\
 641 HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
 642                                      service)
 643                              (for-each (lambda (tcp-port host)
 644                                          (format port "\
 645 HiddenServicePort ~a ~a~%"
 646                                                  tcp-port host))
 647                                        ports hosts)))
 648                           '#$(map (match-lambda
 649                                     (($ <hidden-service> name mapping)
 650                                      (cons name mapping)))
 651                                   services))
 652
 653                 (display "\
 654 ### End of automatically generated lines.\n\n" port)
 655
 656                 ;; Append the user's config file.
 657                 (call-with-input-file #$config-file
 658                   (lambda (input)
 659                     (dump-port input port)))
 660                 #t))))))))
 661
 662 (define (tor-shepherd-service config)
 663   "Return a <shepherd-service> running Tor."
 664   (match config
 665     (($ <tor-configuration> tor)
 666      (let ((torrc (tor-configuration->torrc config)))
 667        (with-imported-modules (source-module-closure
 668                                '((gnu build shepherd)
 669                                  (gnu system file-systems)))
 670          (list (shepherd-service
 671                 (provision '(tor))
 672
 673                 ;; Tor needs at least one network interface to be up, hence the
 674                 ;; dependency on 'loopback'.
 675                 (requirement '(user-processes loopback syslogd))
 676
 677                 (modules '((gnu build shepherd)
 678                            (gnu system file-systems)))
 679
 680                 (start #~(make-forkexec-constructor/container
 681                           (list #$(file-append tor "/bin/tor") "-f" #$torrc)
 682
 683                           #:mappings (list (file-system-mapping
 684                                             (source "/var/lib/tor")
 685                                             (target source)
 686                                             (writable? #t))
 687                                            (file-system-mapping
 688                                             (source "/dev/log") ;for syslog
 689                                             (target source))
 690                                            (file-system-mapping
 691                                             (source "/var/run/tor")
 692                                             (target source)
 693                                             (writable? #t)))
 694                           #:pid-file "/var/run/tor/tor.pid"))
 695                 (stop #~(make-kill-destructor))
 696                 (documentation "Run the Tor anonymous network overlay."))))))))
 697
 698 (define (tor-activation config)
 699   "Set up directories for Tor and its hidden services, if any."
 700   #~(begin
 701       (use-modules (guix build utils))
 702
 703       (define %user
 704         (getpw "tor"))
 705
 706       (define (initialize service)
 707         (let ((directory (string-append "/var/lib/tor/hidden-services/"
 708                                         service)))
 709           (mkdir-p directory)
 710           (chown directory (passwd:uid %user) (passwd:gid %user))
 711
 712           ;; The daemon bails out if we give wider permissions.
 713           (chmod directory #o700)))
 714
 715       ;; Allow Tor to write its PID file.
 716       (mkdir-p "/var/run/tor")
 717       (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
 718       ;; Set the group permissions to rw so that if the system administrator
 719       ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
 720       ;; of the "tor" group will be able to use the SOCKS socket.
 721       (chmod "/var/run/tor" #o750)
 722
 723       ;; Allow Tor to access the hidden services' directories.
 724       (mkdir-p "/var/lib/tor")
 725       (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
 726       (chmod "/var/lib/tor" #o700)
 727
 728       ;; Make sure /var/lib is accessible to the 'tor' user.
 729       (chmod "/var/lib" #o755)
 730
 731       (for-each initialize
 732                 '#$(map hidden-service-name
 733                         (tor-configuration-hidden-services config)))))
 734
 735 (define tor-service-type
 736   (service-type (name 'tor)
 737                 (extensions
 738                  (list (service-extension shepherd-root-service-type
 739                                           tor-shepherd-service)
 740                        (service-extension account-service-type
 741                                           (const %tor-accounts))
 742                        (service-extension activation-service-type
 743                                           tor-activation)))
 744
 745                 ;; This can be extended with hidden services.
 746                 (compose concatenate)
 747                 (extend (lambda (config services)
 748                           (tor-configuration
 749                            (inherit config)
 750                            (hidden-services
 751                             (append (tor-configuration-hidden-services config)
 752                                     services)))))
 753                 (default-value (tor-configuration))
 754                 (description
 755                  "Run the @uref{https://torproject.org, Tor} anonymous
 756 networking daemon.")))
 757
 758 (define-deprecated (tor-service #:optional
 759                                 (config-file (plain-file "empty" ""))
 760                                 #:key (tor tor))
 761   tor-service-type
 762   "Return a service to run the @uref{https://torproject.org, Tor} anonymous
 763 networking daemon.
 764
 765 The daemon runs as the @code{tor} unprivileged user.  It is passed
 766 @var{config-file}, a file-like object, with an additional @code{User tor} line
 767 and lines for hidden services added via @code{tor-hidden-service}.  Run
 768 @command{man tor} for information about the configuration file."
 769   (service tor-service-type
 770            (tor-configuration (tor tor)
 771                               (config-file config-file))))
 772
 773 (define tor-hidden-service-type
 774   ;; A type that extends Tor with hidden services.
 775   (service-type (name 'tor-hidden-service)
 776                 (extensions
 777                  (list (service-extension tor-service-type list)))
 778                 (description
 779                  "Define a new Tor @dfn{hidden service}.")))
 780
 781 (define (tor-hidden-service name mapping)
 782   "Define a new Tor @dfn{hidden service} called @var{name} and implementing
 783 @var{mapping}.  @var{mapping} is a list of port/host tuples, such as:
 784
 785 @example
 786  '((22 \"127.0.0.1:22\")
 787    (80 \"127.0.0.1:8080\"))
 788 @end example
 789
 790 In this example, port 22 of the hidden service is mapped to local port 22, and
 791 port 80 is mapped to local port 8080.
 792
 793 This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
 794 the @file{hostname} file contains the @code{.onion} host name for the hidden
 795 service.
 796
 797 See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
 798 project's documentation} for more information."
 799   (service tor-hidden-service-type
 800            (hidden-service name mapping)))
 801
 802 \f
 803 ;;;
 804 ;;; Wicd.
 805 ;;;
 806
 807 (define %wicd-activation
 808   ;; Activation gexp for Wicd.
 809   #~(begin
 810       (use-modules (guix build utils))
 811
 812       (mkdir-p "/etc/wicd")
 813       (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
 814         (unless (file-exists? file-name)
 815           (copy-file (string-append #$wicd file-name)
 816                      file-name)))
 817
 818       ;; Wicd invokes 'wpa_supplicant', which needs this directory for its
 819       ;; named socket files.
 820       (mkdir-p "/var/run/wpa_supplicant")
 821       (chmod "/var/run/wpa_supplicant" #o750)))
 822
 823 (define (wicd-shepherd-service wicd)
 824   "Return a shepherd service for WICD."
 825   (list (shepherd-service
 826          (documentation "Run the Wicd network manager.")
 827          (provision '(networking))
 828          (requirement '(user-processes dbus-system loopback))
 829          (start #~(make-forkexec-constructor
 830                    (list (string-append #$wicd "/sbin/wicd")
 831                          "--no-daemon")))
 832          (stop #~(make-kill-destructor)))))
 833
 834 (define wicd-service-type
 835   (service-type (name 'wicd)
 836                 (extensions
 837                  (list (service-extension shepherd-root-service-type
 838                                           wicd-shepherd-service)
 839                        (service-extension dbus-root-service-type
 840                                           list)
 841                        (service-extension activation-service-type
 842                                           (const %wicd-activation))
 843
 844                        ;; Add Wicd to the global profile.
 845                        (service-extension profile-service-type list)))
 846                 (description
 847                  "Run @url{https://launchpad.net/wicd,Wicd}, a network
 848 management daemon that aims to simplify wired and wireless networking.")))
 849
 850 (define* (wicd-service #:key (wicd wicd))
 851   "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
 852 management daemon that aims to simplify wired and wireless networking.
 853
 854 This service adds the @var{wicd} package to the global profile, providing
 855 several commands to interact with the daemon and configure networking:
 856 @command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
 857 and @command{wicd-curses} user interfaces."
 858   (service wicd-service-type wicd))
 859
 860 \f
 861 ;;;
 862 ;;; ModemManager
 863 ;;;
 864
 865 (define-record-type* <modem-manager-configuration>
 866   modem-manager-configuration make-modem-manager-configuration
 867   modem-manager-configuration?
 868   (modem-manager modem-manager-configuration-modem-manager
 869                    (default modem-manager)))
 870
 871 \f
 872 ;;;
 873 ;;; NetworkManager
 874 ;;;
 875
 876 (define-record-type* <network-manager-configuration>
 877   network-manager-configuration make-network-manager-configuration
 878   network-manager-configuration?
 879   (network-manager network-manager-configuration-network-manager
 880                    (default network-manager))
 881   (dns network-manager-configuration-dns
 882        (default "default"))
 883   (vpn-plugins network-manager-vpn-plugins        ;list of <package>
 884                (default '())))
 885
 886 (define %network-manager-activation
 887   ;; Activation gexp for NetworkManager.
 888   #~(begin
 889       (use-modules (guix build utils))
 890       (mkdir-p "/etc/NetworkManager/system-connections")))
 891
 892 (define (vpn-plugin-directory plugins)
 893   "Return a directory containing PLUGINS, the NM VPN plugins."
 894   (directory-union "network-manager-vpn-plugins" plugins))
 895
 896 (define network-manager-environment
 897   (match-lambda
 898     (($ <network-manager-configuration> network-manager dns vpn-plugins)
 899      ;; Define this variable in the global environment such that
 900      ;; "nmcli connection import type openvpn file foo.ovpn" works.
 901      `(("NM_VPN_PLUGIN_DIR"
 902         . ,(file-append (vpn-plugin-directory vpn-plugins)
 903                         "/lib/NetworkManager/VPN"))))))
 904
 905 (define network-manager-shepherd-service
 906   (match-lambda
 907     (($ <network-manager-configuration> network-manager dns vpn-plugins)
 908      (let ((conf (plain-file "NetworkManager.conf"
 909                              (string-append "[main]\ndns=" dns "\n")))
 910            (vpn  (vpn-plugin-directory vpn-plugins)))
 911        (list (shepherd-service
 912               (documentation "Run the NetworkManager.")
 913               (provision '(networking))
 914               (requirement '(user-processes dbus-system wpa-supplicant loopback))
 915               (start #~(make-forkexec-constructor
 916                         (list (string-append #$network-manager
 917                                              "/sbin/NetworkManager")
 918                               (string-append "--config=" #$conf)
 919                               "--no-daemon")
 920                         #:environment-variables
 921                         (list (string-append "NM_VPN_PLUGIN_DIR=" #$vpn
 922                                              "/lib/NetworkManager/VPN"))))
 923               (stop #~(make-kill-destructor))))))))
 924
 925 (define network-manager-service-type
 926   (let
 927       ((config->package
 928         (match-lambda
 929          (($ <network-manager-configuration> network-manager)
 930           (list network-manager)))))
 931
 932     (service-type
 933      (name 'network-manager)
 934      (extensions
 935       (list (service-extension shepherd-root-service-type
 936                                network-manager-shepherd-service)
 937             (service-extension dbus-root-service-type config->package)
 938             (service-extension polkit-service-type config->package)
 939             (service-extension activation-service-type
 940                                (const %network-manager-activation))
 941             (service-extension session-environment-service-type
 942                                network-manager-environment)
 943             ;; Add network-manager to the system profile.
 944             (service-extension profile-service-type config->package)))
 945      (default-value (network-manager-configuration))
 946      (description
 947       "Run @uref{https://wiki.gnome.org/Projects/NetworkManager,
 948 NetworkManager}, a network management daemon that aims to simplify wired and
 949 wireless networking."))))
 950
 951 \f
 952 ;;;
 953 ;;; Connman
 954 ;;;
 955
 956 (define-record-type* <connman-configuration>
 957   connman-configuration make-connman-configuration
 958   connman-configuration?
 959   (connman      connman-configuration-connman
 960                 (default connman))
 961   (disable-vpn? connman-configuration-disable-vpn?
 962                 (default #f)))
 963
 964 (define (connman-activation config)
 965   (let ((disable-vpn? (connman-configuration-disable-vpn? config)))
 966     (with-imported-modules '((guix build utils))
 967       #~(begin
 968           (use-modules (guix build utils))
 969           (mkdir-p "/var/lib/connman/")
 970           (unless #$disable-vpn?
 971             (mkdir-p "/var/lib/connman-vpn/"))))))
 972
 973 (define (connman-shepherd-service config)
 974   "Return a shepherd service for Connman"
 975   (and
 976    (connman-configuration? config)
 977    (let ((connman      (connman-configuration-connman config))
 978          (disable-vpn? (connman-configuration-disable-vpn? config)))
 979      (list (shepherd-service
 980             (documentation "Run Connman")
 981             (provision '(networking))
 982             (requirement
 983              '(user-processes dbus-system loopback wpa-supplicant))
 984             (start #~(make-forkexec-constructor
 985                       (list (string-append #$connman
 986                                            "/sbin/connmand")
 987                             "-n" "-r"
 988                             #$@(if disable-vpn? '("--noplugin=vpn") '()))))
 989             (stop #~(make-kill-destructor)))))))
 990
 991 (define connman-service-type
 992   (let ((connman-package (compose list connman-configuration-connman)))
 993     (service-type (name 'connman)
 994                   (extensions
 995                    (list (service-extension shepherd-root-service-type
 996                                             connman-shepherd-service)
 997                          (service-extension polkit-service-type
 998                                             connman-package)
 999                          (service-extension dbus-root-service-type
1000                                             connman-package)
1001                          (service-extension activation-service-type
1002                                             connman-activation)
1003                          ;; Add connman to the system profile.
1004                          (service-extension profile-service-type
1005                                             connman-package)))
1006                   (default-value (connman-configuration))
1007                   (description
1008                    "Run @url{https://01.org/connman,Connman},
1009 a network connection manager."))))
1010
1011 \f
1012 ;;;
1013 ;;; Modem manager
1014 ;;;
1015
1016 (define modem-manager-service-type
1017   (let ((config->package
1018          (match-lambda
1019           (($ <modem-manager-configuration> modem-manager)
1020            (list modem-manager)))))
1021     (service-type (name 'modem-manager)
1022                   (extensions
1023                    (list (service-extension dbus-root-service-type
1024                                             config->package)
1025                          (service-extension udev-service-type
1026                                             config->package)
1027                          (service-extension polkit-service-type
1028                                             config->package)))
1029                   (default-value (modem-manager-configuration))
1030                   (description
1031                    "Run @uref{https://wiki.gnome.org/Projects/ModemManager,
1032 ModemManager}, a modem management daemon that aims to simplify dialup
1033 networking."))))
1034
1035 \f
1036 ;;;
1037 ;;; WPA supplicant
1038 ;;;
1039
1040 (define-record-type* <wpa-supplicant-configuration>
1041   wpa-supplicant-configuration make-wpa-supplicant-configuration
1042   wpa-supplicant-configuration?
1043   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
1044                       (default wpa-supplicant))
1045   (pid-file           wpa-supplicant-configuration-pid-file       ;string
1046                       (default "/var/run/wpa_supplicant.pid"))
1047   (dbus?              wpa-supplicant-configuration-dbus?          ;Boolean
1048                       (default #t))
1049   (interface          wpa-supplicant-configuration-interface      ;#f | string
1050                       (default #f))
1051   (config-file        wpa-supplicant-configuration-config-file    ;#f | <file-like>
1052                       (default #f))
1053   (extra-options      wpa-supplicant-configuration-extra-options  ;list of strings
1054                       (default '())))
1055
1056 (define wpa-supplicant-shepherd-service
1057   (match-lambda
1058     (($ <wpa-supplicant-configuration> wpa-supplicant pid-file dbus? interface
1059                                        config-file extra-options)
1060      (list (shepherd-service
1061             (documentation "Run the WPA supplicant daemon")
1062             (provision '(wpa-supplicant))
1063             (requirement '(user-processes dbus-system loopback))
1064             (start #~(make-forkexec-constructor
1065                       (list (string-append #$wpa-supplicant
1066                                            "/sbin/wpa_supplicant")
1067                             (string-append "-P" #$pid-file)
1068                             "-B"        ;run in background
1069                             #$@(if dbus?
1070                                    #~("-u")
1071                                    #~())
1072                             #$@(if interface
1073                                    #~((string-append "-i" #$interface))
1074                                    #~())
1075                             #$@(if config-file
1076                                    #~((string-append "-c" #$config-file))
1077                                    #~())
1078                             #$@extra-options)
1079                       #:pid-file #$pid-file))
1080             (stop #~(make-kill-destructor)))))))
1081
1082 (define wpa-supplicant-service-type
1083   (let ((config->package
1084          (match-lambda
1085            (($ <wpa-supplicant-configuration> wpa-supplicant)
1086             (list wpa-supplicant)))))
1087     (service-type (name 'wpa-supplicant)
1088                   (extensions
1089                    (list (service-extension shepherd-root-service-type
1090                                             wpa-supplicant-shepherd-service)
1091                          (service-extension dbus-root-service-type config->package)
1092                          (service-extension profile-service-type config->package)))
1093                   (description "Run the WPA Supplicant daemon, a service that
1094 implements authentication, key negotiation and more for wireless networks.")
1095                   (default-value (wpa-supplicant-configuration)))))
1096
1097 \f
1098 ;;;
1099 ;;; Open vSwitch
1100 ;;;
1101
1102 (define-record-type* <openvswitch-configuration>
1103   openvswitch-configuration make-openvswitch-configuration
1104   openvswitch-configuration?
1105   (package openvswitch-configuration-package
1106            (default openvswitch)))
1107
1108 (define openvswitch-activation
1109   (match-lambda
1110     (($ <openvswitch-configuration> package)
1111      (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
1112        (with-imported-modules '((guix build utils))
1113          #~(begin
1114              (use-modules (guix build utils))
1115              (mkdir-p "/var/run/openvswitch")
1116              (mkdir-p "/var/lib/openvswitch")
1117              (let ((conf.db "/var/lib/openvswitch/conf.db"))
1118                (unless (file-exists? conf.db)
1119                  (system* #$ovsdb-tool "create" conf.db)))))))))
1120
1121 (define openvswitch-shepherd-service
1122   (match-lambda
1123     (($ <openvswitch-configuration> package)
1124      (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
1125            (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
1126        (list
1127         (shepherd-service
1128          (provision '(ovsdb))
1129          (documentation "Run the Open vSwitch database server.")
1130          (start #~(make-forkexec-constructor
1131                    (list #$ovsdb-server "--pidfile"
1132                          "--remote=punix:/var/run/openvswitch/db.sock")
1133                    #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
1134          (stop #~(make-kill-destructor)))
1135         (shepherd-service
1136          (provision '(vswitchd))
1137          (requirement '(ovsdb))
1138          (documentation "Run the Open vSwitch daemon.")
1139          (start #~(make-forkexec-constructor
1140                    (list #$ovs-vswitchd "--pidfile")
1141                    #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
1142          (stop #~(make-kill-destructor))))))))
1143
1144 (define openvswitch-service-type
1145   (service-type
1146    (name 'openvswitch)
1147    (extensions
1148     (list (service-extension activation-service-type
1149                              openvswitch-activation)
1150           (service-extension profile-service-type
1151                              (compose list openvswitch-configuration-package))
1152           (service-extension shepherd-root-service-type
1153                              openvswitch-shepherd-service)))
1154    (description
1155     "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
1156 switch designed to enable massive network automation through programmatic
1157 extension.")
1158    (default-value (openvswitch-configuration))))
1159
1160 ;;;
1161 ;;; iptables
1162 ;;;
1163
1164 (define %iptables-accept-all-rules
1165   (plain-file "iptables-accept-all.rules"
1166               "*filter
1167 :INPUT ACCEPT
1168 :FORWARD ACCEPT
1169 :OUTPUT ACCEPT
1170 COMMIT
1171 "))
1172
1173 (define-record-type* <iptables-configuration>
1174   iptables-configuration make-iptables-configuration iptables-configuration?
1175   (iptables iptables-configuration-iptables
1176             (default iptables))
1177   (ipv4-rules iptables-configuration-ipv4-rules
1178               (default %iptables-accept-all-rules))
1179   (ipv6-rules iptables-configuration-ipv6-rules
1180               (default %iptables-accept-all-rules)))
1181
1182 (define iptables-shepherd-service
1183   (match-lambda
1184     (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
1185      (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
1186            (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
1187        (shepherd-service
1188         (documentation "Packet filtering framework")
1189         (provision '(iptables))
1190         (start #~(lambda _
1191                    (invoke #$iptables-restore #$ipv4-rules)
1192                    (invoke #$ip6tables-restore #$ipv6-rules)))
1193         (stop #~(lambda _
1194                   (invoke #$iptables-restore #$%iptables-accept-all-rules)
1195                   (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
1196
1197 (define iptables-service-type
1198   (service-type
1199    (name 'iptables)
1200    (description
1201     "Run @command{iptables-restore}, setting up the specified rules.")
1202    (extensions
1203     (list (service-extension shepherd-root-service-type
1204                              (compose list iptables-shepherd-service))))))
1205
1206 ;;; networking.scm ends here