haskell-tor 0.1.0.0 → 0.1.1
raw patch · 4 files changed
+198/−47 lines, 4 files
Files
- README.md +31/−0
- exe/Main.hs +72/−43
- exe/Tor/Flags.hs +87/−0
- haskell-tor.cabal +8/−4
README.md view
@@ -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
exe/Main.hs view
@@ -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
+ exe/Tor/Flags.hs view
@@ -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+
haskell-tor.cabal view
@@ -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,