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