module Network.Anonymous.Tor.Protocol ( detectPort
, socksPort
, connect
, connect'
, protocolInfo
, authenticate
, mapOnion ) where
import Control.Concurrent.MVar
import Control.Monad (unless, void, when)
import Control.Monad.Catch (handleAll)
import Control.Monad.IO.Class
import qualified Data.Attoparsec.ByteString as Atto
import qualified Data.Base32String.Default as B32
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.HexString as HS
import Data.Maybe (catMaybes, fromJust)
import qualified Data.Text.Encoding as TE
import qualified Network.Attoparsec as NA
import qualified Network.Simple.TCP as NST
import qualified Network.Socket as Network hiding
(recv,
send)
import qualified Network.Socket.ByteString as Network
import qualified Network.Socks5 as Socks
import qualified Network.Anonymous.Tor.Error as E
import qualified Network.Anonymous.Tor.Protocol.Parser as Parser
import qualified Network.Anonymous.Tor.Protocol.Parser.Ast as Ast
import qualified Network.Anonymous.Tor.Protocol.Types as T
sendCommand :: MonadIO m
=> Network.Socket
-> BS.ByteString
-> m [Ast.Line]
sendCommand sock = sendCommand' sock 250 E.protocolErrorType
sendCommand' :: MonadIO m
=> Network.Socket
-> Integer
-> E.TorErrorType
-> BS.ByteString
-> m [Ast.Line]
sendCommand' sock status errorType msg = do
_ <- liftIO $ Network.sendAll sock msg
res <- liftIO $ NA.parseOne sock (Atto.parse Parser.reply)
when (Ast.statusCode res /= status)
(E.torError (E.mkTorError errorType))
return res
detectPort :: MonadIO m
=> [Integer]
-> m [Integer]
detectPort possible = do
ports <- liftIO $ mapM hasTor possible
return (catMaybes ports)
where
hasTor :: Integer -> IO (Maybe Integer)
hasTor port = liftIO $ do
result <- newEmptyMVar
handleAll
(\_ -> putMVar result Nothing)
(NST.connect "127.0.0.1" (show port) (\(sock, _) -> do
_ <- protocolInfo sock
putMVar result (Just port)))
takeMVar result
socksPort :: MonadIO m
=> Network.Socket
-> m Integer
socksPort s = do
reply <- sendCommand s (BS8.pack "GETCONF SOCKSPORT\n")
return . fst . fromJust . BS8.readInteger . fromJust . Ast.tokenValue . head . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "SocksPort") reply
connect :: MonadIO m
=> Integer
-> Socks.SocksAddress
-> (Network.Socket -> IO a)
-> m a
connect sport remote callback = liftIO $ do
(sock, _) <- Socks.socksConnect conf remote
callback sock
where
conf = Socks.defaultSocksConf "127.0.0.1" (fromInteger sport)
connect' :: MonadIO m
=> Network.Socket
-> Socks.SocksAddress
-> (Network.Socket -> IO a)
-> m a
connect' sock remote callback = do
sport <- socksPort sock
connect sport remote callback
protocolInfo :: MonadIO m
=> Network.Socket
-> m T.ProtocolInfo
protocolInfo s = do
res <- sendCommand s (BS.concat ["PROTOCOLINFO", "\n"])
return (T.ProtocolInfo (protocolVersion res) (torVersion res) (methods res) (cookieFile res))
where
protocolVersion :: [Ast.Line] -> Integer
protocolVersion reply =
fst . fromJust . BS8.readInteger . Ast.tokenKey . last . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "PROTOCOLINFO") reply
torVersion :: [Ast.Line] -> [Integer]
torVersion reply =
map (fst . fromJust . BS8.readInteger) . BS8.split '.' . fromJust . Ast.value "Tor" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "VERSION") reply
methods :: [Ast.Line] -> [T.AuthMethod]
methods reply =
map (read . BS8.unpack) . BS8.split ',' . fromJust . Ast.value "METHODS" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "AUTH") reply
cookieFile :: [Ast.Line] -> Maybe FilePath
cookieFile reply =
fmap BS8.unpack . Ast.value "COOKIEFILE" . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "AUTH") reply
authenticate :: MonadIO m
=> Network.Socket
-> m ()
authenticate s = do
info <- protocolInfo s
unless (T.Cookie `elem` T.authMethods info)
(E.torError (E.mkTorError E.permissionDeniedErrorType))
cookieData <- liftIO $ readCookie (T.cookieFile info)
liftIO . void $ sendCommand' s 250 E.permissionDeniedErrorType (BS8.concat ["AUTHENTICATE ", TE.encodeUtf8 $ HS.toText cookieData, "\n"])
where
readCookie :: Maybe FilePath -> IO HS.HexString
readCookie Nothing = E.torError (E.mkTorError E.protocolErrorType)
readCookie (Just file) = return . HS.fromBytes =<< BS.readFile file
mapOnion :: MonadIO m
=> Network.Socket
-> Integer
-> Integer
-> m B32.Base32String
mapOnion s rport lport = do
reply <- sendCommand s (BS8.concat ["ADD_ONION NEW:BEST Port=", BS8.pack (show rport), ",127.0.0.1:", BS8.pack(show lport), "\n"])
return . B32.b32String' . fromJust . Ast.tokenValue . head . Ast.lineMessage . fromJust $ Ast.line (BS8.pack "ServiceID") reply