gnu/services/networking.scm

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