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