gnu/services/networking.scm

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