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