gnu/services/networking.scm

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