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