diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..74d9225 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,58 @@ +language: c + +sudo: false + +matrix: + include: + - env: CABALVER=1.18 GHCVER=7.8.4 NETWORK=-fnetwork HANS=+hans + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.18 GHCVER=7.8.4 NETWORK=-f-network HANS=+hans + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.18 GHCVER=7.8.4 NETWORK=-fnetwork HANS=-hans + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.18 GHCVER=7.8.4 NETWORK=-f-network HANS=-hans + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.2 NETWORK=-fnetwork HANS=+hans + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2],sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.2 NETWORK=-f-network HANS=+hans + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2],sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.2 NETWORK=-fnetwork HANS=-hans + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2],sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.2 NETWORK=-f-network HANS=-hans + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2],sources: [hvr-ghc]}} + - env: CABALVER=head GHCVER=head NETWORK=-fnetwork HANS=+hans + addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + - env: CABALVER=head GHCVER=head NETWORK=-f-network HANS=+hans + addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + - env: CABALVER=head GHCVER=head NETWORK=-fnetwork HANS=-hans + addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + - env: CABALVER=head GHCVER=head NETWORK=-f-network HANS=-hans + addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + + allow_failures: + - env: CABALVER=head GHCVER=head NETWORK=-fnetwork HANS=+hans + - env: CABALVER=head GHCVER=head NETWORK=-f-network HANS=+hans + - env: CABALVER=head GHCVER=head NETWORK=-fnetwork HANS=-hans + - env: CABALVER=head GHCVER=head NETWORK=-f-network HANS=-hans + +before_install: + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + +install: + - cabal sandbox init + - cabal update + - cabal install --only-dependencies --enable-tests $NETWORK -f$HANS --constraint="tls $HANS" + - cabal configure --enable-tests $NETWORK -f$HANS --constraint="tls $HANS" + +script: + - cabal build + - cabal check + - cabal test + - cabal sdist # tests that a source-distribution can be generated +# Check that the resulting source distribution can be built & installed. +# If there are no other `.tar.gz` files in `dist`, this can be even simpler: +# `cabal install --force-reinstalls dist/*-*.tar.gz` + - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && + (cd dist && cabal install --force-reinstalls $NETWORK -f$HANS --constraint="tls $HANS" "$SRC_TGZ") + + diff --git a/README.md b/README.md index 027b0dc..67b0d25 100644 --- a/README.md +++ b/README.md @@ -36,6 +36,37 @@ This library uses cabal as its build system, and should work for Mac, Unix, and 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 index 75ca7c5..d7b3939 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,38 +1,42 @@ {-# 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 -> @@ -104,6 +108,7 @@ readLoop sock = initializeSystem :: [Flag] -> IO (SomeNetworkStack, String -> IO ()) #ifdef HaLVM_HOST_OS +# ifdef VERSION_hans initializeSystem _ = do con <- initXenConsole xs <- initXenStore @@ -121,27 +126,51 @@ initializeSystem _ = 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/haskell-tor.cabal b/haskell-tor.cabal index 438a7e3..9557d33 100644 --- 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 @@ category: Network 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 @@ library 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 @@ library 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 @@ executable haskell-tor 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 @@ test-suite test-tor 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, diff --git a/test/Test/HybridEncrypt.hs b/test/Test/HybridEncrypt.hs index 7a08f59..baca178 100644 --- a/test/Test/HybridEncrypt.hs +++ b/test/Test/HybridEncrypt.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE CPP #-} module Test.HybridEncrypt(hybridEncryptionTest) where +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Crypto.PubKey.RSA import Control.Applicative import Control.Monad diff --git a/test/Test/Standard.hs b/test/Test/Standard.hs index 0939444..2e7a5db 100644 --- a/test/Test/Standard.hs +++ b/test/Test/Standard.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE CPP #-} module Test.Standard where +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Control.Monad import Crypto.Random import Data.Binary.Get diff --git a/test/Test/TorCell.hs b/test/Test/TorCell.hs index 1853059..4482c70 100644 --- a/test/Test/TorCell.hs +++ b/test/Test/TorCell.hs @@ -1,7 +1,11 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} module Test.TorCell(torCellTests) where +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Control.Monad import Crypto.Hash import Data.ASN1.OID @@ -77,10 +81,8 @@ showHex' :: (Show a, Integral a) => a -> String showHex' x = showHex x "" instance Arbitrary ExtendSpec where - arbitrary = oneof [ ExtendIP4 <$> (BS.pack <$> replicateM 4 arbitrary ) - <*> arbitrary - , ExtendIP6 <$> (BS.pack <$> replicateM 16 arbitrary) - <*> arbitrary + arbitrary = oneof [ ExtendIP4 <$> genIP4 <*> arbitrary + , ExtendIP6 <$> genIP6 <*> arbitrary , ExtendDigest <$> (BSC.pack <$> replicateM 20 (elements "abcdef0123456789")) @@ -136,7 +138,7 @@ instance Arbitrary RelayCell where , RelayConnected <$> arbitrary <*> legalTorAddress False <*> arbitrary , RelaySendMe <$> arbitrary - , RelayExtend <$> arbitrary <*> (IP4 <$> genIP4) + , RelayExtend <$> arbitrary <*> genIP4 <*> arbitrary <*> arbitraryBS 186 <*> arbitraryBS 20 , RelayExtended <$> arbitrary <*> (BS.pack <$> replicateM 148 arbitrary)