git-annex enable-tor command

Tor unfortunately does not come out of the box configured to let hidden
services register themselves on the fly via the ControlPort.

And, changing the config to enable the ControlPort and a particular type
of auth for it may break something already using the ControlPort, or
lessen the security of the system.

So, this leaves only one option to us: Add a hidden service to the
torrc. git-annex enable-tor does so, and picks an unused high port for
tor to listen on for connections to the hidden service.

It's up to the caller to somehow pick a local port to listen on
that won't be used by something else. That may be difficult to do..

This commit was sponsored by Jochen Bartl on Patreon.

CmdLine/GitAnnex.hs

@@ -52,6 +52,7 @@ import qualified Command.Init
 import qualified Command.Describe
 import qualified Command.InitRemote
 import qualified Command.EnableRemote
+import qualified Command.EnableTor
 import qualified Command.Expire
 import qualified Command.Repair
 import qualified Command.Unused
@@ -142,6 +143,7 @@ cmds testoptparser testrunner =
 	, Command.Describe.cmd
 	, Command.InitRemote.cmd
 	, Command.EnableRemote.cmd
+	, Command.EnableTor.cmd
 	, Command.Reinject.cmd
 	, Command.Unannex.cmd
 	, Command.Uninit.cmd

Command/EnableTor.hs

@@ -0,0 +1,28 @@
+{- git-annex command
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.EnableTor where
+
+import Command
+import Utility.Tor
+
+cmd :: Command
+cmd = noCommit $ dontCheck repoExists $
+	command "enable-tor" SectionPlumbing ""
+		paramNumber (withParams seek)
+
+seek :: CmdParams -> CommandSeek
+seek = withWords start
+
+start :: CmdParams -> CommandStart
+start (localport:[]) = case readish localport of
+	Nothing -> error "Bad localport"
+	Just lp -> do
+		(onionaddr, onionport) <- liftIO $ addHiddenService lp
+		liftIO $ putStrLn (onionaddr ++ ":" ++ show onionport)
+		stop
+start _ = error "Need 1 localport parameter"

Utility/Tor.hs

@@ -0,0 +1,71 @@
+{- tor interface
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Tor where
+
+import Common
+import Utility.ThreadScheduler
+import Data.Char
+
+type LocalPort = Int
+type OnionPort = Int
+type OnionAddress = String
+
+-- | Adds a hidden service connecting to localhost on the specified local port.
+-- This will only work if run as root, and tor has to already be running.
+--
+-- Picks a port number for the hidden service that is not used by any
+-- other hidden service (and is >= 1024). Returns the hidden service's
+-- onion address and port.
+
+-- If there is already a hidden service for the specified local port,
+-- returns its information without making any changes.
+addHiddenService :: LocalPort -> IO (OnionAddress, OnionPort)
+addHiddenService localport = do
+	ls <- map (separate isSpace) . lines <$> readFile torrc
+	let usedports = mapMaybe readish $
+		map (drop 1 . dropWhile (/= ':')) $
+		map snd $
+		filter (\(k, _) -> k == "HiddenServicePort") ls
+	let newport = Prelude.head $ filter (`notElem` usedports) [1024..]
+	let dir = libDir </> "hidden_service" ++ show localport
+	if localport `elem` usedports
+		then waithiddenservice 1 dir newport
+		else do
+			writeFile torrc $ unlines $
+				map (\(k, v) -> k ++ " " ++ v) ls ++
+				[ ""
+				, "HiddenServiceDir " ++ dir
+				, "HiddenServicePort " ++ show newport ++ 
+					" 127.0.0.1:" ++ show localport
+				]
+			-- Reload tor, so it will see the new hidden
+			-- service and generate the hostname file for it.
+			reloaded <- anyM (uncurry boolSystem)
+				[ ("systemctl", [Param "reload", Param "tor"])
+				, ("sefvice", [Param "tor", Param "reload"])
+				]
+			unless reloaded $
+				error "failed to reload tor, perhaps the tor service is not running"
+			waithiddenservice 120 dir newport
+  where
+	waithiddenservice :: Int -> FilePath -> OnionPort -> IO (OnionAddress, OnionPort)
+	waithiddenservice 0 _ _ = error "tor failed to create hidden service, perhaps the tor service is not running"
+	waithiddenservice n dir newport = do
+		v <- tryIO $ readFile (dir </> "hostname")
+		case v of
+			Right s | ".onion\n" `isSuffixOf` s -> 
+				return (takeWhile (/= '\n') s, newport)
+			_ -> do
+				threadDelaySeconds (Seconds 1)
+				waithiddenservice (n-1) dir newport
+
+torrc :: FilePath
+torrc = "/etc/tor/torrc"
+
+libDir :: FilePath
+libDir = "/var/lib/tor"

doc/git-annex-enable-tor.mdwn

@@ -0,0 +1,25 @@
+# NAME
+
+git-annex enable-tor - enable tor hidden service
+
+# SYNOPSIS
+
+git annex enable-tor localport
+
+# DESCRIPTION
+
+This plumbing-level command enables a tor hidden service for git-annex,
+using the specified local port number. It outputs to stdout a line
+of the form "address.onion:onionport"
+
+This command has to be run by root, since it modifies `/etc/tor/torrc`.
+
+# SEE ALSO
+
+[[git-annex]](1)
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.

git-annex.cabal

@@ -1063,6 +1063,7 @@ Executable git-annex
     Utility.ThreadLock
     Utility.ThreadScheduler
     Utility.Tmp
+    Utility.Tor
     Utility.Touch
     Utility.Url
     Utility.UserInfo