aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-27 23:04:49 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-27 23:04:49 +0100
commit6331bde73f26381e694f84e7e6885f1961abb8ae (patch)
tree0b05e019be400bcda9b7d1107cd8dd20a8a37629
parentfde40c98f916d36746dd78e742dff576146beef7 (diff)
downloadguix-6331bde73f26381e694f84e7e6885f1961abb8ae.tar.gz
guix-6331bde73f26381e694f84e7e6885f1961abb8ae.zip
services: Add 'tor-hidden-service'.
* gnu/services/networking.scm (<tor-configuration>, <hidden-service>): New record types. (tor-configuration->torrc): New procedure. (tor-dmd-service): Use it. (tor-hidden-service-activation): New procedure. (tor-service-type)[extensions]: Extend ACTIVATION-SERVICE-TYPE. [compose, extend]: New fields. (tor-service): Use 'tor-configuration'. (tor-hidden-service-type): New variable. (tor-hidden-service): New procedure.
-rw-r--r--doc/guix.texi25
-rw-r--r--gnu/services/networking.scm139
2 files changed, 145 insertions, 19 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index b4044531ed..2252bf9c18 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6580,8 +6580,29 @@ Return a service to run the @uref{https://torproject.org, Tor} anonymous
networking daemon.
The daemon runs as the @code{tor} unprivileged user. It is passed
-@var{config-file}, a file-like object, with an additional @code{User tor}
-line. Run @command{man tor} for information about the configuration file.
+@var{config-file}, a file-like object, with an additional @code{User tor} line
+and lines for hidden services added via @code{tor-hidden-service}. Run
+@command{man tor} for information about the configuration file.
+@end deffn
+
+@deffn {Scheme Procedure} tor-hidden-service @var{name} @var{mapping}
+Define a new Tor @dfn{hidden service} called @var{name} and implementing
+@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
+
+@example
+ '((22 \"127.0.0.1:22\")
+ (80 \"127.0.0.1:8080\"))
+@end example
+
+In this example, port 22 of the hidden service is mapped to local port 22, and
+port 80 is mapped to local port 8080.
+
+This creates a @file{/var/lib/tor/@var{name}} directory, where the
+@file{hostname} file contains the @code{.onion} host name for the hidden
+service.
+
+See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
+project's documentation} for more information.
@end deffn
@deffn {Scheme Procedure} bitlbee-service [#:bitlbee bitlbee] @
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 0bbacab1ad..e5b713678d 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -32,6 +32,8 @@
#:use-module (gnu packages gnome)
#:use-module (guix gexp)
#:use-module (guix records)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (%facebook-host-aliases
@@ -39,6 +41,7 @@
dhcp-client-service
%ntp-servers
ntp-service
+ tor-hidden-service
tor-service
bitlbee-service
wicd-service
@@ -307,6 +310,15 @@ keep the system clock synchronized with that of @var{servers}."
;;; Tor.
;;;
+(define-record-type* <tor-configuration>
+ tor-configuration make-tor-configuration
+ tor-configuration?
+ (tor tor-configuration-tor
+ (default tor))
+ (config-file tor-configuration-config-file)
+ (hidden-services tor-configuration-hidden-services
+ (default '())))
+
(define %tor-accounts
;; User account and groups for Tor.
(list (user-group (name "tor") (system? #t))
@@ -318,22 +330,55 @@ keep the system clock synchronized with that of @var{servers}."
(home-directory "/var/empty")
(shell #~(string-append #$shadow "/sbin/nologin")))))
+(define-record-type <hidden-service>
+ (hidden-service name mapping)
+ hidden-service?
+ (name hidden-service-name) ;string
+ (mapping hidden-service-mapping)) ;list of port/address tuples
+
+(define (tor-configuration->torrc config)
+ "Return a 'torrc' file for CONFIG."
+ (match config
+ (($ <tor-configuration> tor config-file services)
+ (computed-file
+ "torrc"
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (call-with-output-file #$output
+ (lambda (port)
+ (display "\
+# The beginning was automatically added.
+User tor\n" port)
+
+ (for-each (match-lambda
+ ((service (ports hosts) ...)
+ (format port "\
+HiddenServiceDir /var/lib/tor/~a~%"
+ service)
+ (for-each (lambda (tcp-port host)
+ (format port "\
+HiddenServicePort ~a ~a~%"
+ tcp-port host))
+ ports hosts)))
+ '#$(map (match-lambda
+ (($ <hidden-service> name mapping)
+ (cons name mapping)))
+ services))
+
+ ;; Append the user's config file.
+ (call-with-input-file #$config-file
+ (lambda (input)
+ (dump-port input port)))
+ #t)))
+ #:modules '((guix build utils))))))
+
(define (tor-dmd-service config)
"Return a <dmd-service> running TOR."
(match config
- ((tor config-file)
- (let ((torrc (computed-file "torrc"
- #~(begin
- (use-modules (guix build utils))
- (call-with-output-file #$output
- (lambda (port)
- (display "\
-User tor # automatically added\n" port)
- (call-with-input-file #$config-file
- (lambda (input)
- (dump-port input port)))
- #t)))
- #:modules '((guix build utils)))))
+ (($ <tor-configuration> tor)
+ (let ((torrc (tor-configuration->torrc config)))
(list (dmd-service
(provision '(tor))
@@ -346,13 +391,43 @@ User tor # automatically added\n" port)
(stop #~(make-kill-destructor))
(documentation "Run the Tor anonymous network overlay.")))))))
+(define (tor-hidden-service-activation config)
+ "Return the activation gexp for SERVICES, a list of hidden services."
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define (initialize service)
+ (let ((directory (string-append "/var/lib/tor/"
+ service))
+ (user (getpw "tor")))
+ (mkdir-p directory)
+ (chown directory (passwd:uid user) (passwd:gid user))
+
+ ;; The daemon bails out if we give wider permissions.
+ (chmod directory #o700)))
+
+ (for-each initialize
+ '#$(map hidden-service-name
+ (tor-configuration-hidden-services config)))))
+
(define tor-service-type
(service-type (name 'tor)
(extensions
(list (service-extension dmd-root-service-type
tor-dmd-service)
(service-extension account-service-type
- (const %tor-accounts))))))
+ (const %tor-accounts))
+ (service-extension activation-service-type
+ tor-hidden-service-activation)))
+
+ ;; This can be extended with hidden services.
+ (compose concatenate)
+ (extend (lambda (config services)
+ (tor-configuration
+ (inherit config)
+ (hidden-services
+ (append (tor-configuration-hidden-services config)
+ services)))))))
(define* (tor-service #:optional
(config-file (plain-file "empty" ""))
@@ -361,9 +436,39 @@ User tor # automatically added\n" port)
networking daemon.
The daemon runs as the @code{tor} unprivileged user. It is passed
-@var{config-file}, a file-like object, with an additional @code{User tor}
-line. Run @command{man tor} for information about the configuration file."
- (service tor-service-type (list tor config-file)))
+@var{config-file}, a file-like object, with an additional @code{User tor} line
+and lines for hidden services added via @code{tor-hidden-service}. Run
+@command{man tor} for information about the configuration file."
+ (service tor-service-type
+ (tor-configuration (tor tor)
+ (config-file config-file))))
+
+(define tor-hidden-service-type
+ ;; A type that extends Tor with hidden services.
+ (service-type (name 'tor-hidden-service)
+ (extensions
+ (list (service-extension tor-service-type list)))))
+
+(define (tor-hidden-service name mapping)
+ "Define a new Tor @dfn{hidden service} called @var{name} and implementing
+@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
+
+@example
+ '((22 \"127.0.0.1:22\")
+ (80 \"127.0.0.1:8080\"))
+@end example
+
+In this example, port 22 of the hidden service is mapped to local port 22, and
+port 80 is mapped to local port 8080.
+
+This creates a @file{/var/lib/tor/@var{name}} directory, where the
+@file{hostname} file contains the @code{.onion} host name for the hidden
+service.
+
+See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
+project's documentation} for more information."
+ (service tor-hidden-service-type
+ (hidden-service name mapping)))
;;;