1 files changed, 71 insertions, 0 deletions
diff --git a/Utility/Tor.hs b/Utility/Tor.hs
new file mode 100644
index 000000000..b15a23dcc
--- /dev/null
+++ b/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"