summary refs log tree commit diff
path: root/gnu/services/networking.scm
blob: ce924a55bfb23bc6e1a595ffe1461ebd624a17a4 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
;;; 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

      ;; 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* (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