Clean up the cabal file so that the 'hans' and 'network' flags all ma…

…ke sense, have sensible defaults, and produce sensible results. This also created some more complication in the executable, in order to deal with all the cases, and required some additional documentation in the README. I've also set up an initial Travis build that tests all the various combinations so that we don't accidentally drift away over time. (This is a squashed merge of the "hans-network-madness" branch.)
GaloisInc · Nov 26, 2015 · 8aea2aa · 8aea2aa
1 parent 75f8f04
commit 8aea2aa
Show file tree

Hide file tree

Showing 7 changed files with 184 additions and 52 deletions.
diff --git a/.travis.yml 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
@@ -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
@@ -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
@@ -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,19 +122,21 @@ 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
   main-is:            Test.hs
   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
@@ -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
@@ -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
@@ -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)