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