relocate tor socket out of /etc

weasel explained that apparmor limits on what files tor can read do not
apply to sockets (because they're not files). And apparently the
problems I was seeing with hidden services not being accessible had to
do with onion address propigation and not the location of the socket
file.

remotedaemon looks up the HiddenServicePort in torrc, so if it was
previously configured with the socket in /etc, that will still work.

This commit was sponsored by Denis Dzyubenko on Patreon.

4 files changed, 71 insertions, 48 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 9d9faf1e4..65a3da82b 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -19,6 +19,8 @@ git-annex (6.20161211) UNRELEASED; urgency=medium
     supporting locales such as, en_GB.UTF-8.
   * rekey --force: Incorrectly marked the new key's content as being
     present in the local repo even when it was not.
+  * enable-tor: Put tor sockets in /var/lib/tor-annex/, rather
+    than in /etc/tor/hidden_service/.
   * Fix build with directory-1.3.
   * Debian: Suggest tor and magic-wormhole.
   * Debian: Build webapp on armel.
diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs
index d24ecb2dc..c6d477b4e 100644
--- a/Command/EnableTor.hs
+++ b/Command/EnableTor.hs
@@ -30,6 +30,6 @@ start ps = case readish =<< headMaybe ps of
 		when (uuid == NoUUID) $
 			giveup "This can only be run in a git-annex repository."
 		(onionaddr, onionport) <- liftIO $
-			addHiddenService userid (fromUUID uuid)
+			addHiddenService "tor-annex" userid (fromUUID uuid)
 		storeP2PAddress $ TorAnnex onionaddr onionport
 		stop
diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs
index 61e1189a5..3f70fb1fb 100644
--- a/RemoteDaemon/Transport/Tor.hs
+++ b/RemoteDaemon/Transport/Tor.hs
@@ -39,36 +39,41 @@ import qualified Network.Socket as S
 server :: TransportHandle -> IO ()
 server th@(TransportHandle (LocalRepo r) _) = do
 	u <- liftAnnex th getUUID
-
-	q <- newTBMQueueIO maxConnections
-	replicateM_ maxConnections $
-		forkIO $ forever $ serveClient th u r q
-
 	uid <- getRealUserID
 	let ident = fromUUID u
-	let sock = hiddenServiceSocketFile uid ident
-	nukeFile sock
-	soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
-	S.bind soc (S.SockAddrUnix sock)
-	-- Allow everyone to read and write to the socket; tor is probably
-	-- running as a different user. Connections have to authenticate
-	-- to do anything, so it's fine that other local users can connect.
-	modifyFileMode sock $ addModes
-		[groupReadMode, groupWriteMode, otherReadMode, otherWriteMode]
-	S.listen soc 2
-	debugM "remotedaemon" "Tor hidden service running"
-	forever $ do
-		(conn, _) <- S.accept soc
-		h <- setupHandle conn
-		ok <- atomically $ ifM (isFullTBMQueue q)
-			( return False
-			, do
-				writeTBMQueue q h
-				return True
-			)
-		unless ok $ do
-			hClose h
-			warningIO "dropped Tor connection, too busy"
+	go u =<< getHiddenServiceSocketFile uid ident
+  where
+	go u (Just sock) = do
+		q <- newTBMQueueIO maxConnections
+		replicateM_ maxConnections $
+			forkIO $ forever $ serveClient th u r q
+
+		nukeFile sock
+		soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
+		S.bind soc (S.SockAddrUnix sock)
+		-- Allow everyone to read and write to the socket; tor
+		-- is probably running as a different user.
+		-- Connections have to authenticate to do anything,
+		-- so it's fine that other local users can connect to the
+		-- socket.
+		modifyFileMode sock $ addModes
+			[groupReadMode, groupWriteMode, otherReadMode, otherWriteMode]
+
+		S.listen soc 2
+		debugM "remotedaemon" "Tor hidden service running"
+		forever $ do
+			(conn, _) <- S.accept soc
+			h <- setupHandle conn
+			ok <- atomically $ ifM (isFullTBMQueue q)
+				( return False
+				, do
+					writeTBMQueue q h
+					return True
+				)
+			unless ok $ do
+				hClose h
+				warningIO "dropped Tor connection, too busy"
+	go _ Nothing = debugM "remotedaemon" "Tor hidden service not enabled"
 
 -- How many clients to serve at a time, maximum. This is to avoid DOS attacks.
 maxConnections :: Int
diff --git a/Utility/Tor.hs b/Utility/Tor.hs
index 71628084c..64a6ae11d 100644
--- a/Utility/Tor.hs
+++ b/Utility/Tor.hs
@@ -25,8 +25,12 @@ newtype OnionAddress = OnionAddress String
 
 type OnionSocket = FilePath
 
+-- | A unique identifier for a hidden service.
 type UniqueIdent = String
 
+-- | Name of application that is providing a hidden service.
+type AppName = String
+
 connectHiddenService :: OnionAddress -> OnionPort -> IO Socket
 connectHiddenService (OnionAddress address) port = do
 	(s, _) <- socksConnect torsockconf socksaddr
@@ -48,9 +52,9 @@ connectHiddenService (OnionAddress address) port = do
 -- 
 -- If there is already a hidden service for the specified unique
 -- identifier, returns its information without making any changes.
-addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
-addHiddenService uid ident = do
-	prepHiddenServiceSocketDir uid ident
+addHiddenService :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
+addHiddenService appname uid ident = do
+	prepHiddenServiceSocketDir appname uid ident
 	ls <- lines <$> readFile torrc
 	let portssocks = mapMaybe (parseportsock . separate isSpace) ls
 	case filter (\(_, s) -> s == sockfile) portssocks of
@@ -81,7 +85,7 @@ addHiddenService uid ident = do
 		return (p, drop 1 (dropWhile (/= ':') l))
 	parseportsock _ = Nothing
 	
-	sockfile = hiddenServiceSocketFile uid ident
+	sockfile = hiddenServiceSocketFile appname uid ident
 
 	-- An infinite random list of high ports.
 	mkhighports g = 
@@ -104,7 +108,7 @@ addHiddenService uid ident = do
 -- The "hs" is used in the name to prevent too long a path name,
 -- which could present problems for socketFile.
 hiddenServiceDir :: UserID -> UniqueIdent -> FilePath
-hiddenServiceDir uid ident = libDir </> "hs_" ++ show uid ++ "_" ++ ident
+hiddenServiceDir uid ident = torLibDir </> "hs_" ++ show uid ++ "_" ++ ident
 
 hiddenServiceHostnameFile :: UserID -> UniqueIdent -> FilePath
 hiddenServiceHostnameFile uid ident = hiddenServiceDir uid ident </> "hostname"
@@ -112,33 +116,45 @@ hiddenServiceHostnameFile uid ident = hiddenServiceDir uid ident </> "hostname"
 -- | Location of the socket for a hidden service.
 --
 -- This has to be a location that tor can read from, and that the user
--- can write to. Tor is often prevented by apparmor from reading
--- from many locations. Putting it in /etc is a FHS violation, but it's the
--- simplest and most robust choice until http://bugs.debian.org/846275 is
--- dealt with.
+-- can write to. Since torLibDir is locked down, it can't go in there.
 --
 -- Note that some unix systems limit socket paths to 92 bytes long.
 -- That should not be a problem if the UniqueIdent is around the length of
--- a UUID.
-hiddenServiceSocketFile :: UserID -> UniqueIdent -> FilePath
-hiddenServiceSocketFile uid ident = etcDir </> "hidden_services" </> show uid ++ "_" ++ ident </> "s"
+-- a UUID, and the AppName is short.
+hiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> FilePath
+hiddenServiceSocketFile appname uid ident = varLibDir </> appname </> show uid ++ "_" ++ ident </> "s"
+
+-- | Parse torrc, to get the socket file used for a hidden service with
+-- the specified UniqueIdent.
+getHiddenServiceSocketFile :: UserID -> UniqueIdent -> IO (Maybe FilePath)
+getHiddenServiceSocketFile uid ident = 
+	parse . map words . lines <$> catchDefaultIO "" (readFile torrc)
+  where
+	parse [] = Nothing
+	parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)
+		| "unix:" `isPrefixOf` hsaddr && hsdir == hsdir_want =
+			Just (drop (length "unix:") hsaddr)
+		| otherwise = parse rest
+	parse (_:rest) = parse rest
+
+	hsdir_want = hiddenServiceDir uid ident
 
 -- | Sets up the directory for the socketFile, with appropriate
 -- permissions. Must run as root.
-prepHiddenServiceSocketDir :: UserID -> UniqueIdent -> IO ()
-prepHiddenServiceSocketDir uid ident = do
+prepHiddenServiceSocketDir :: AppName -> UserID -> UniqueIdent -> IO ()
+prepHiddenServiceSocketDir appname uid ident = do
 	createDirectoryIfMissing True d
 	setOwnerAndGroup d uid (-1)
 	modifyFileMode d $
 		addModes [ownerReadMode, ownerExecuteMode, ownerWriteMode]
   where
-	d = takeDirectory $ hiddenServiceSocketFile uid ident
+	d = takeDirectory $ hiddenServiceSocketFile appname uid ident
 
 torrc :: FilePath
 torrc = "/etc/tor/torrc"
 
-libDir :: FilePath
-libDir = "/var/lib/tor"
+torLibDir :: FilePath
+torLibDir = "/var/lib/tor"
 
-etcDir :: FilePath
-etcDir = "/etc/tor"
+varLibDir :: FilePath
+varLibDir = "/var/lib"