01/02: services: 'tor-service' takes a 'config-file' parameter.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 375c610844c7776470edb88eafb18c48c6c90187
Author: Ludovic Courtès <address@hidden>
Date:   Sat Oct 31 11:17:08 2015 +0100

    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 84f194b..483d6e2 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
 
address@hidden {Scheme Procedure} tor-service [#:tor tor]
-Return a service to run the @uref{https://torproject.org,Tor} daemon.
address@hidden {Scheme Procedure} tor-service address@hidden [#: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
address@hidden, 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 003d5a5..d33ff4f 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -316,20 +316,33 @@ keep the system clock synchronized with that of 
@var{servers}."
          (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 @@ keep the system clock synchronized with that of 
@var{servers}."
                        (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
address@hidden, 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)))
 
 
 ;;;