From 375c610844c7776470edb88eafb18c48c6c90187 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 31 Oct 2015 11:17:08 +0100
Subject: services: 'tor-service' takes a 'config-file' parameter.

* gnu/services/networking.scm (tor-dmd-service): Take a 'config'
  parameter and honor it.
  (tor-service): Take a 'config-file' parameter.  Pass it in the
  service's value.
* doc/guix.texi (Networking Services): Adjust accordingly.
---
 doc/guix.texi               | 10 +++++----
 gnu/services/networking.scm | 49 ++++++++++++++++++++++++++++++---------------
 2 files changed, 39 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 84f194b14b..483d6e2608 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6393,11 +6393,13 @@ keep the system clock synchronized with that of @var{servers}.
 List of host names used as the default NTP servers.
 @end defvr
 
-@deffn {Scheme Procedure} tor-service [#:tor tor]
-Return a service to run the @uref{https://torproject.org,Tor} daemon.
+@deffn {Scheme Procedure} tor-service [@var{config-file}] [#:tor @var{tor}]
+Return a service to run the @uref{https://torproject.org, Tor} anonymous
+networking daemon.
 
-The daemon runs with the default settings (in particular the default exit
-policy) as the @code{tor} unprivileged user.
+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.
 @end deffn
 
 @deffn {Scheme Procedure} bitlbee-service [#:bitlbee bitlbee] @
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 003d5a5010..d33ff4fc4a 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -316,20 +316,33 @@ (define %tor-accounts
          (home-directory "/var/empty")
          (shell #~(string-append #$shadow "/sbin/nologin")))))
 
-(define (tor-dmd-service tor)
+(define (tor-dmd-service config)
   "Return a <dmd-service> running TOR."
-  (let ((torrc (plain-file "torrc" "User tor\n")))
-    (list (dmd-service
-           (provision '(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)))))
+       (list (dmd-service
+              (provision '(tor))
 
-           ;; Tor needs at least one network interface to be up, hence the
-           ;; dependency on 'loopback'.
-           (requirement '(user-processes loopback))
+              ;; 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))
-           (documentation "Run the Tor anonymous network overlay.")))))
+              (start #~(make-forkexec-constructor
+                        (list (string-append #$tor "/bin/tor") "-f" #$torrc)))
+              (stop #~(make-kill-destructor))
+              (documentation "Run the Tor anonymous network overlay.")))))))
 
 (define tor-service-type
   (service-type (name 'tor)
@@ -339,12 +352,16 @@ (define tor-service-type
                        (service-extension account-service-type
                                           (const %tor-accounts))))))
 
-(define* (tor-service #:key (tor tor))
-  "Return a service to run the @uref{https://torproject.org,Tor} daemon.
+(define* (tor-service #:optional
+                      (config-file (plain-file "empty" ""))
+                      #:key (tor tor))
+  "Return a service to run the @uref{https://torproject.org, Tor} anonymous
+networking daemon.
 
-The daemon runs with the default settings (in particular the default exit
-policy) as the @code{tor} unprivileged user."
-  (service tor-service-type tor))
+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)))
 
 
 ;;;
-- 
cgit v1.2.3