From 57d33f79238599014e2eeef569d61fc3021ee476 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Nov 2016 16:35:45 -0400 Subject: [PATCH] use socket for tor hidden service This avoids needing to bind to the right port before something else does. The socket is in /var/run/user/$uid/ which ought to be writable by only that uid. At least it is on linux systems using systemd. For Windows, may need to revisit this and use ports or something. The first version of tor to support sockets for hidden services was 0.2.6.3. That is not in Debian stable, but is available in backports. This commit was sponsored by andrea rota. --- Command/EnableTor.hs | 20 +++++++---- Utility/Tor.hs | 67 ++++++++++++++++++++--------------- doc/git-annex-enable-tor.mdwn | 6 ++-- 3 files changed, 55 insertions(+), 38 deletions(-) diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs index 8d9dd6f0aa..1a54c6c5d8 100644 --- a/Command/EnableTor.hs +++ b/Command/EnableTor.hs @@ -10,19 +10,25 @@ module Command.EnableTor where import Command import Utility.Tor +-- This runs as root, so avoid making any commits or initializing +-- git-annex, as that would create root-owned files. cmd :: Command cmd = noCommit $ dontCheck repoExists $ command "enable-tor" SectionPlumbing "" - paramNumber (withParams seek) + "userid uuid" (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) +start (suserid:uuid:[]) = case readish suserid of + Nothing -> error "Bad userid" + Just userid -> do + (onionaddr, onionport, onionsocket) <- liftIO $ + addHiddenService userid uuid + liftIO $ putStrLn $ + onionaddr ++ ":" ++ + show onionport ++ " " ++ + show onionsocket stop -start _ = error "Need 1 localport parameter" +start _ = error "Bad params" diff --git a/Utility/Tor.hs b/Utility/Tor.hs index b15a23dccc..a0a6090089 100644 --- a/Utility/Tor.hs +++ b/Utility/Tor.hs @@ -9,39 +9,39 @@ module Utility.Tor where import Common import Utility.ThreadScheduler +import System.PosixCompat.Types import Data.Char -type LocalPort = Int type OnionPort = Int type OnionAddress = String +type OnionSocket = FilePath --- | Adds a hidden service connecting to localhost on the specified local port. +-- | Adds a hidden service connecting to localhost, using some kind +-- of unique identifier. +-- -- 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 +-- onion address, port, and the unix socket file to use. +-- +-- If there is already a hidden service for the specified unique +-- identifier, returns its information without making any changes. +addHiddenService :: UserID -> String -> IO (OnionAddress, OnionPort, OnionSocket) +addHiddenService uid ident = do + ls <- lines <$> readFile torrc + let portssocks = mapMaybe (parseportsock . separate isSpace) ls + case filter (\(_, s) -> s == sockfile) portssocks of + ((p, _s):_) -> waithiddenservice 1 p + _ -> do + let newport = Prelude.head $ + filter (`notElem` map fst portssocks) [1024..] writeFile torrc $ unlines $ - map (\(k, v) -> k ++ " " ++ v) ls ++ + ls ++ [ "" - , "HiddenServiceDir " ++ dir + , "HiddenServiceDir " ++ hsdir , "HiddenServicePort " ++ show newport ++ - " 127.0.0.1:" ++ show localport + " unix:" ++ sockfile ] -- Reload tor, so it will see the new hidden -- service and generate the hostname file for it. @@ -51,21 +51,32 @@ addHiddenService localport = do ] unless reloaded $ error "failed to reload tor, perhaps the tor service is not running" - waithiddenservice 120 dir newport + waithiddenservice 120 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") + parseportsock ("HiddenServicePort", l) = do + p <- readish $ takeWhile (not . isSpace) l + return (p, drop 1 (dropWhile (/= ':') l)) + parseportsock _ = Nothing + + hsdir = libDir "hidden_service_" ++ show uid ++ "_" ++ ident + sockfile = runDir uid ident ++ ".sock" + + waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort, OnionSocket) + waithiddenservice 0 _ = error "tor failed to create hidden service, perhaps the tor service is not running" + waithiddenservice n p = do + v <- tryIO $ readFile (hsdir "hostname") case v of Right s | ".onion\n" `isSuffixOf` s -> - return (takeWhile (/= '\n') s, newport) + return (takeWhile (/= '\n') s, p, sockfile) _ -> do threadDelaySeconds (Seconds 1) - waithiddenservice (n-1) dir newport + waithiddenservice (n-1) p torrc :: FilePath torrc = "/etc/tor/torrc" libDir :: FilePath libDir = "/var/lib/tor" + +runDir :: UserID -> FilePath +runDir uid = "/var/run/user" show uid diff --git a/doc/git-annex-enable-tor.mdwn b/doc/git-annex-enable-tor.mdwn index 961eef1722..b44cf817cf 100644 --- a/doc/git-annex-enable-tor.mdwn +++ b/doc/git-annex-enable-tor.mdwn @@ -4,13 +4,13 @@ git-annex enable-tor - enable tor hidden service # SYNOPSIS -git annex enable-tor localport +git annex enable-tor userid uuid # 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" +using the specified repository uuid and userid. +It outputs to stdout a line of the form "address.onion:onionport socketfile" This command has to be run by root, since it modifies `/etc/tor/torrc`.