gnu/services/networking.scm

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