diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -36,6 +36,37 @@ HaLVM-based installations. Windows support may work ... we just haven't tested it. +### Understanding Network Stacks + +The haskell-tor library is built such that it can use one of two built-in +network stacks and/or a third-party network stack that you provide. How you get +each of these is governed by two flags that correspond to the two network +stacks: + + * `network` ensures that haskell-tor includes defaults for the standard, + sockets-based network stack as described in the Haskell `network` library. + + * `hans` ensures that haskell-tor includes defaults for the Haskell + Network stack, which is a clean-slate networks stack that runs off raw + Ethernet frames. + +The defaults are a little complicated. To help try to sort things out, here is a +table that describes all the combinations of flags, and what the default is for +each platform: + +| Default | Platform | `network` | `hans` | Meaning | +|---------|----------|-----------|--------|-----------------------------------------| +| | Normal | True | True | Support for both `hans` and `network` | +| * | Normal | True | False | Support only `network` | +| | Normal | False | True | Support only `hans` | +| | Normal | False | False | No network stack support (BYONS) | +| | HaLVM | True | True | Support only `hans` (`network` ignored) | +| | HaLVM | True | False | No network stack support (see prev.) | +| * | HaLVM | False | True | Support only `hans` | +| | HaLVM | False | False | No network stack support (BYONS) | + +### Standard Cabal Constraints + If you're building with the HaLVM, please add the constraints `--constraint "tls +hans"`, `--constraint "tls -network"`, and `-f-network` to your build flags, and if you're using the `integer-simple` library (for example, to avoid GPL diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,39 +1,43 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -import Data.ByteString.Char8(ByteString,pack) -import qualified Data.ByteString.Lazy as L -import Tor -import Tor.Flags -import Tor.NetworkStack +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 Hans.Device.Xen -import Hans.DhcpClient -import Hans.NetworkStack hiding (listen, accept) -import Hypervisor.Console -import Hypervisor.XenStore -import Tor.NetworkStack.Hans -import XenDevice.NIC -#else -import Hans.Device.Tap -import Hans.DhcpClient -import Hans.NetworkStack hiding (listen, accept) -import System.IO -import Tor.NetworkStack.Hans -import Tor.NetworkStack.System +import Hypervisor.Console +import Hypervisor.XenStore +import XenDevice.NIC #endif -import qualified Data.ByteString as S -import Tor.Link -import Tor.Circuit -import Tor.State.Credentials -import Control.Concurrent -import Crypto.Random -import Tor.RouterDesc -import Tor.DataFormat.Helpers -import Tor.State.Directories -import Tor.State.Routers +#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 @@ -104,6 +108,7 @@ initializeSystem :: [Flag] -> IO (SomeNetworkStack, String -> IO ()) #ifdef HaLVM_HOST_OS +# ifdef VERSION_hans initializeSystem _ = do con <- initXenConsole xs <- initXenStore @@ -121,27 +126,51 @@ 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 -> - do mfd <- openTapDevice tapName - case mfd of - Nothing -> - fail ("Couldn't open tap device " ++ tapName) - Just fd -> - do ns <- newNetworkStack - logger <- generateLogger flags - 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) + 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 diff --git a/exe/Tor/Flags.hs b/exe/Tor/Flags.hs new file mode 100644 --- /dev/null +++ b/exe/Tor/Flags.hs @@ -0,0 +1,87 @@ +module Tor.Flags( + Flag(..) + , runDefaultMain + -- + , getNickname + , getOnionPort + , getContactInfo + , getTapDevice + ) + where + +import Data.Version hiding (Version) +import Data.Word +import System.Console.GetOpt +import System.Environment +import System.Exit +import Paths_haskell_tor + +data Flag = Version + | Help + | OnionPort Word16 + | OutputLog FilePath + | Nickname String + | ContactInfo String + | UseTapDevice String + deriving (Eq) + +options :: [OptDescr Flag] +options = + [ Option ['v'] ["version"] (NoArg Version) + "show the version number" + , Option ['h','?'] ["help"] (NoArg Help) + "show this message" + , Option ['p'] ["onion-port"] (ReqArg (OnionPort . read) "PORT") + "Select what onion port to use. [default 9374]" + , Option ['o'] ["output-log"] (ReqArg OutputLog "FILE") + "Select where to write log info. [default stdout]" + , Option ['n'] ["node-nickname"] (ReqArg Nickname "STR") + "An (optional) nickname for this Tor node." + , Option ['c'] ["node-contact"] (ReqArg ContactInfo "STR") + "An (optional) contact for this Tor node." + , Option ['t'] ["use-tap"] (ReqArg UseTapDevice "STR") + "Use a direct connection to a tap device." + ] + +showHelpAndStop :: Bool -> IO () +showHelpAndStop okgood = + do putStrLn (usageInfo "Usage: haskell-tor [options]" options) + exitWith (if okgood then ExitSuccess else (ExitFailure 2)) + +showVersionAndStop :: IO () +showVersionAndStop = + do putStrLn ("Haskell Tor Version " ++ showVersion version) + exitWith ExitSuccess + +runDefaultMain :: ([Flag] -> IO ()) -> IO () +runDefaultMain runNode = + do args <- getArgs + case getOpt Permute options args of + (opts, [], []) + | Version `elem` opts -> showVersionAndStop + | Help `elem` opts -> showHelpAndStop True + | otherwise -> runNode opts + (_, _, _) -> showHelpAndStop False + +-- ----------------------------------------------------------------------------- + +getNickname :: [Flag] -> String +getNickname [] = "" +getNickname (Nickname x : _) = x +getNickname (_ : rest) = getNickname rest + +getOnionPort :: [Flag] -> Word16 +getOnionPort [] = 9002 -- http://xkcd.com/221/ +getOnionPort (OnionPort p : _) = p +getOnionPort (_ : rest) = getOnionPort rest + +getContactInfo :: [Flag] -> Maybe String +getContactInfo [] = Nothing +getContactInfo (ContactInfo ci : _) = Just ci +getContactInfo (_ : rest) = getContactInfo rest + +getTapDevice :: [Flag] -> Maybe String +getTapDevice [] = Nothing +getTapDevice (UseTapDevice t : _) = Just t +getTapDevice (_ : rest) = getTapDevice rest + diff --git a/haskell-tor.cabal b/haskell-tor.cabal --- a/haskell-tor.cabal +++ b/haskell-tor.cabal @@ -1,5 +1,5 @@ name: haskell-tor -version: 0.1.0.0 +version: 0.1.1 synopsis: A Haskell Tor Node description: An implementation of the Tor anonymity system in Haskell. The core functionality is exported both as an application @@ -16,6 +16,7 @@ build-type: Simple extra-source-files: README.md cabal-version: >=1.10 +tested-with: GHC == 7.10.2, GHC == 7.8.4 source-repository head type: git @@ -93,7 +94,7 @@ Tor.State.LinkManager, Tor.State.Routers - if flag(network) + if flag(network) && !os(HaLVM) build-depends: network >= 2.5 && < 2.7 exposed-modules: Tor.NetworkStack.System if flag(hans) @@ -102,6 +103,7 @@ executable haskell-tor main-is: Main.hs + other-modules: Tor.Flags default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: exe @@ -120,11 +122,13 @@ x509 >= 1.6 && < 1.8 if flag(hans) build-depends: hans >= 2.6 && < 2.8 - if flag(network) + if flag(network) && !os(HaLVM) build-depends: network >= 2.5 && < 2.7 if os(HaLVM) build-depends: HALVMCore >= 2.0 && < 2.4, XenDevice >= 2.0 && < 2.4 + if (!flag(hans) && !flag(network)) || (!flag(hans) && os(HaLVM)) + buildable: False test-suite test-tor type: exitcode-stdio-1.0 @@ -132,7 +136,7 @@ ghc-options: -Wall hs-source-dirs: test default-language: Haskell2010 - other-extensions: FlexibleInstances, TypeSynonymInstances + other-extensions: CPP, FlexibleInstances, TypeSynonymInstances ghc-options: -fno-warn-orphans build-depends: asn1-types >= 0.2 && < 0.4,