{-# LANGUAGE ExistentialQuantification #-}
-- |The high-level interface to the Tor implementation. Basic usage, for
-- using Tor as a mechanism for connecting to Internet services anonymously:
--
-- @
-- main :: IO ()
-- main =
-- do tor <- startTor systemNetworkStack defaultTorOptions
-- addrs <- torResolveName tor "hostname.com"
-- case addrs of
-- [] -> ...
-- ((x, _):_) ->
-- do sock <- torConnect tor x 80
-- torWrite sock ...
-- resp <- torRead sock 1024
-- ...
-- @
--
-- HaLVM users should initialize a HaNS network stack, and use that instead of
-- systemNetworkStack, above.
module Tor(
-- * Setup and initialization
Tor
, startTor
-- * Options
, module Tor.Options
-- * Functions for Tor entrance nodes
, TorAddress(..)
, RelayEndReason(..)
, torResolveName
, TorSocket
, torConnect
, torClose
, torWrite
, torRead
)
where
import Control.Exception
import Control.Monad
import Data.Maybe
import Data.Word
import Network.TLS
import System.Timeout
import Tor.Circuit
import Tor.DataFormat.RelayCell
import Tor.DataFormat.TorAddress
import Tor.NetworkStack hiding (connect)
import Tor.Options
import Tor.State.CircuitManager
import Tor.State.Credentials
import Tor.State.Directories
import Tor.State.LinkManager
import Tor.State.Routers
type HostName = String
-- |A handle to the current Tor system state.
data Tor = forall ls s . HasBackend s => Tor (CircuitManager ls s)
-- |Start up the underlying Tor system, given a network stack to operate in and
-- some setup options.
startTor :: HasBackend s => TorNetworkStack ls s -> TorOptions -> IO Tor
startTor ns o =
do creds <- newCredentials o
dirDB <- newDirectoryDatabase ns (torLog o)
routerDB <- newRouterDatabase ns dirDB (torLog o)
lm <- newLinkManager o ns routerDB creds
cm <- newCircuitManager o ns creds routerDB lm
when (not isRelay && isExit) $
do torLog o "WARNING: Requested exit without relay support: weird."
torLog o "WARNING: Please check that this is really what you want."
let res = Tor cm
when (isRelay || isExit) $
handle (checkPublicFail o) $
do _ <- torResolveName res "google.com" -- not important
addrs <- getAddresses creds
torLog o ("I believe I have the following addrs: " ++ show addrs)
fin <- timeout (15 * 1000000) $ tryConnect res orPort addrs
unless (isJust fin) $ fail "Timeout connecting to myself."
torLog o ("At least one of which is routable. Starting relay.")
(_, PrivKeyRSA pkey) <- getSigningKey creds
desc <- getRouterDesc creds
sendRouterDescription ns (torLog o) dirDB desc pkey
return (Tor cm)
where
isRelay = isJust (torRelayOptions o)
isExit = isJust (torExitOptions o)
orPort = maybe 9374 torOnionPort (torRelayOptions o)
tryConnect :: Tor -> Word16 -> [TorAddress] -> IO ()
tryConnect _ _ [] = fail "Could not connect to any addresses."
tryConnect tor p (x:rest) =
handle failRecurse $
do con <- torConnect tor x p
torClose con ReasonDone
where
failRecurse :: SomeException -> IO ()
failRecurse _ = tryConnect tor p rest
checkPublicFail :: TorOptions -> SomeException -> IO ()
checkPublicFail o _ =
torLog o ("Failed to create connection to myself. No relay/exit support.")
-- -----------------------------------------------------------------------------
-- |Resolve the given host name, anonymously. This routine will create a new
-- circuit unless torMaxCircuits has been reached, at which point it will re-use
-- an existing circuit.
torResolveName :: Tor -> HostName -> IO [(TorAddress, Word32)]
torResolveName (Tor cm) name =
do circ <- openCircuit cm [ExitNode]
resolveName circ name
-- |Connect to the given address via Tor. The TorAddress should be one of the
-- IP4 or IP6 variants, rather than a hostname or an error. The result will be
-- the built circuit. This will throw exceptions if failures occur during the
-- building process.
torConnect :: Tor -> TorAddress -> Word16 -> IO TorSocket
torConnect (Tor cm) addr port =
do circ <- openCircuit cm [ExitNodeAllowing addr port]
connectToHost circ addr port