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