gnu/services/networking.scm

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