gnu/services/networking.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu services networking)
  21   #:use-module (gnu services)
  22   #:use-module (gnu system shadow)
  23   #:use-module (gnu packages admin)
  24   #:use-module (gnu packages linux)
  25   #:use-module (gnu packages tor)
  26   #:use-module (gnu packages messaging)
  27   #:use-module (gnu packages ntp)
  28   #:use-module (gnu packages wicd)
  29   #:use-module (guix gexp)
  30   #:use-module (guix store)
  31   #:use-module (guix monads)
  32   #:use-module (srfi srfi-26)
  33   #:export (%facebook-host-aliases
  34             static-networking-service
  35             dhcp-client-service
  36             %ntp-servers
  37             ntp-service
  38             tor-service
  39             bitlbee-service
  40             wicd-service))
  41
  42 ;;; Commentary:
  43 ;;;
  44 ;;; Networking services.
  45 ;;;
  46 ;;; Code:
  47
  48 (define %facebook-host-aliases
  49   ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
  50   ;; are to block it.
  51   "\
  52 # Block Facebook IPv4.
  53 127.0.0.1   www.facebook.com
  54 127.0.0.1   facebook.com
  55 127.0.0.1   login.facebook.com
  56 127.0.0.1   www.login.facebook.com
  57 127.0.0.1   fbcdn.net
  58 127.0.0.1   www.fbcdn.net
  59 127.0.0.1   fbcdn.com
  60 127.0.0.1   www.fbcdn.com
  61 127.0.0.1   static.ak.fbcdn.net
  62 127.0.0.1   static.ak.connect.facebook.com
  63 127.0.0.1   connect.facebook.net
  64 127.0.0.1   www.connect.facebook.net
  65 127.0.0.1   apps.facebook.com
  66
  67 # Block Facebook IPv6.
  68 fe80::1%lo0 facebook.com
  69 fe80::1%lo0 login.facebook.com
  70 fe80::1%lo0 www.login.facebook.com
  71 fe80::1%lo0 fbcdn.net
  72 fe80::1%lo0 www.fbcdn.net
  73 fe80::1%lo0 fbcdn.com
  74 fe80::1%lo0 www.fbcdn.com
  75 fe80::1%lo0 static.ak.fbcdn.net
  76 fe80::1%lo0 static.ak.connect.facebook.com
  77 fe80::1%lo0 connect.facebook.net
  78 fe80::1%lo0 www.connect.facebook.net
  79 fe80::1%lo0 apps.facebook.com\n")
  80
  81
  82 (define* (static-networking-service interface ip
  83                                     #:key
  84                                     gateway
  85                                     (provision '(networking))
  86                                     (name-servers '())
  87                                     (net-tools net-tools))
  88   "Return a service that starts @var{interface} with address @var{ip}.  If
  89 @var{gateway} is true, it must be a string specifying the default network
  90 gateway."
  91   (define loopback?
  92     (memq 'loopback provision))
  93
  94   ;; TODO: Eventually replace 'route' with bindings for the appropriate
  95   ;; ioctls.
  96   (with-monad %store-monad
  97     (return
  98      (service
  99
 100       ;; Unless we're providing the loopback interface, wait for udev to be up
 101       ;; and running so that INTERFACE is actually usable.
 102       (requirement (if loopback? '() '(udev)))
 103
 104       (documentation
 105        "Bring up the networking interface using a static IP address.")
 106       (provision provision)
 107       (start #~(lambda _
 108                  ;; Return #t if successfully started.
 109                  (let* ((addr     (inet-pton AF_INET #$ip))
 110                         (sockaddr (make-socket-address AF_INET addr 0)))
 111                    (configure-network-interface #$interface sockaddr
 112                                                 (logior IFF_UP
 113                                                         #$(if loopback?
 114                                                               #~IFF_LOOPBACK
 115                                                               0))))
 116                  #$(if gateway
 117                        #~(zero? (system* (string-append #$net-tools
 118                                                         "/sbin/route")
 119                                          "add" "-net" "default"
 120                                          "gw" #$gateway))
 121                        #t)
 122                  #$(if (pair? name-servers)
 123                        #~(call-with-output-file "/etc/resolv.conf"
 124                            (lambda (port)
 125                              (display
 126                               "# Generated by 'static-networking-service'.\n"
 127                               port)
 128                              (for-each (lambda (server)
 129                                          (format port "nameserver ~a~%"
 130                                                  server))
 131                                        '#$name-servers)))
 132                        #t)))
 133       (stop #~(lambda _
 134                 ;; Return #f is successfully stopped.
 135                 (let ((sock (socket AF_INET SOCK_STREAM 0)))
 136                   (set-network-interface-flags sock #$interface 0)
 137                   (close-port sock))
 138                 (not #$(if gateway
 139                            #~(system* (string-append #$net-tools
 140                                                      "/sbin/route")
 141                                       "del" "-net" "default")
 142                            #t))))
 143       (respawn? #f)))))
 144
 145 (define* (dhcp-client-service #:key (dhcp isc-dhcp))
 146   "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
 147 Protocol (DHCP) client, on all the non-loopback network interfaces."
 148
 149   (define dhclient
 150     #~(string-append #$dhcp "/sbin/dhclient"))
 151
 152   (define pid-file
 153     "/var/run/dhclient.pid")
 154
 155   (with-monad %store-monad
 156     (return (service
 157              (documentation "Set up networking via DHCP.")
 158              (requirement '(user-processes udev))
 159
 160              ;; XXX: Running with '-nw' ("no wait") avoids blocking for a
 161              ;; minute when networking is unavailable, but also means that the
 162              ;; interface is not up yet when 'start' completes.  To wait for
 163              ;; the interface to be ready, one should instead monitor udev
 164              ;; events.
 165              (provision '(networking))
 166
 167              (start #~(lambda _
 168                         ;; When invoked without any arguments, 'dhclient'
 169                         ;; discovers all non-loopback interfaces *that are
 170                         ;; up*.  However, the relevant interfaces are
 171                         ;; typically down at this point.  Thus we perform our
 172                         ;; own interface discovery here.
 173                         (define valid?
 174                           (negate loopback-network-interface?))
 175                         (define ifaces
 176                           (filter valid? (all-network-interfaces)))
 177
 178                         ;; XXX: Make sure the interfaces are up so that
 179                         ;; 'dhclient' can actually send/receive over them.
 180                         (for-each set-network-interface-up ifaces)
 181
 182                         (false-if-exception (delete-file #$pid-file))
 183                         (let ((pid (fork+exec-command
 184                                     (cons* #$dhclient "-nw"
 185                                            "-pf" #$pid-file ifaces))))
 186                           (and (zero? (cdr (waitpid pid)))
 187                                (let loop ()
 188                                  (catch 'system-error
 189                                    (lambda ()
 190                                      (call-with-input-file #$pid-file read))
 191                                    (lambda args
 192                                      ;; 'dhclient' returned before PID-FILE
 193                                      ;; was created, so try again.
 194                                      (let ((errno (system-error-errno args)))
 195                                        (if (= ENOENT errno)
 196                                            (begin
 197                                              (sleep 1)
 198                                              (loop))
 199                                            (apply throw args))))))))))
 200              (stop #~(make-kill-destructor))))))
 201
 202 (define %ntp-servers
 203   ;; Default set of NTP servers.
 204   '("0.pool.ntp.org"
 205     "1.pool.ntp.org"
 206     "2.pool.ntp.org"))
 207
 208 (define* (ntp-service #:key (ntp ntp)
 209                       (servers %ntp-servers))
 210   "Return a service that runs the daemon from @var{ntp}, the
 211 @uref{http://www.ntp.org, Network Time Protocol package}.  The daemon will
 212 keep the system clock synchronized with that of @var{servers}."
 213   ;; TODO: Add authentication support.
 214
 215   (define config
 216     (string-append "driftfile /var/run/ntp.drift\n"
 217                    (string-join (map (cut string-append "server " <>)
 218                                      servers)
 219                                 "\n")
 220                    "
 221 # Disable status queries as a workaround for CVE-2013-5211:
 222 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 223 restrict default kod nomodify notrap nopeer noquery
 224 restrict -6 default kod nomodify notrap nopeer noquery
 225
 226 # Yet, allow use of the local 'ntpq'.
 227 restrict 127.0.0.1
 228 restrict -6 ::1\n"))
 229
 230   (mlet %store-monad ((ntpd.conf (text-file "ntpd.conf" config)))
 231     (return
 232      (service
 233       (provision '(ntpd))
 234       (documentation "Run the Network Time Protocol (NTP) daemon.")
 235       (requirement '(user-processes networking))
 236       (start #~(make-forkexec-constructor
 237                 (list (string-append #$ntp "/bin/ntpd") "-n"
 238                       "-c" #$ntpd.conf
 239                       "-u" "ntpd")))
 240       (stop #~(make-kill-destructor))
 241       (user-accounts (list (user-account
 242                             (name "ntpd")
 243                             (group "nogroup")
 244                             (system? #t)
 245                             (comment "NTP daemon user")
 246                             (home-directory "/var/empty")
 247                             (shell
 248                              #~(string-append #$shadow "/sbin/nologin")))))))))
 249
 250 (define* (tor-service #:key (tor tor))
 251   "Return a service to run the @uref{https://torproject.org,Tor} daemon.
 252
 253 The daemon runs with the default settings (in particular the default exit
 254 policy) as the @code{tor} unprivileged user."
 255   (mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
 256     (return
 257      (service
 258       (provision '(tor))
 259
 260       ;; Tor needs at least one network interface to be up, hence the
 261       ;; dependency on 'loopback'.
 262       (requirement '(user-processes loopback))
 263
 264       (start #~(make-forkexec-constructor
 265                 (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
 266       (stop #~(make-kill-destructor))
 267
 268       (user-groups   (list (user-group
 269                             (name "tor")
 270                             (system? #t))))
 271       (user-accounts (list (user-account
 272                             (name "tor")
 273                             (group "tor")
 274                             (system? #t)
 275                             (comment "Tor daemon user")
 276                             (home-directory "/var/empty")
 277                             (shell
 278                              #~(string-append #$shadow "/sbin/nologin")))))
 279
 280       (documentation "Run the Tor anonymous network overlay.")))))
 281
 282 (define* (bitlbee-service #:key (bitlbee bitlbee)
 283                           (interface "127.0.0.1") (port 6667)
 284                           (extra-settings ""))
 285   "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
 286 acts as a gateway between IRC and chat networks.
 287
 288 The daemon will listen to the interface corresponding to the IP address
 289 specified in @var{interface}, on @var{port}.  @code{127.0.0.1} means that only
 290 local clients can connect, whereas @code{0.0.0.0} means that connections can
 291 come from any networking interface.
 292
 293 In addition, @var{extra-settings} specifies a string to append to the
 294 configuration file."
 295   (mlet %store-monad ((conf (text-file "bitlbee.conf"
 296                                        (string-append "
 297   [settings]
 298   User = bitlbee
 299   ConfigDir = /var/lib/bitlbee
 300   DaemonInterface = " interface "
 301   DaemonPort = " (number->string port) "
 302 " extra-settings))))
 303     (return
 304      (service
 305       (provision '(bitlbee))
 306       (requirement '(user-processes loopback))
 307       (activate #~(begin
 308                     (use-modules (guix build utils))
 309
 310                     ;; This directory is used to store OTR data.
 311                     (mkdir-p "/var/lib/bitlbee")
 312                     (let ((user (getpwnam "bitlbee")))
 313                       (chown "/var/lib/bitlbee"
 314                              (passwd:uid user) (passwd:gid user)))))
 315       (start #~(make-forkexec-constructor
 316                 (list (string-append #$bitlbee "/sbin/bitlbee")
 317                       "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
 318       (stop  #~(make-kill-destructor))
 319       (user-groups   (list (user-group (name "bitlbee") (system? #t))))
 320       (user-accounts (list (user-account
 321                             (name "bitlbee")
 322                             (group "bitlbee")
 323                             (system? #t)
 324                             (comment "BitlBee daemon user")
 325                             (home-directory "/var/empty")
 326                             (shell #~(string-append #$shadow
 327                                                     "/sbin/nologin")))))))))
 328
 329 (define* (wicd-service #:key (wicd wicd))
 330   "Return a service that runs @url{https://launchpad.net/wicd,Wicd}, a network
 331 manager that aims to simplify wired and wireless networking."
 332   (with-monad %store-monad
 333     (return
 334      (service
 335       (documentation "Run the Wicd network manager.")
 336       (provision '(networking))
 337       (requirement '(user-processes dbus-system loopback))
 338       (start #~(make-forkexec-constructor
 339                 (list (string-append #$wicd "/sbin/wicd")
 340                       "--no-daemon")))
 341       (stop #~(make-kill-destructor))
 342       (activate
 343        #~(begin
 344            (use-modules (guix build utils))
 345            (mkdir-p "/etc/wicd")
 346            (let ((file-name "/etc/wicd/dhclient.conf.template.default"))
 347              (unless (file-exists? file-name)
 348                (copy-file (string-append #$wicd file-name)
 349                           file-name)))))))))
 350
 351 ;;; networking.scm ends here