gnu/services/networking.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
   5 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
   6 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu services networking)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services shepherd)
  26   #:use-module (gnu services dbus)
  27   #:use-module (gnu system shadow)
  28   #:use-module (gnu system pam)
  29   #:use-module (gnu packages admin)
  30   #:use-module (gnu packages connman)
  31   #:use-module (gnu packages linux)
  32   #:use-module (gnu packages tor)
  33   #:use-module (gnu packages messaging)
  34   #:use-module (gnu packages networking)
  35   #:use-module (gnu packages ntp)
  36   #:use-module (gnu packages wicd)
  37   #:use-module (gnu packages gnome)
  38   #:use-module (guix gexp)
  39   #:use-module (guix records)
  40   #:use-module (guix modules)
  41   #:use-module (srfi srfi-1)
  42   #:use-module (srfi srfi-9)
  43   #:use-module (srfi srfi-26)
  44   #:use-module (ice-9 match)
  45   #:export (%facebook-host-aliases
  46             static-networking
  47
  48             static-networking?
  49             static-networking-interface
  50             static-networking-ip
  51             static-networking-netmask
  52             static-networking-gateway
  53
  54             static-networking-service
  55             static-networking-service-type
  56             dhcp-client-service
  57             %ntp-servers
  58
  59             ntp-configuration
  60             ntp-configuration?
  61             ntp-service
  62             ntp-service-type
  63
  64             tor-configuration
  65             tor-configuration?
  66             tor-hidden-service
  67             tor-service
  68             tor-service-type
  69
  70             bitlbee-configuration
  71             bitlbee-configuration?
  72             bitlbee-service
  73             bitlbee-service-type
  74
  75             wicd-service-type
  76             wicd-service
  77
  78             network-manager-configuration
  79             network-manager-configuration?
  80             network-manager-configuration-dns
  81             network-manager-service-type
  82
  83             connman-service
  84             wpa-supplicant-service-type
  85
  86             openvswitch-service-type
  87             openvswitch-configuration))
  88
  89 ;;; Commentary:
  90 ;;;
  91 ;;; Networking services.
  92 ;;;
  93 ;;; Code:
  94
  95 (define %facebook-host-aliases
  96   ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
  97   ;; are to block it.
  98   "\
  99 # Block Facebook IPv4.
 100 127.0.0.1   www.facebook.com
 101 127.0.0.1   facebook.com
 102 127.0.0.1   login.facebook.com
 103 127.0.0.1   www.login.facebook.com
 104 127.0.0.1   fbcdn.net
 105 127.0.0.1   www.fbcdn.net
 106 127.0.0.1   fbcdn.com
 107 127.0.0.1   www.fbcdn.com
 108 127.0.0.1   static.ak.fbcdn.net
 109 127.0.0.1   static.ak.connect.facebook.com
 110 127.0.0.1   connect.facebook.net
 111 127.0.0.1   www.connect.facebook.net
 112 127.0.0.1   apps.facebook.com
 113
 114 # Block Facebook IPv6.
 115 fe80::1%lo0 facebook.com
 116 fe80::1%lo0 login.facebook.com
 117 fe80::1%lo0 www.login.facebook.com
 118 fe80::1%lo0 fbcdn.net
 119 fe80::1%lo0 www.fbcdn.net
 120 fe80::1%lo0 fbcdn.com
 121 fe80::1%lo0 www.fbcdn.com
 122 fe80::1%lo0 static.ak.fbcdn.net
 123 fe80::1%lo0 static.ak.connect.facebook.com
 124 fe80::1%lo0 connect.facebook.net
 125 fe80::1%lo0 www.connect.facebook.net
 126 fe80::1%lo0 apps.facebook.com\n")
 127
 128
 129 (define-record-type* <static-networking>
 130   static-networking make-static-networking
 131   static-networking?
 132   (interface static-networking-interface)
 133   (ip static-networking-ip)
 134   (netmask static-networking-netmask
 135            (default #f))
 136   (gateway static-networking-gateway              ;FIXME: doesn't belong here
 137            (default #f))
 138   (provision static-networking-provision
 139              (default #f))
 140   (name-servers static-networking-name-servers    ;FIXME: doesn't belong here
 141                 (default '())))
 142
 143 (define static-networking-shepherd-service
 144   (match-lambda
 145     (($ <static-networking> interface ip netmask gateway provision
 146                             name-servers)
 147      (let ((loopback? (and provision (memq 'loopback provision))))
 148        (shepherd-service
 149
 150         ;; Unless we're providing the loopback interface, wait for udev to be up
 151         ;; and running so that INTERFACE is actually usable.
 152         (requirement (if loopback? '() '(udev)))
 153
 154         (documentation
 155          "Bring up the networking interface using a static IP address.")
 156         (provision (or provision
 157                        (list (symbol-append 'networking-
 158                                             (string->symbol interface)))))
 159
 160         (start #~(lambda _
 161                    ;; Return #t if successfully started.
 162                    (let* ((addr     (inet-pton AF_INET #$ip))
 163                           (sockaddr (make-socket-address AF_INET addr 0))
 164                           (mask     (and #$netmask
 165                                          (inet-pton AF_INET #$netmask)))
 166                           (maskaddr (and mask
 167                                          (make-socket-address AF_INET
 168                                                               mask 0)))
 169                           (gateway  (and #$gateway
 170                                          (inet-pton AF_INET #$gateway)))
 171                           (gatewayaddr (and gateway
 172                                             (make-socket-address AF_INET
 173                                                                  gateway 0))))
 174                      (configure-network-interface #$interface sockaddr
 175                                                   (logior IFF_UP
 176                                                           #$(if loopback?
 177                                                                 #~IFF_LOOPBACK
 178                                                                 0))
 179                                                   #:netmask maskaddr)
 180                      (when gateway
 181                        (let ((sock (socket AF_INET SOCK_DGRAM 0)))
 182                          (add-network-route/gateway sock gatewayaddr)
 183                          (close-port sock))))))
 184         (stop #~(lambda _
 185                   ;; Return #f is successfully stopped.
 186                   (let ((sock (socket AF_INET SOCK_STREAM 0)))
 187                     (when #$gateway
 188                       (delete-network-route sock
 189                                             (make-socket-address
 190                                              AF_INET INADDR_ANY 0)))
 191                     (set-network-interface-flags sock #$interface 0)
 192                     (close-port sock)
 193                     #f)))
 194         (respawn? #f))))))
 195
 196 (define (static-networking-etc-files interfaces)
 197   "Return a /etc/resolv.conf entry for INTERFACES or the empty list."
 198   (match (delete-duplicates
 199           (append-map static-networking-name-servers
 200                       interfaces))
 201     (()
 202      '())
 203     ((name-servers ...)
 204      (let ((content (string-join
 205                      (map (cut string-append "nameserver " <>)
 206                           name-servers)
 207                      "\n" 'suffix)))
 208        `(("resolv.conf"
 209           ,(plain-file "resolv.conf"
 210                        (string-append "\
 211 # Generated by 'static-networking-service'.\n"
 212                                       content))))))))
 213
 214 (define (static-networking-shepherd-services interfaces)
 215   "Return the list of Shepherd services to bring up INTERFACES, a list of
 216 <static-networking> objects."
 217   (define (loopback? service)
 218     (memq 'loopback (shepherd-service-provision service)))
 219
 220   (let ((services (map static-networking-shepherd-service interfaces)))
 221     (match (remove loopback? services)
 222       (()
 223        ;; There's no interface other than 'loopback', so we assume that the
 224        ;; 'networking' service will be provided by dhclient or similar.
 225        services)
 226       ((non-loopback ...)
 227        ;; Assume we're providing all the interfaces, and thus, provide a
 228        ;; 'networking' service.
 229        (cons (shepherd-service
 230               (provision '(networking))
 231               (requirement (append-map shepherd-service-provision
 232                                        services))
 233               (start #~(const #t))
 234               (stop #~(const #f))
 235               (documentation "Bring up all the networking interfaces."))
 236              services)))))
 237
 238 (define static-networking-service-type
 239   ;; The service type for statically-defined network interfaces.
 240   (service-type (name 'static-networking)
 241                 (extensions
 242                  (list
 243                   (service-extension shepherd-root-service-type
 244                                      static-networking-shepherd-services)
 245                   (service-extension etc-service-type
 246                                      static-networking-etc-files)))
 247                 (compose concatenate)
 248                 (extend append)))
 249
 250 (define* (static-networking-service interface ip
 251                                     #:key
 252                                     netmask gateway provision
 253                                     (name-servers '()))
 254   "Return a service that starts @var{interface} with address @var{ip}.  If
 255 @var{netmask} is true, use it as the network mask.  If @var{gateway} is true,
 256 it must be a string specifying the default network gateway.
 257
 258 This procedure can be called several times, one for each network
 259 interface of interest.  Behind the scenes what it does is extend
 260 @code{static-networking-service-type} with additional network interfaces
 261 to handle."
 262   (simple-service 'static-network-interface
 263                   static-networking-service-type
 264                   (list (static-networking (interface interface) (ip ip)
 265                                            (netmask netmask) (gateway gateway)
 266                                            (provision provision)
 267                                            (name-servers name-servers)))))
 268
 269 (define dhcp-client-service-type
 270   (shepherd-service-type
 271    'dhcp-client
 272    (lambda (dhcp)
 273      (define dhclient
 274        (file-append dhcp "/sbin/dhclient"))
 275
 276      (define pid-file
 277        "/var/run/dhclient.pid")
 278
 279      (shepherd-service
 280       (documentation "Set up networking via DHCP.")
 281       (requirement '(user-processes udev))
 282
 283       ;; XXX: Running with '-nw' ("no wait") avoids blocking for a minute when
 284       ;; networking is unavailable, but also means that the interface is not up
 285       ;; yet when 'start' completes.  To wait for the interface to be ready, one
 286       ;; should instead monitor udev events.
 287       (provision '(networking))
 288
 289       (start #~(lambda _
 290                  ;; When invoked without any arguments, 'dhclient' discovers all
 291                  ;; non-loopback interfaces *that are up*.  However, the relevant
 292                  ;; interfaces are typically down at this point.  Thus we perform
 293                  ;; our own interface discovery here.
 294                  (define valid?
 295                    (negate loopback-network-interface?))
 296                  (define ifaces
 297                    (filter valid? (all-network-interface-names)))
 298
 299                  ;; XXX: Make sure the interfaces are up so that 'dhclient' can
 300                  ;; actually send/receive over them.
 301                  (for-each set-network-interface-up ifaces)
 302
 303                  (false-if-exception (delete-file #$pid-file))
 304                  (let ((pid (fork+exec-command
 305                              (cons* #$dhclient "-nw"
 306                                     "-pf" #$pid-file ifaces))))
 307                    (and (zero? (cdr (waitpid pid)))
 308                         (let loop ()
 309                           (catch 'system-error
 310                             (lambda ()
 311                               (call-with-input-file #$pid-file read))
 312                             (lambda args
 313                               ;; 'dhclient' returned before PID-FILE was created,
 314                               ;; so try again.
 315                               (let ((errno (system-error-errno args)))
 316                                 (if (= ENOENT errno)
 317                                     (begin
 318                                       (sleep 1)
 319                                       (loop))
 320                                     (apply throw args))))))))))
 321       (stop #~(make-kill-destructor))))))
 322
 323 (define* (dhcp-client-service #:key (dhcp isc-dhcp))
 324   "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
 325 Protocol (DHCP) client, on all the non-loopback network interfaces."
 326   (service dhcp-client-service-type dhcp))
 327
 328 (define %ntp-servers
 329   ;; Default set of NTP servers.
 330   '("0.pool.ntp.org"
 331     "1.pool.ntp.org"
 332     "2.pool.ntp.org"))
 333
 334 \f
 335 ;;;
 336 ;;; NTP.
 337 ;;;
 338
 339 ;; TODO: Export.
 340 (define-record-type* <ntp-configuration>
 341   ntp-configuration make-ntp-configuration
 342   ntp-configuration?
 343   (ntp      ntp-configuration-ntp
 344             (default ntp))
 345   (servers  ntp-configuration-servers)
 346   (allow-large-adjustment? ntp-allow-large-adjustment?
 347                            (default #f)))
 348
 349 (define ntp-shepherd-service
 350   (match-lambda
 351     (($ <ntp-configuration> ntp servers allow-large-adjustment?)
 352      (let ()
 353        ;; TODO: Add authentication support.
 354        (define config
 355          (string-append "driftfile /var/run/ntpd/ntp.drift\n"
 356                         (string-join (map (cut string-append "server " <>)
 357                                           servers)
 358                                      "\n")
 359                         "
 360 # Disable status queries as a workaround for CVE-2013-5211:
 361 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 362 restrict default kod nomodify notrap nopeer noquery
 363 restrict -6 default kod nomodify notrap nopeer noquery
 364
 365 # Yet, allow use of the local 'ntpq'.
 366 restrict 127.0.0.1
 367 restrict -6 ::1\n"))
 368
 369        (define ntpd.conf
 370          (plain-file "ntpd.conf" config))
 371
 372        (list (shepherd-service
 373               (provision '(ntpd))
 374               (documentation "Run the Network Time Protocol (NTP) daemon.")
 375               (requirement '(user-processes networking))
 376               (start #~(make-forkexec-constructor
 377                         (list (string-append #$ntp "/bin/ntpd") "-n"
 378                               "-c" #$ntpd.conf "-u" "ntpd"
 379                               #$@(if allow-large-adjustment?
 380                                      '("-g")
 381                                      '()))))
 382               (stop #~(make-kill-destructor))))))))
 383
 384 (define %ntp-accounts
 385   (list (user-account
 386          (name "ntpd")
 387          (group "nogroup")
 388          (system? #t)
 389          (comment "NTP daemon user")
 390          (home-directory "/var/empty")
 391          (shell (file-append shadow "/sbin/nologin")))))
 392
 393
 394 (define (ntp-service-activation config)
 395   "Return the activation gexp for CONFIG."
 396   (with-imported-modules '((guix build utils))
 397     #~(begin
 398         (use-modules (guix build utils))
 399         (define %user
 400           (getpw "ntpd"))
 401
 402         (let ((directory "/var/run/ntpd"))
 403           (mkdir-p directory)
 404           (chown directory (passwd:uid %user) (passwd:gid %user))))))
 405
 406 (define ntp-service-type
 407   (service-type (name 'ntp)
 408                 (extensions
 409                  (list (service-extension shepherd-root-service-type
 410                                           ntp-shepherd-service)
 411                        (service-extension account-service-type
 412                                           (const %ntp-accounts))
 413                        (service-extension activation-service-type
 414                                           ntp-service-activation)))))
 415
 416 (define* (ntp-service #:key (ntp ntp)
 417                       (servers %ntp-servers)
 418                       allow-large-adjustment?)
 419   "Return a service that runs the daemon from @var{ntp}, the
 420 @uref{http://www.ntp.org, Network Time Protocol package}.  The daemon will
 421 keep the system clock synchronized with that of @var{servers}.
 422 @var{allow-large-adjustment?} determines whether @command{ntpd} is allowed to
 423 make an initial adjustment of more than 1,000 seconds."
 424   (service ntp-service-type
 425            (ntp-configuration (ntp ntp)
 426                               (servers servers)
 427                               (allow-large-adjustment?
 428                                allow-large-adjustment?))))
 429
 430 \f
 431 ;;;
 432 ;;; Tor.
 433 ;;;
 434
 435 (define-record-type* <tor-configuration>
 436   tor-configuration make-tor-configuration
 437   tor-configuration?
 438   (tor              tor-configuration-tor
 439                     (default tor))
 440   (config-file      tor-configuration-config-file)
 441   (hidden-services  tor-configuration-hidden-services
 442                     (default '())))
 443
 444 (define %tor-accounts
 445   ;; User account and groups for Tor.
 446   (list (user-group (name "tor") (system? #t))
 447         (user-account
 448          (name "tor")
 449          (group "tor")
 450          (system? #t)
 451          (comment "Tor daemon user")
 452          (home-directory "/var/empty")
 453          (shell (file-append shadow "/sbin/nologin")))))
 454
 455 (define-record-type <hidden-service>
 456   (hidden-service name mapping)
 457   hidden-service?
 458   (name    hidden-service-name)                   ;string
 459   (mapping hidden-service-mapping))               ;list of port/address tuples
 460
 461 (define (tor-configuration->torrc config)
 462   "Return a 'torrc' file for CONFIG."
 463   (match config
 464     (($ <tor-configuration> tor config-file services)
 465      (computed-file
 466       "torrc"
 467       (with-imported-modules '((guix build utils))
 468         #~(begin
 469             (use-modules (guix build utils)
 470                          (ice-9 match))
 471
 472             (call-with-output-file #$output
 473               (lambda (port)
 474                 (display "\
 475 # The beginning was automatically added.
 476 User tor
 477 DataDirectory /var/lib/tor
 478 Log notice syslog\n" port)
 479
 480                 (for-each (match-lambda
 481                             ((service (ports hosts) ...)
 482                              (format port "\
 483 HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
 484                                      service)
 485                              (for-each (lambda (tcp-port host)
 486                                          (format port "\
 487 HiddenServicePort ~a ~a~%"
 488                                                  tcp-port host))
 489                                        ports hosts)))
 490                           '#$(map (match-lambda
 491                                     (($ <hidden-service> name mapping)
 492                                      (cons name mapping)))
 493                                   services))
 494
 495                 ;; Append the user's config file.
 496                 (call-with-input-file #$config-file
 497                   (lambda (input)
 498                     (dump-port input port)))
 499                 #t))))))))
 500
 501 (define (tor-shepherd-service config)
 502   "Return a <shepherd-service> running TOR."
 503   (match config
 504     (($ <tor-configuration> tor)
 505      (let ((torrc (tor-configuration->torrc config)))
 506        (list (shepherd-service
 507               (provision '(tor))
 508
 509               ;; Tor needs at least one network interface to be up, hence the
 510               ;; dependency on 'loopback'.
 511               (requirement '(user-processes loopback syslogd))
 512
 513               (start #~(make-forkexec-constructor
 514                         (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
 515               (stop #~(make-kill-destructor))
 516               (documentation "Run the Tor anonymous network overlay.")))))))
 517
 518 (define (tor-hidden-service-activation config)
 519   "Return the activation gexp for SERVICES, a list of hidden services."
 520   #~(begin
 521       (use-modules (guix build utils))
 522
 523       (define %user
 524         (getpw "tor"))
 525
 526       (define (initialize service)
 527         (let ((directory (string-append "/var/lib/tor/hidden-services/"
 528                                         service)))
 529           (mkdir-p directory)
 530           (chown directory (passwd:uid %user) (passwd:gid %user))
 531
 532           ;; The daemon bails out if we give wider permissions.
 533           (chmod directory #o700)))
 534
 535       (mkdir-p "/var/lib/tor")
 536       (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
 537       (chmod "/var/lib/tor" #o700)
 538
 539       ;; Make sure /var/lib is accessible to the 'tor' user.
 540       (chmod "/var/lib" #o755)
 541
 542       (for-each initialize
 543                 '#$(map hidden-service-name
 544                         (tor-configuration-hidden-services config)))))
 545
 546 (define tor-service-type
 547   (service-type (name 'tor)
 548                 (extensions
 549                  (list (service-extension shepherd-root-service-type
 550                                           tor-shepherd-service)
 551                        (service-extension account-service-type
 552                                           (const %tor-accounts))
 553                        (service-extension activation-service-type
 554                                           tor-hidden-service-activation)))
 555
 556                 ;; This can be extended with hidden services.
 557                 (compose concatenate)
 558                 (extend (lambda (config services)
 559                           (tor-configuration
 560                            (inherit config)
 561                            (hidden-services
 562                             (append (tor-configuration-hidden-services config)
 563                                     services)))))))
 564
 565 (define* (tor-service #:optional
 566                       (config-file (plain-file "empty" ""))
 567                       #:key (tor tor))
 568   "Return a service to run the @uref{https://torproject.org, Tor} anonymous
 569 networking daemon.
 570
 571 The daemon runs as the @code{tor} unprivileged user.  It is passed
 572 @var{config-file}, a file-like object, with an additional @code{User tor} line
 573 and lines for hidden services added via @code{tor-hidden-service}.  Run
 574 @command{man tor} for information about the configuration file."
 575   (service tor-service-type
 576            (tor-configuration (tor tor)
 577                               (config-file config-file))))
 578
 579 (define tor-hidden-service-type
 580   ;; A type that extends Tor with hidden services.
 581   (service-type (name 'tor-hidden-service)
 582                 (extensions
 583                  (list (service-extension tor-service-type list)))))
 584
 585 (define (tor-hidden-service name mapping)
 586   "Define a new Tor @dfn{hidden service} called @var{name} and implementing
 587 @var{mapping}.  @var{mapping} is a list of port/host tuples, such as:
 588
 589 @example
 590  '((22 \"127.0.0.1:22\")
 591    (80 \"127.0.0.1:8080\"))
 592 @end example
 593
 594 In this example, port 22 of the hidden service is mapped to local port 22, and
 595 port 80 is mapped to local port 8080.
 596
 597 This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
 598 the @file{hostname} file contains the @code{.onion} host name for the hidden
 599 service.
 600
 601 See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
 602 project's documentation} for more information."
 603   (service tor-hidden-service-type
 604            (hidden-service name mapping)))
 605
 606 \f
 607 ;;;
 608 ;;; BitlBee.
 609 ;;;
 610
 611 (define-record-type* <bitlbee-configuration>
 612   bitlbee-configuration make-bitlbee-configuration
 613   bitlbee-configuration?
 614   (bitlbee bitlbee-configuration-bitlbee
 615            (default bitlbee))
 616   (interface bitlbee-configuration-interface)
 617   (port bitlbee-configuration-port)
 618   (extra-settings bitlbee-configuration-extra-settings))
 619
 620 (define bitlbee-shepherd-service
 621   (match-lambda
 622     (($ <bitlbee-configuration> bitlbee interface port extra-settings)
 623      (let ((conf (plain-file "bitlbee.conf"
 624                              (string-append "
 625   [settings]
 626   User = bitlbee
 627   ConfigDir = /var/lib/bitlbee
 628   DaemonInterface = " interface "
 629   DaemonPort = " (number->string port) "
 630 " extra-settings))))
 631
 632        (with-imported-modules (source-module-closure
 633                                '((gnu build shepherd)
 634                                  (gnu system file-systems)))
 635          (list (shepherd-service
 636                 (provision '(bitlbee))
 637
 638                 ;; Note: If networking is not up, then /etc/resolv.conf
 639                 ;; doesn't get mapped in the container, hence the dependency
 640                 ;; on 'networking'.
 641                 (requirement '(user-processes networking))
 642
 643                 (modules '((gnu build shepherd)
 644                            (gnu system file-systems)))
 645                 (start #~(make-forkexec-constructor/container
 646                           (list #$(file-append bitlbee "/sbin/bitlbee")
 647                                 "-n" "-F" "-u" "bitlbee" "-c" #$conf)
 648
 649                           #:pid-file "/var/run/bitlbee.pid"
 650                           #:mappings (list (file-system-mapping
 651                                             (source "/var/lib/bitlbee")
 652                                             (target source)
 653                                             (writable? #t)))))
 654                 (stop  #~(make-kill-destructor)))))))))
 655
 656 (define %bitlbee-accounts
 657   ;; User group and account to run BitlBee.
 658   (list (user-group (name "bitlbee") (system? #t))
 659         (user-account
 660          (name "bitlbee")
 661          (group "bitlbee")
 662          (system? #t)
 663          (comment "BitlBee daemon user")
 664          (home-directory "/var/empty")
 665          (shell (file-append shadow "/sbin/nologin")))))
 666
 667 (define %bitlbee-activation
 668   ;; Activation gexp for BitlBee.
 669   #~(begin
 670       (use-modules (guix build utils))
 671
 672       ;; This directory is used to store OTR data.
 673       (mkdir-p "/var/lib/bitlbee")
 674       (let ((user (getpwnam "bitlbee")))
 675         (chown "/var/lib/bitlbee"
 676                (passwd:uid user) (passwd:gid user)))))
 677
 678 (define bitlbee-service-type
 679   (service-type (name 'bitlbee)
 680                 (extensions
 681                  (list (service-extension shepherd-root-service-type
 682                                           bitlbee-shepherd-service)
 683                        (service-extension account-service-type
 684                                           (const %bitlbee-accounts))
 685                        (service-extension activation-service-type
 686                                           (const %bitlbee-activation))))))
 687
 688 (define* (bitlbee-service #:key (bitlbee bitlbee)
 689                           (interface "127.0.0.1") (port 6667)
 690                           (extra-settings ""))
 691   "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
 692 acts as a gateway between IRC and chat networks.
 693
 694 The daemon will listen to the interface corresponding to the IP address
 695 specified in @var{interface}, on @var{port}.  @code{127.0.0.1} means that only
 696 local clients can connect, whereas @code{0.0.0.0} means that connections can
 697 come from any networking interface.
 698
 699 In addition, @var{extra-settings} specifies a string to append to the
 700 configuration file."
 701   (service bitlbee-service-type
 702            (bitlbee-configuration
 703             (bitlbee bitlbee)
 704             (interface interface) (port port)
 705             (extra-settings extra-settings))))
 706
 707 \f
 708 ;;;
 709 ;;; Wicd.
 710 ;;;
 711
 712 (define %wicd-activation
 713   ;; Activation gexp for Wicd.
 714   #~(begin
 715       (use-modules (guix build utils))
 716
 717       (mkdir-p "/etc/wicd")
 718       (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
 719         (unless (file-exists? file-name)
 720           (copy-file (string-append #$wicd file-name)
 721                      file-name)))
 722
 723       ;; Wicd invokes 'wpa_supplicant', which needs this directory for its
 724       ;; named socket files.
 725       (mkdir-p "/var/run/wpa_supplicant")
 726       (chmod "/var/run/wpa_supplicant" #o750)))
 727
 728 (define (wicd-shepherd-service wicd)
 729   "Return a shepherd service for WICD."
 730   (list (shepherd-service
 731          (documentation "Run the Wicd network manager.")
 732          (provision '(networking))
 733          (requirement '(user-processes dbus-system loopback))
 734          (start #~(make-forkexec-constructor
 735                    (list (string-append #$wicd "/sbin/wicd")
 736                          "--no-daemon")))
 737          (stop #~(make-kill-destructor)))))
 738
 739 (define wicd-service-type
 740   (service-type (name 'wicd)
 741                 (extensions
 742                  (list (service-extension shepherd-root-service-type
 743                                           wicd-shepherd-service)
 744                        (service-extension dbus-root-service-type
 745                                           list)
 746                        (service-extension activation-service-type
 747                                           (const %wicd-activation))
 748
 749                        ;; Add Wicd to the global profile.
 750                        (service-extension profile-service-type list)))))
 751
 752 (define* (wicd-service #:key (wicd wicd))
 753   "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
 754 management daemon that aims to simplify wired and wireless networking.
 755
 756 This service adds the @var{wicd} package to the global profile, providing
 757 several commands to interact with the daemon and configure networking:
 758 @command{wicd-client}, a graphical user interface, and the @command{wicd-cli}
 759 and @command{wicd-curses} user interfaces."
 760   (service wicd-service-type wicd))
 761
 762 \f
 763 ;;;
 764 ;;; NetworkManager
 765 ;;;
 766
 767 (define-record-type* <network-manager-configuration>
 768   network-manager-configuration make-network-manager-configuration
 769   network-manager-configuration?
 770   (network-manager network-manager-configuration-network-manager
 771                    (default network-manager))
 772   (dns network-manager-configuration-dns
 773        (default "default")))
 774
 775 (define %network-manager-activation
 776   ;; Activation gexp for NetworkManager.
 777   #~(begin
 778       (use-modules (guix build utils))
 779       (mkdir-p "/etc/NetworkManager/system-connections")))
 780
 781 (define network-manager-shepherd-service
 782   (match-lambda
 783     (($ <network-manager-configuration> network-manager dns)
 784      (let
 785          ((conf (plain-file "NetworkManager.conf"
 786                             (string-append "
 787 [main]
 788 dns=" dns "
 789 "))))
 790      (list (shepherd-service
 791             (documentation "Run the NetworkManager.")
 792             (provision '(networking))
 793             (requirement '(user-processes dbus-system wpa-supplicant loopback))
 794             (start #~(make-forkexec-constructor
 795                       (list (string-append #$network-manager
 796                                            "/sbin/NetworkManager")
 797                             (string-append "--config=" #$conf)
 798                             "--no-daemon")))
 799             (stop #~(make-kill-destructor))))))))
 800
 801 (define network-manager-service-type
 802   (let
 803       ((config->package
 804         (match-lambda
 805          (($ <network-manager-configuration> network-manager)
 806           (list network-manager)))))
 807
 808     (service-type
 809      (name 'network-manager)
 810      (extensions
 811       (list (service-extension shepherd-root-service-type
 812                                network-manager-shepherd-service)
 813             (service-extension dbus-root-service-type config->package)
 814             (service-extension polkit-service-type config->package)
 815             (service-extension activation-service-type
 816                                (const %network-manager-activation))
 817             ;; Add network-manager to the system profile.
 818             (service-extension profile-service-type config->package))))))
 819
 820 \f
 821 ;;;
 822 ;;; Connman
 823 ;;;
 824
 825 (define %connman-activation
 826   ;; Activation gexp for Connman.
 827   #~(begin
 828       (use-modules (guix build utils))
 829       (mkdir-p "/var/lib/connman/")
 830       (mkdir-p "/var/lib/connman-vpn/")))
 831
 832 (define (connman-shepherd-service connman)
 833   "Return a shepherd service for Connman"
 834   (list (shepherd-service
 835          (documentation "Run Connman")
 836          (provision '(networking))
 837          (requirement '(user-processes dbus-system loopback wpa-supplicant))
 838          (start #~(make-forkexec-constructor
 839                    (list (string-append #$connman
 840                                         "/sbin/connmand")
 841                          "-n" "-r")))
 842          (stop #~(make-kill-destructor)))))
 843
 844 (define connman-service-type
 845   (service-type (name 'connman)
 846                 (extensions
 847                  (list (service-extension shepherd-root-service-type
 848                                           connman-shepherd-service)
 849                        (service-extension dbus-root-service-type list)
 850                        (service-extension activation-service-type
 851                                           (const %connman-activation))
 852                        ;; Add connman to the system profile.
 853                        (service-extension profile-service-type list)))))
 854
 855 (define* (connman-service #:key (connman connman))
 856   "Return a service that runs @url{https://01.org/connman,Connman}, a network
 857 connection manager.
 858
 859 This service adds the @var{connman} package to the global profile, providing
 860 several the @command{connmanctl} command to interact with the daemon and
 861 configure networking."
 862   (service connman-service-type connman))
 863
 864
 865 \f
 866 ;;;
 867 ;;; WPA supplicant
 868 ;;;
 869
 870
 871 (define (wpa-supplicant-shepherd-service wpa-supplicant)
 872   "Return a shepherd service for wpa_supplicant"
 873   (list (shepherd-service
 874          (documentation "Run WPA supplicant with dbus interface")
 875          (provision '(wpa-supplicant))
 876          (requirement '(user-processes dbus-system loopback))
 877          (start #~(make-forkexec-constructor
 878                    (list (string-append #$wpa-supplicant
 879                                         "/sbin/wpa_supplicant")
 880                          "-u" "-B" "-P/var/run/wpa_supplicant.pid")
 881                    #:pid-file "/var/run/wpa_supplicant.pid"))
 882          (stop #~(make-kill-destructor)))))
 883
 884 (define wpa-supplicant-service-type
 885   (service-type (name 'wpa-supplicant)
 886                 (extensions
 887                  (list (service-extension shepherd-root-service-type
 888                                           wpa-supplicant-shepherd-service)
 889                        (service-extension dbus-root-service-type list)
 890                        (service-extension profile-service-type list)))))
 891
 892 \f
 893 ;;;
 894 ;;; Open vSwitch
 895 ;;;
 896
 897 (define-record-type* <openvswitch-configuration>
 898   openvswitch-configuration make-openvswitch-configuration
 899   openvswitch-configuration?
 900   (package openvswitch-configuration-package
 901            (default openvswitch)))
 902
 903 (define openvswitch-activation
 904   (match-lambda
 905     (($ <openvswitch-configuration> package)
 906      (let ((ovsdb-tool (file-append package "/bin/ovsdb-tool")))
 907        (with-imported-modules '((guix build utils))
 908          #~(begin
 909              (use-modules (guix build utils))
 910              (mkdir-p "/var/run/openvswitch")
 911              (mkdir-p "/var/lib/openvswitch")
 912              (let ((conf.db "/var/lib/openvswitch/conf.db"))
 913                (unless (file-exists? conf.db)
 914                  (system* #$ovsdb-tool "create" conf.db)))))))))
 915
 916 (define openvswitch-shepherd-service
 917   (match-lambda
 918     (($ <openvswitch-configuration> package)
 919      (let ((ovsdb-server (file-append package "/sbin/ovsdb-server"))
 920            (ovs-vswitchd (file-append package "/sbin/ovs-vswitchd")))
 921        (list
 922         (shepherd-service
 923          (provision '(ovsdb))
 924          (documentation "Run the Open vSwitch database server.")
 925          (start #~(make-forkexec-constructor
 926                    (list #$ovsdb-server "--pidfile"
 927                          "--remote=punix:/var/run/openvswitch/db.sock")
 928                    #:pid-file "/var/run/openvswitch/ovsdb-server.pid"))
 929          (stop #~(make-kill-destructor)))
 930         (shepherd-service
 931          (provision '(vswitchd))
 932          (requirement '(ovsdb))
 933          (documentation "Run the Open vSwitch daemon.")
 934          (start #~(make-forkexec-constructor
 935                    (list #$ovs-vswitchd "--pidfile")
 936                    #:pid-file "/var/run/openvswitch/ovs-vswitchd.pid"))
 937          (stop #~(make-kill-destructor))))))))
 938
 939 (define openvswitch-service-type
 940   (service-type
 941    (name 'openvswitch)
 942    (extensions
 943     (list (service-extension activation-service-type
 944                              openvswitch-activation)
 945           (service-extension profile-service-type
 946                              (compose list openvswitch-configuration-package))
 947           (service-extension shepherd-root-service-type
 948                              openvswitch-shepherd-service)))))
 949
 950 ;;; networking.scm ends here