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