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