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