124 lines
5.1 KiB
Scheme
124 lines
5.1 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
|
;;;
|
|
;;; This file is part of GNU Guix.
|
|
;;;
|
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
|
;;; under the terms of the GNU General Public License as published by
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
;;; your option) any later version.
|
|
;;;
|
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;; GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (gnu services networking)
|
|
#:use-module (gnu services)
|
|
#:use-module (gnu system shadow)
|
|
#:use-module (gnu packages admin)
|
|
#:use-module (gnu packages linux)
|
|
#:use-module (gnu packages tor)
|
|
#:use-module (guix gexp)
|
|
#:use-module (guix monads)
|
|
#:export (static-networking-service
|
|
tor-service))
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; Networking services.
|
|
;;;
|
|
;;; Code:
|
|
|
|
(define* (static-networking-service interface ip
|
|
#:key
|
|
gateway
|
|
(provision '(networking))
|
|
(name-servers '())
|
|
(inetutils inetutils)
|
|
(net-tools net-tools))
|
|
"Return a service that starts @var{interface} with address @var{ip}. If
|
|
@var{gateway} is true, it must be a string specifying the default network
|
|
gateway."
|
|
|
|
;; TODO: Eventually we should do this using Guile's networking procedures,
|
|
;; like 'configure-qemu-networking' does, but the patch that does this is
|
|
;; not yet in stock Guile.
|
|
(with-monad %store-monad
|
|
(return
|
|
(service
|
|
(documentation
|
|
(string-append "Set up networking on the '" interface
|
|
"' interface using a static IP address."))
|
|
(provision provision)
|
|
(start #~(lambda _
|
|
;; Return #t if successfully started.
|
|
(and (zero? (system* (string-append #$inetutils
|
|
"/bin/ifconfig")
|
|
"-i" #$interface "-A" #$ip
|
|
"-i" #$interface "--up"))
|
|
#$(if gateway
|
|
#~(zero? (system* (string-append #$net-tools
|
|
"/sbin/route")
|
|
"add" "-net" "default"
|
|
"gw" #$gateway))
|
|
#t)
|
|
#$(if (pair? name-servers)
|
|
#~(call-with-output-file "/etc/resolv.conf"
|
|
(lambda (port)
|
|
(display
|
|
"# Generated by 'static-networking-service'.\n"
|
|
port)
|
|
(for-each (lambda (server)
|
|
(format port "nameserver ~a~%"
|
|
server))
|
|
'#$name-servers)))
|
|
#t))))
|
|
(stop #~(lambda _
|
|
;; Return #f is successfully stopped.
|
|
(not (and (system* (string-append #$inetutils "/bin/ifconfig")
|
|
#$interface "down")
|
|
#$(if gateway
|
|
#~(system* (string-append #$net-tools
|
|
"/sbin/route")
|
|
"del" "-net" "default")
|
|
#t)))))
|
|
(respawn? #f)))))
|
|
|
|
(define* (tor-service #:key (tor tor))
|
|
"Return a service to run the @uref{https://torproject.org,Tor} daemon.
|
|
|
|
The daemon runs with the default settings (in particular the default exit
|
|
policy) as the @code{tor} unprivileged user."
|
|
(mlet %store-monad ((torrc (text-file "torrc" "User tor\n")))
|
|
(return
|
|
(service
|
|
(provision '(tor))
|
|
|
|
;; Tor needs at least one network interface to be up, hence the
|
|
;; dependency on 'loopback'.
|
|
(requirement '(user-processes loopback))
|
|
|
|
(start #~(make-forkexec-constructor
|
|
(list (string-append #$tor "/bin/tor") "-f" #$torrc)))
|
|
(stop #~(make-kill-destructor))
|
|
|
|
(user-groups (list (user-group
|
|
(name "tor")
|
|
(system? #t))))
|
|
(user-accounts (list (user-account
|
|
(name "tor")
|
|
(group "tor")
|
|
(system? #t)
|
|
(comment "Tor daemon user")
|
|
(home-directory "/var/empty")
|
|
(shell
|
|
"/run/current-system/profile/sbin/nologin"))))
|
|
|
|
(documentation "Run the Tor anonymous network overlay.")))))
|
|
|
|
;;; networking.scm ends here
|