gnu/services/networking.scm

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