gnu/services/networking.scm

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