;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; 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 . (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 (gnu packages messaging) #:use-module (guix gexp) #:use-module (guix monads) #:export (static-networking-service dhcp-client-service tor-service bitlbee-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 ;; Unless we're providing the loopback interface, wait for udev to be up ;; and running so that INTERFACE is actually usable. (requirement (if (memq 'loopback provision) '() '(udev))) (documentation "Bring up the networking 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* (dhcp-client-service #:key (dhcp isc-dhcp)) "Return a service that runs @var{dhcp}, a Dynamic Host Configuration Protocol (DHCP) client, on all the non-loopback network interfaces." (define dhclient #~(string-append #$dhcp "/sbin/dhclient")) (define pid-file "/var/run/dhclient.pid") (with-monad %store-monad (return (service (documentation "Set up networking via DHCP.") (requirement '(user-processes udev)) ;; XXX: Running with '-nw' ("no wait") avoids blocking for a ;; minute when networking is unavailable, but also means that the ;; interface is not up yet when 'start' completes. To wait for ;; the interface to be ready, one should instead monitor udev ;; events. (provision '(networking)) (start #~(lambda _ ;; When invoked without any arguments, 'dhclient' ;; discovers all non-loopback interfaces *that are ;; up*. However, the relevant interfaces are ;; typically down at this point. Thus we perform our ;; own interface discovery here. (let* ((valid? (negate loopback-network-interface?)) (ifaces (filter valid? (all-network-interfaces))) (pid (fork+exec-command (cons* #$dhclient "-nw" "-pf" #$pid-file ifaces)))) (and (zero? (cdr (waitpid pid))) (call-with-input-file #$pid-file read))))) (stop #~(make-kill-destructor)))))) (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."))))) (define* (bitlbee-service #:key (bitlbee bitlbee) (interface "127.0.0.1") (port 6667) (extra-settings "")) "Return a service that runs @url{http://bitlbee.org,BitlBee}, a daemon that acts as a gateway between IRC and chat networks. The daemon will listen to the interface corresponding to the IP address specified in @var{interface}, on @var{port}. @code{127.0.0.1} means that only local clients can connect, whereas @code{0.0.0.0} means that connections can come from any networking interface. In addition, @var{extra-settings} specifies a string to append to the configuration file." (mlet %store-monad ((conf (text-file "bitlbee.conf" (string-append " [settings] User = bitlbee ConfigDir = /var/lib/bitlbee DaemonInterface = " interface " DaemonPort = " (number->string port) " " extra-settings)))) (return (service (provision '(bitlbee)) (requirement '(user-processes loopback)) (start #~(make-forkexec-constructor (list (string-append #$bitlbee "/sbin/bitlbee") "-n" "-F" "-u" "bitlbee" "-c" #$conf))) (stop #~(make-kill-destructor)) (user-groups (list (user-group (name "bitlbee") (system? #t)))) (user-accounts (list (user-account (name "bitlbee") (group "bitlbee") (system? #t) (comment "BitlBee daemon user") (home-directory "/var/empty") (shell #~(string-append #$shadow "/sbin/nologin"))))))))) ;;; networking.scm ends here