move tor hidden service socket to /etc, temporarily violating the FHS

On Debian, apparmor prevents tor from reading from most locations. And,
it silently fails if it is prevented from reading the hidden service
socket. I filed #846275 about this; violating the FHS is the least bad of a
bad set of choices until that bug is fixed.

1 files changed, 43 insertions, 19 deletions

diff --git a/Utility/Tor.hs b/Utility/Tor.hs
index 0900fb87e..3b9ddb6a6 100644
--- a/Utility/Tor.hs
+++ b/Utility/Tor.hs
@@ -9,6 +9,8 @@ module Utility.Tor where
 
 import Common
 import Utility.ThreadScheduler
+import Utility.FileMode
+
 import System.PosixCompat.Types
 import Data.Char
 import Network.Socket
@@ -27,12 +29,7 @@ type UniqueIdent = String
 
 connectHiddenService :: OnionAddress -> OnionPort -> IO Socket
 connectHiddenService (OnionAddress address) port = do
-        soc <- socket AF_UNIX Stream defaultProtocol
-	connect soc (SockAddrUnix "/run/user/1000/1ecd1f64-3234-47ec-876c-47c4bd7f7407.sock")
-	return soc
-
-connectHiddenService' :: OnionAddress -> OnionPort -> IO Socket
-connectHiddenService' (OnionAddress address) port = do
+	hPutStrLn stderr $ show ("connect to", address, port)
 	(s, _) <- socksConnect torsockconf socksaddr
 	return s
   where
@@ -54,6 +51,7 @@ connectHiddenService' (OnionAddress address) port = do
 -- identifier, returns its information without making any changes.
 addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
 addHiddenService uid ident = do
+	prepHiddenServiceSocketDir uid ident
 	ls <- lines <$> readFile torrc
 	let portssocks = mapMaybe (parseportsock . separate isSpace) ls
 	case filter (\(_, s) -> s == sockfile) portssocks of
@@ -84,7 +82,7 @@ addHiddenService uid ident = do
 		return (p, drop 1 (dropWhile (/= ':') l))
 	parseportsock _ = Nothing
 	
-	sockfile = socketFile uid ident
+	sockfile = hiddenServiceSocketFile uid ident
 
 	-- An infinite random list of high ports.
 	highports g = 
@@ -96,26 +94,52 @@ addHiddenService uid ident = do
 	waithiddenservice n p = do
 		v <- tryIO $ readFile $ hiddenServiceHostnameFile uid ident
 		case v of
-			Right s | ".onion\n" `isSuffixOf` s -> 
+			Right s | ".onion\n" `isSuffixOf` s ->
 				return (OnionAddress (takeWhile (/= '\n') s), p)
 			_ -> do
 				threadDelaySeconds (Seconds 1)
 				waithiddenservice (n-1) p
 
+-- | A hidden service directory to use.
+--
+-- 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
+
+hiddenServiceHostnameFile :: UserID -> UniqueIdent -> FilePath
+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.
+--
+-- 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 ++ "_" ++ show ident </> "s"
+
+-- | Sets up the directory for the socketFile, with appropriate
+-- permissions. Must run as root.
+prepHiddenServiceSocketDir :: UserID -> UniqueIdent -> IO ()
+prepHiddenServiceSocketDir uid ident = do
+	createDirectoryIfMissing True d
+	setOwnerAndGroup d uid (-1)
+	modifyFileMode d $
+		addModes [ownerReadMode, ownerExecuteMode, ownerWriteMode]
+  where
+	d = takeDirectory $ hiddenServiceSocketFile uid ident
+
 torrc :: FilePath
 torrc = "/etc/tor/torrc"
 
 libDir :: FilePath
 libDir = "/var/lib/tor"
 
-runDir :: UserID -> FilePath
-runDir uid = "/var/run/user" </> show uid
-
-socketFile :: UserID -> UniqueIdent -> FilePath
-socketFile uid ident = runDir uid </> ident ++ ".sock"
-
-hiddenServiceDir :: UserID -> UniqueIdent -> FilePath
-hiddenServiceDir uid ident = libDir </> "hidden_service_" ++ show uid ++ "_" ++ ident
-
-hiddenServiceHostnameFile :: UserID -> UniqueIdent -> FilePath
-hiddenServiceHostnameFile uid ident = hiddenServiceDir uid ident </> "hostname"
+etcDir :: FilePath
+etcDir = "/etc/tor"