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