{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
import Control.Concurrent
import Crypto.Random
import Data.ByteString.Char8(ByteString,pack)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Tor
import Tor.Circuit
import Tor.DataFormat.Helpers
import Tor.Flags
import Tor.Link
import Tor.NetworkStack
import Tor.RouterDesc
import Tor.State.Credentials
import Tor.State.Directories
import Tor.State.Routers
#ifdef HaLVM_HOST_OS
import Hypervisor.Console
import Hypervisor.XenStore
import XenDevice.NIC
#endif
#ifdef VERSION_hans
import Hans.DhcpClient
import Hans.NetworkStack hiding (listen, accept)
import Tor.NetworkStack.Hans
# ifdef HaLVM_HOST_OS
import Hans.Device.Xen
# else
import Hans.Device.Tap
# endif
#endif
#ifdef VERSION_network
import System.IO
import Tor.NetworkStack.System
#endif
--main :: IO ()
--main = runDefaultMain $ \ flags ->
-- do rngMV <- newMVar =<< drgNew
-- addrsMV <- newMVar []
-- (MkNS ns, logger) <- initializeSystem flags
---- dirdb <- newDirectoryDatabase ns logger
---- db <- newRouterDatabase ns dirdb logger
-- creds <- newCredentials logger
-- [_,printAscii] <- words `fmap` readFile "/Users/awick/.tor/fingerprint"
-- keyfile <- S.readFile "/Users/awick/.tor/keys/secret_onion_key_ntor"
-- let target = blankRouterDesc { routerIPv4Address = "10.0.1.27"
-- , routerORPort = 9001
-- , routerFingerprint = readHex printAscii
-- , routerNTorOnionKey = Just (S.drop 64 keyfile)
-- }
---- second <- modifyMVar rngMV (getRouter db [])
---- third <- modifyMVar rngMV (getRouter db [])
-- link <- initLink ns creds rngMV addrsMV logger target
-- circId <- modifyMVar rngMV (linkNewCircuitId link)
-- circ <- createCircuit rngMV logger link target circId
---- extendCircuit circ second
---- putStrLn "Done."
---- extendCircuit circ third
---- putStrLn "Done."
-- foo <- resolveName circ "galois.com"
-- putStrLn ("Foo: " ++ show foo)
main :: IO ()
main = runDefaultMain $ \ flags ->
do (MkNS ns, logger) <- initializeSystem flags
let options = defaultTorOptions{
torLog = logger
, torRelayOptions = Just defaultTorRelayOptions {
torOnionPort = getOnionPort flags
, torNickname = getNickname flags
, torContact = getContactInfo flags
}
}
tor <- startTor ns options
addrs <- torResolveName tor "www.whatismypublicip.com"
case addrs of
[] ->
putStrLn ("Could not resolve www.whatismypublicip.com!")
((addr, _ttl) : _) ->
do sock <- torConnect tor addr 80
torWrite sock (buildGet "/")
resp <- readLoop sock
torClose sock ReasonDone
buildGet :: String -> ByteString
buildGet str = result
where
result = pack (requestLine ++ userAgent ++ crlf)
requestLine = "GET " ++ str ++ " HTTP/1.0\r\n"
userAgent = "User-Agent: CERN-LineMode/2.15 libwww/2.17b3\r\n"
crlf = "\r\n"
readLoop :: TorSocket -> IO L.ByteString
readLoop sock =
do next <- torRead sock 256
if L.length next < 256
then return next
else do rest <- readLoop sock
return (next `L.append` rest)
-- -----------------------------------------------------------------------------
initializeSystem :: [Flag] ->
IO (SomeNetworkStack, String -> IO ())
#ifdef HaLVM_HOST_OS
# ifdef VERSION_hans
initializeSystem _ =
do con <- initXenConsole
xs <- initXenStore
ns <- newNetworkStack
macstr <- findNIC xs
nic <- openNIC xs macstr
let mac = read macstr
addDevice ns mac (xenSend nic) (xenReceiveLoop nic)
deviceUp ns mac
ipaddr <- dhcpDiscover ns mac
return (MkNS (hansNetworkStack ns), makeLogger (\ x -> writeConsole con (x ++ "\n")))
where
findNIC xs =
do nics <- listNICs xs
case nics of
[] -> threadDelay 1000000 >> findNIC xs
(x:_) -> return x
# else
# error "No HaLVM-compatible network stack defined!"
# endif
#else
# if defined(VERSION_hans) && defined(VERSION_network)
initializeSystem flags =
case getTapDevice flags of
Nothing ->
do logger <- generateLogger flags
return (MkNS systemNetworkStack, logger)
Just tapName -> startTapNetworkStack flags tapName
# elif defined(VERSION_hans)
initializeSystem flags =
case getTapDevice flags of
Nothing -> fail ("No tap device specified, in HaNS-only implementation.")
Just tapName -> startTapNetworkStack flags tapName
# elif defined(VERSION_network)
initializeSystem flags =
do logger <- generateLogger flags
return (MkNS systemNetworkStack, logger)
# else
# error "Compilation error: No network stack available!"
# endif
# if defined(VERSION_hans)
startTapNetworkStack :: [Flag] -> String ->
IO (SomeNetworkStack, String -> IO ())
startTapNetworkStack flags tapName =
do mfd <- openTapDevice tapName
case mfd of
Nothing ->
fail ("Couldn't open tap device " ++ tapName)
Just fd ->
do ns <- newNetworkStack
let logger = makeLogger putStrLn
let mac = read "52:54:00:12:34:56"
addDevice ns mac (tapSend fd) (tapReceiveLoop fd)
deviceUp ns mac
ipaddr <- dhcpDiscover ns mac
logger ("Node has IP Address " ++ show ipaddr)
return (MkNS (hansNetworkStack ns), logger)
# endif
#endif
#if defined(VERSION_network)
generateLogger :: [Flag] -> IO (String -> IO ())
generateLogger [] = return (makeLogger (hPutStrLn stdout))
generateLogger ((OutputLog fp):_) = do h <- openFile fp AppendMode
return (makeLogger (hPutStrLn h))
generateLogger (_:rest) = generateLogger rest
#endif