From 927097effdab473d2a344e6de75a85ec734df5dc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 12 Jul 2014 23:14:10 +0200
Subject: [PATCH] services: Add Tor service.

* gnu/services/networking.scm (tor-service): New procedure.
* doc/guix.texi (Networking Services): Document it.
* build-aux/hydra/demo-os.scm: Use it.  Add TOR and TORSOCKS to
  'packages'.
---
 build-aux/hydra/demo-os.scm |  6 +++++-
 doc/guix.texi               |  7 +++++++
 gnu/services/networking.scm | 36 +++++++++++++++++++++++++++++++++++-
 3 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm
index 43baa391e3..89b67aabe3 100644
--- a/build-aux/hydra/demo-os.scm
+++ b/build-aux/hydra/demo-os.scm
@@ -27,6 +27,7 @@
              (gnu packages xorg)
              (gnu packages avahi)
              (gnu packages linux)
+             (gnu packages tor)
 
              (gnu services networking)
              (gnu services avahi)
@@ -79,10 +80,13 @@ You can log in as 'guest' or 'root' with no password.
 
                   (avahi-service)
                   (dbus-service (list avahi))
+                  (tor-service)
 
                   %base-services))
  (pam-services
   ;; Explicitly allow for empty passwords.
   (base-pam-services #:allow-empty-passwords? #t))
 
- (packages (cons* strace xterm avahi %base-packages)))
+ (packages (cons* strace
+                  tor torsocks
+                  xterm avahi %base-packages)))
diff --git a/doc/guix.texi b/doc/guix.texi
index 9eb9d3f88a..7ea40e5f48 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3460,6 +3460,13 @@ Return a service that starts @var{interface} with address @var{ip}.  If
 gateway.
 @end deffn
 
+@deffn {Monadic Procedure} tor-service [#: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.
+@end deffn
+
 In addition, @code{(gnu system ssh)} provides the following service.
 
 @deffn {Monadic Procedure} lsh-service [#:host-key "/etc/lsh/host-key"] @
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 7abcd9ed15..502b0d85f1 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -18,11 +18,14 @@
 
 (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))
+  #:export (static-networking-service
+            tor-service))
 
 ;;; Commentary:
 ;;;
@@ -85,4 +88,35 @@ gateway."
                                 #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"))))
+      (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