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   (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 (define-record-type* <wpa-supplicant-configuration>
1035   wpa-supplicant-configuration make-wpa-supplicant-configuration
1036   wpa-supplicant-configuration?
1037   (wpa-supplicant     wpa-supplicant-configuration-wpa-supplicant ;<package>
1038                       (default wpa-supplicant))
1039   (pid-file           wpa-supplicant-configuration-pid-file       ;string
1040                       (default "/var/run/wpa_supplicant.pid"))
1041   (dbus?              wpa-supplicant-configuration-dbus?          ;Boolean
1042                       (default #t))
1043   (interface          wpa-supplicant-configuration-interface      ;#f | string
1044                       (default #f))
1045   (config-file        wpa-supplicant-configuration-config-file    ;#f | <file-like>
1046                       (default #f))
1047   (extra-options      wpa-supplicant-configuration-extra-options  ;list of strings
1048                       (default '())))
1049
1050 (define wpa-supplicant-shepherd-service
1051   (match-lambda
1052     (($ <wpa-supplicant-configuration> wpa-supplicant pid-file dbus? interface
1053                                        config-file extra-options)
1054      (list (shepherd-service
1055             (documentation "Run the WPA supplicant daemon")
1056             (provision '(wpa-supplicant))
1057             (requirement '(user-processes dbus-system loopback))
1058             (start #~(make-forkexec-constructor
1059                       (list (string-append #$wpa-supplicant
1060                                            "/sbin/wpa_supplicant")
1061                             (string-append "-P" #$pid-file)
1062                             "-B"        ;run in background
1063                             #$@(if dbus?
1064                                    #~("-u")
1065                                    #~())
1066                             #$@(if interface
1067                                    #~((string-append "-i" #$interface))
1068                                    #~())
1069                             #$@(if config-file
1070                                    #~((string-append "-c" #$config-file))
1071                                    #~())
1072                             #$@extra-options)
1073                       #:pid-file #$pid-file))
1074             (stop #~(make-kill-destructor)))))))
1075
1076 (define wpa-supplicant-service-type
1077   (let ((config->package
1078          (match-lambda
1079            (($ <wpa-supplicant-configuration> wpa-supplicant)
1080             (list wpa-supplicant)))))
1081     (service-type (name 'wpa-supplicant)
1082                   (extensions
1083                    (list (service-extension shepherd-root-service-type
1084                                             wpa-supplicant-shepherd-service)
1085                          (service-extension dbus-root-service-type config->package)
1086                          (service-extension profile-service-type config->package)))
1087                   (description "Run the WPA Supplicant daemon, a service that
1088 implements authentication, key negotiation and more for wireless networks.")
1089                   (default-value (wpa-supplicant-configuration)))))
1090
1091 \f
1092 ;;;
1093 ;;; Open vSwitch
1094 ;;;
1095
1096 (define-record-type* <openvswitch-configuration>
1097   openvswitch-configuration make-openvswitch-configuration
1098   openvswitch-configuration?
1099   (package openvswitch-configuration-package
1100            (default openvswitch)))
1101
1102 (define openvswitch-activation
1103   (match-lambda
1104     (($ <openvswitch-configuration> package)
1105      (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
1106        (with-imported-modules '((guix build utils))
1107          #~(begin
1108              (use-modules (guix build utils))
1109              (mkdir-p "/var/run/openvswitch")
1110              (mkdir-p "/var/lib/openvswitch")
1111              (let ((conf.db "/var/lib/openvswitch/conf.db"))
1112                (unless (file-exists? conf.db)
1113                  (system* #$ovsdb-tool "create" conf.db)))))))))
1114
1115 (define openvswitch-shepherd-service
1116   (match-lambda
1117     (($ <openvswitch-configuration> package)
1118      (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
1119            (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
1120        (list
1121         (shepherd-service
1122          (provision '(ovsdb))
1123          (documentation "Run the Open vSwitch database server.")
1124          (start #~(make-forkexec-constructor
1125                    (list #$ovsdb-server "--pidfile"
1126                          "--remote=punix:/var/run/openvswitch/db.sock")
1127                    #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
1128          (stop #~(make-kill-destructor)))
1129         (shepherd-service
1130          (provision '(vswitchd))
1131          (requirement '(ovsdb))
1132          (documentation "Run the Open vSwitch daemon.")
1133          (start #~(make-forkexec-constructor
1134                    (list #$ovs-vswitchd "--pidfile")
1135                    #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
1136          (stop #~(make-kill-destructor))))))))
1137
1138 (define openvswitch-service-type
1139   (service-type
1140    (name 'openvswitch)
1141    (extensions
1142     (list (service-extension activation-service-type
1143                              openvswitch-activation)
1144           (service-extension profile-service-type
1145                              (compose list openvswitch-configuration-package))
1146           (service-extension shepherd-root-service-type
1147                              openvswitch-shepherd-service)))
1148    (description
1149     "Run @uref{http://www.openvswitch.org, Open vSwitch}, a multilayer virtual
1150 switch designed to enable massive network automation through programmatic
1151 extension.")))
1152
1153 ;;;
1154 ;;; iptables
1155 ;;;
1156
1157 (define %iptables-accept-all-rules
1158   (plain-file "iptables-accept-all.rules"
1159               "*filter
1160 :INPUT ACCEPT
1161 :FORWARD ACCEPT
1162 :OUTPUT ACCEPT
1163 COMMIT
1164 "))
1165
1166 (define-record-type* <iptables-configuration>
1167   iptables-configuration make-iptables-configuration iptables-configuration?
1168   (iptables iptables-configuration-iptables
1169             (default iptables))
1170   (ipv4-rules iptables-configuration-ipv4-rules
1171               (default %iptables-accept-all-rules))
1172   (ipv6-rules iptables-configuration-ipv6-rules
1173               (default %iptables-accept-all-rules)))
1174
1175 (define iptables-shepherd-service
1176   (match-lambda
1177     (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
1178      (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
1179            (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
1180        (shepherd-service
1181         (documentation "Packet filtering framework")
1182         (provision '(iptables))
1183         (start #~(lambda _
1184                    (invoke #$iptables-restore #$ipv4-rules)
1185                    (invoke #$ip6tables-restore #$ipv6-rules)))
1186         (stop #~(lambda _
1187                   (invoke #$iptables-restore #$%iptables-accept-all-rules)
1188                   (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
1189
1190 (define iptables-service-type
1191   (service-type
1192    (name 'iptables)
1193    (description
1194     "Run @command{iptables-restore}, setting up the specified rules.")
1195    (extensions
1196     (list (service-extension shepherd-root-service-type
1197                              (compose list iptables-shepherd-service))))))
1198
1199 ;;; networking.scm ends here