1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
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 (guix gexp)
27 #:use-module (guix monads)
28 #:export (static-networking-service
35 ;;; Networking services.
39 (define* (static-networking-service interface ip
42 (provision '(networking))
45 (net-tools net-tools))
46 "Return a service that starts @var{interface} with address @var{ip}. If
47 @var{gateway} is true, it must be a string specifying the default network
50 ;; TODO: Eventually we should do this using Guile's networking procedures,
51 ;; like 'configure-qemu-networking' does, but the patch that does this is
52 ;; not yet in stock Guile.
53 (with-monad %store-monad
57 ;; Unless we're providing the loopback interface, wait for udev to be up
58 ;; and running so that INTERFACE is actually usable.
59 (requirement (if (memq 'loopback provision)
64 "Bring up the networking interface using a static IP address.")
67 ;; Return #t if successfully started.
68 (and (zero? (system* (string-append #$inetutils
70 "-i" #$interface "-A" #$ip
71 "-i" #$interface "--up"))
73 #~(zero? (system* (string-append #$net-tools
75 "add" "-net" "default"
78 #$(if (pair? name-servers)
79 #~(call-with-output-file "/etc/resolv.conf"
82 "# Generated by 'static-networking-service'.\n"
84 (for-each (lambda (server)
85 (format port "nameserver ~a~%"
90 ;; Return #f is successfully stopped.
91 (not (and (system* (string-append #$inetutils "/bin/ifconfig")
94 #~(system* (string-append #$net-tools
96 "del" "-net" "default")
100 (define* (dhcp-client-service #:key (dhcp isc-dhcp))
101 "Return a service that runs @var{dhcp}, a Dynamic Host Configuration
102 Protocol (DHCP) client, on all the non-loopback network interfaces."
105 #~(string-append #$dhcp "/sbin/dhclient"))
108 "/var/run/dhclient.pid")
110 (with-monad %store-monad
112 (documentation "Set up networking via DHCP.")
113 (requirement '(user-processes udev))
115 ;; XXX: Running with '-nw' ("no wait") avoids blocking for a
116 ;; minute when networking is unavailable, but also means that the
117 ;; interface is not up yet when 'start' completes. To wait for
118 ;; the interface to be ready, one should instead monitor udev
120 (provision '(networking))
123 ;; When invoked without any arguments, 'dhclient'
124 ;; discovers all non-loopback interfaces *that are
125 ;; up*. However, the relevant interfaces are
126 ;; typically down at this point. Thus we perform our
127 ;; own interface discovery here.
128 (let* ((valid? (negate loopback-network-interface?))
129 (ifaces (filter valid?
130 (all-network-interfaces)))
131 (pid (fork+exec-command
132 (cons* #$dhclient "-nw"
135 (and (zero? (cdr (waitpid pid)))
136 (call-with-input-file #$pid-file read)))))
137 (stop #~(make-kill-destructor))))))
139 (define* (tor-service #:key (tor tor))
140 "Return a service to run the @uref{https://torproject.org,Tor} daemon.
142 The daemon runs with the default settings (in particular the default exit
143 policy) as the @code{tor} unprivileged user."
144 (mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
149 ;; Tor needs at least one network interface to be up, hence the
150 ;; dependency on 'loopback'.
151 (requirement '(user-processes loopback))
153 (start #~(make-forkexec-constructor
154 (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
155 (stop #~(make-kill-destructor))
157 (user-groups (list (user-group
160 (user-accounts (list (user-account
164 (comment "Tor daemon user")
165 (home-directory "/var/empty")
167 "/run/current-system/profile/sbin/nologin"))))
169 (documentation "Run the Tor anonymous network overlay.")))))
171 (define* (bitlbee-service #:key (bitlbee bitlbee)
172 (interface "127.0.0.1") (port 6667)
174 "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that
175 acts as a gateway between IRC and chat networks.
177 The daemon will listen to the interface corresponding to the IP address
178 specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only
179 local clients can connect, whereas @code{0.0.0.0} means that connections can
180 come from any networking interface.
182 In addition, @var{extra-settings} specifies a string to append to the
184 (mlet %store-monad ((conf (text-file "bitlbee.conf"
188 ConfigDir = /var/lib/bitlbee
189 DaemonInterface = " interface "
190 DaemonPort = " (number->string port) "
194 (provision '(bitlbee))
195 (requirement '(user-processes loopback))
196 (start #~(make-forkexec-constructor
197 (list (string-append #$bitlbee "/sbin/bitlbee")
198 "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
199 (stop #~(make-kill-destructor))
200 (user-groups (list (user-group (name "bitlbee") (system? #t))))
201 (user-accounts (list (user-account
205 (comment "BitlBee daemon user")
206 (home-directory "/var/empty")
207 (shell #~(string-append #$shadow
208 "/sbin/nologin")))))))))
210 ;;; networking.scm ends here