network-builder (empty) → 0.1.0
raw patch · 10 files changed
+698/−0 lines, 10 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, cabal-test-bin, hspec, hspec-server, network-builder, optparse-applicative, process, shelly, text, yaml
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- Network/Builder.hs +7/−0
- Network/Builder/Namespace.hs +185/−0
- Network/Builder/Tunnel.hs +82/−0
- README.md +81/−0
- Setup.hs +2/−0
- network-builder.cabal +73/−0
- network-builder.hs +102/−0
- tests/test.hs +133/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0++* First Release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Junji Hashimoto++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Junji Hashimoto nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Builder.hs view
@@ -0,0 +1,7 @@+module Network.Builder (+ module Network.Builder.Namespace+, module Network.Builder.Tunnel+) where++import Network.Builder.Namespace+import Network.Builder.Tunnel
+ Network/Builder/Namespace.hs view
@@ -0,0 +1,185 @@+{-#LANGUAGE OverloadedStrings#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE ExtendedDefaultRules #-}+{-#LANGUAGE RecordWildCards #-}+{-#LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Network.Builder.Namespace where++import Prelude hiding (FilePath)+import Shelly hiding (command)+import qualified Data.Text as T++import Data.Monoid+import Control.Monad+import Control.Exception+import Data.Char+import qualified Data.Aeson.TH as A++default (T.Text)++data Bridge = Bridge {+ bname :: T.Text+ , bip :: T.Text+ }+ deriving (Show,Eq)+$(A.deriveJSON A.defaultOptions{A.fieldLabelModifier = drop 1,A.constructorTagModifier = map toLower} ''Bridge)++data Veth = Veth {+ vname :: T.Text+ , vip :: T.Text+ }+ deriving (Show,Eq)+$(A.deriveJSON A.defaultOptions{A.fieldLabelModifier = drop 1, A.constructorTagModifier = map toLower} ''Veth)++data NetworkNameSpace =+ NetworkNameSpace {+ nname :: T.Text+ , nnss :: Maybe [(Bridge,[(Veth,NetworkNameSpace)])]+ }+ deriving (Show,Eq)+$(A.deriveJSON A.defaultOptions{A.fieldLabelModifier = drop 1, A.constructorTagModifier = map toLower} ''NetworkNameSpace)+++data HostServer =+ HostServer {+ hnss :: Maybe [(Bridge,[(Veth,NetworkNameSpace)])]+ }+ deriving (Show,Eq)+$(A.deriveJSON A.defaultOptions{A.fieldLabelModifier = drop 1, A.constructorTagModifier = map toLower} ''HostServer)++class VirtualServer a where+ name :: a -> T.Text + nss :: a -> [(Bridge,[(Veth,NetworkNameSpace)])]+ isHost :: a -> Bool+ runNs :: a -> T.Text -> [T.Text] -> Sh T.Text++instance VirtualServer HostServer where+ name _ = "localhost"+ nss host = maybe [] id $ hnss host+ isHost _ = True+ runNs (HostServer _) cmd' args = do+ run "sudo" $ [cmd'] ++ args++instance VirtualServer NetworkNameSpace where+ name = nname+ nss ns = maybe [] id $ nnss ns+ isHost _ = False+ runNs (NetworkNameSpace name' _) cmd' args = do+ run "sudo" $ ["ip", "netns", "exec", name', cmd'] ++ args+++delMask :: T.Text -> T.Text+delMask = T.takeWhile (/= '/') ++-- sampleNS :: HostServer+-- sampleNS =+-- HostServer{+-- hnss = [+-- (Bridge {+-- bname = "br1"+-- , bip = "192.168.10.1/24"+-- } ,+-- [+-- (Veth {+-- vname = "veth-2"+-- , vip = "192.168.10.2/24"+-- } ,+-- NetworkNameSpace {+-- nname = "server2"+-- , nnss = [+-- (Bridge {+-- bname = "br1"+-- , bip = "192.168.11.1/24"+-- } ,+-- [+-- (Veth {+-- vname = "veth-3"+-- , vip = "192.168.11.4/24"+-- } ,+-- NetworkNameSpace {+-- nname = "server4"+-- , nnss = []+-- })+-- ])+-- ]+-- }),+-- (Veth {+-- vname = "veth-3"+-- , vip = "192.168.10.3/24"+-- } ,+-- NetworkNameSpace {+-- nname = "server3"+-- , nnss = []+-- })+-- ])+-- ]+-- }++createNetworkNameSpaces :: HostServer -> Sh ()+createNetworkNameSpaces host = createNetworkNameSpaces' host host++createNetworkNameSpaces' :: VirtualServer a => HostServer -> a -> Sh ()+createNetworkNameSpaces' host ns = do+ forM_ (nss ns) $ \(br,vs) -> do+ -- create bridge+ _<- runNs ns "ip" ["link", "add", "name", bname br, "type", "bridge"]+ _<- runNs ns "ip" ["addr", "add" , bip br, "dev", bname br]+ _<- runNs ns "ip" ["link", "set", "dev", bname br, "up"]+ + -- setup ip masquerade+ _<- runNs ns "iptables" ["-t","nat", "-A", "POSTROUTING", "-s", bip br, "!", "-o", bname br, "-j", "MASQUERADE"]+ + forM_ vs $ \(veth,nss') -> do+ -- create namespace + _<- runNs host "ip" ["netns", "add", nname nss']+ + -- create veth pair+ _<- runNs host "ip" ["link", "add", vname veth <> "-0", "type", "veth", "peer", "name", vname veth <> "-1"]+ + -- assign veth pair for namespace+ when (isHost ns == False) $ do+ void $ runNs host "ip" ["link", "set", vname veth <> "-0", "netns", name ns]+ void $ runNs host "ip" ["link", "set", vname veth <> "-1", "netns", name nss']+ + -- up veth of upper side sserver+ _<- runNs ns "ip" ["link", "set", "dev", vname veth <> "-0", "up"]+ + -- connect veth to bridge+ _<- runNs ns "ip" ["link", "set", "dev", vname veth <> "-0", "master", bname br]+ + -- setup lo+ _<- runNs nss' "ip" ["addr", "add" , "127.0.0.1", "dev", "lo"]+ _<- runNs nss' "ip" ["link", "set" , "dev", "lo", "up"]+ + -- up veth of lower side server+ _<- runNs nss' "ip" ["addr", "add" , vip veth, "dev", vname veth <> "-1"]+ _<- runNs nss' "ip" ["link", "set" , "dev", vname veth <> "-1", "up"]++ -- setup gateway+ _<- runNs nss' "ip" ["route", "add", "default", "via",delMask (bip br), "dev", vname veth <> "-1"]++ -- create lower network+ _<- createNetworkNameSpaces' host nss'+ return ()+++deleteNetworkNameSpaces :: HostServer -> Sh ()+deleteNetworkNameSpaces host = deleteNetworkNameSpaces' host host++deleteNetworkNameSpaces' :: VirtualServer a => HostServer -> a -> Sh ()+deleteNetworkNameSpaces' host ns = do+ forM_ (nss ns) $ \(br,vs) -> do+ forM_ vs $ \(veth,nss') -> do+ _<- deleteNetworkNameSpaces' host nss'+ ignore $ runNs ns "ip" ["link", "set", "dev", vname veth <> "-0", "down"]+ ignore $ runNs ns "ip" ["link", "set", "dev", vname veth <> "-0", "nomaster"]+ ignore $ runNs host "ip" ["netns", "del", nname nss']+ return ()+ ignore $ runNs ns "iptables" ["-t","nat", "-D", "POSTROUTING", "-s", bip br, "!", "-o", bname br, "-j", "MASQUERADE"]+ ignore $ runNs ns "ip" ["link", "delete", bname br, "type", "bridge"]+ return ()+ where+ ignore act = (void $ act) `catch_sh` \(err :: SomeException) -> liftIO $ putStrLn $ show err
+ Network/Builder/Tunnel.hs view
@@ -0,0 +1,82 @@+{-#LANGUAGE OverloadedStrings#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE ExtendedDefaultRules #-}+{-#LANGUAGE RecordWildCards #-}+{-#LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Network.Builder.Tunnel where++import Prelude hiding (FilePath)+import Shelly hiding (command)+import qualified Data.Text as T++import Control.Monad+import Control.Exception+import Data.Char+import qualified Data.Aeson.TH as A+import Network.Builder.Namespace++default (T.Text)++data Tunnel =+ GreTunnel {+ gName :: T.Text+ , gRemoteIp :: T.Text+ , gLocalIp :: T.Text+ , gRemoteNetwork :: T.Text+ , gGreDeviceIp :: T.Text+ } | + GreTapTunnel {+ gName :: T.Text+ , gRemoteIp :: T.Text+ , gLocalIp :: T.Text+ , gGreTapBridge :: T.Text+ }+ deriving (Show,Eq)+$(A.deriveJSON A.defaultOptions{A.fieldLabelModifier = drop 1, A.constructorTagModifier = map toLower} ''Tunnel)++-- sampleTunnel :: (NetworkNameSpace,Tunnel)+-- sampleTunnel =(+-- NetworkNameSpace {+-- nname = "server2"+-- , nnss = []+-- },+-- GreTunnel {+-- gName = "gre2"+-- , gRemoteIp = "192.168.10.3/24"+-- , gLocalIp = "192.168.10.2/24"+-- , gRemoteNetwork ="192.168.12.0/24"+-- , gGreDeviceIp ="192.168.11.254/24"+-- })++createTunnel :: VirtualServer a => a -> Tunnel -> Sh ()+createTunnel ns GreTunnel{..} = do+ void $ runNs ns "ip" ["tunnel", "add", gName, "mode", "gre", "remote", gRemoteIp, "local", gLocalIp]+ void $ runNs ns "ip" ["link", "set", gName, "up"]+ void $ runNs ns "ip" ["link", "set", gName, "mtu", "1462"]+ void $ runNs ns "ip" ["addr", "add", gGreDeviceIp, "dev", gName]+ void $ runNs ns "ip" ["route", "add", gRemoteNetwork, "dev", gName]++createTunnel ns GreTapTunnel{..} = do+ void $ runNs ns "ip" ["link", "add", gName, "type", "gretap", "remote", gRemoteIp, "local", gLocalIp]+ void $ runNs ns "ip" ["link", "set", gName, "up"]+ void $ runNs ns "ip" ["link", "set", gName, "mtu", "1462"]+ void $ runNs ns "ip" ["link", "set", gName, "master", gGreTapBridge]++deleteTunnel :: VirtualServer a => a -> Tunnel -> Sh ()+deleteTunnel ns GreTunnel{..} = do+ ignore $ runNs ns "ip" ["route", "del", gRemoteNetwork, "dev", gName]+ ignore $ runNs ns "ip" ["addr", "del", gGreDeviceIp, "dev", gName]+ ignore $ runNs ns "ip" ["link", "set", gName, "down"]+ ignore $ runNs ns "ip" ["tunnel", "del", gName]+ where+ ignore act = (void $ act) `catch_sh` \(err :: SomeException) -> liftIO $ putStrLn $ show err ++deleteTunnel ns GreTapTunnel{..} = do+ ignore $ runNs ns "ip" ["link", "set", gName, "down"]+ ignore $ runNs ns "ip" ["link", "del", gName]+ where+ ignore act = (void $ act) `catch_sh` \(err :: SomeException) -> liftIO $ putStrLn $ show err +
+ README.md view
@@ -0,0 +1,81 @@+# network-builder : Linux Network NameSpace Builder for test++[](https://hackage.haskell.org/package/network-builder) [](https://travis-ci.org/junjihashimoto/network-builder)++network-builder makes network using Linux Network NameSpaces and tunnels.++## Getting started++Install this from Hackage.++ cabal update && cabal install network-builder++## Usage++When you create network,+put network-builder.yml on current directory.+The yaml format is below.++```+nss:+- - ip: 192.168.10.1/24+ name: br1+ - - - ip: 192.168.10.2/24+ name: veth-2+ - name: server2+ nss:+ - - ip: 192.168.11.1/24+ name: br1+ - - - ip: 192.168.11.4/24+ name: veth-3+ - name: server3+ - - ip: 192.168.10.3/24+ name: veth-4+ - name: server4+ nss:+ - - ip: 192.168.12.1/24+ name: br1+ - - - ip: 192.168.12.4/24+ name: veth-5+ - name: server5+```++When you create tunnel for server2 of namespace+put yaml file(just example) below.++```+- name: server2+- tag: gretunnel+ Name: gre2+ LocalIp: 192.168.10.2+ RemoteIp: 192.168.10.3+ RemoteNetwork: 192.168.12.0/24+ GreDeviceIp: 192.168.11.254/24+```+++## Commands++### create network++```+network-builder create+```++### destroy network++```+network-builder destroy+```++### create tunnel++```+network-builder create-tunnel "yaml-file"+```++### destroy tunnel++```+network-builder destroy-tunnel "yaml-file"+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ network-builder.cabal view
@@ -0,0 +1,73 @@+-- Initial network-builder.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: network-builder+version: 0.1.0+synopsis: Linux NetworkNameSpace Builder+description: Linux NetworkNameSpace Builder+license: BSD3+license-file: LICENSE+author: Junji Hashimoto+maintainer: junji.hashimoto@gmail.com+-- copyright: +stability: Experimental+category: Network+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++bug-reports: https://github.com/junjihashimoto/network-builder/issues++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/junjihashimoto/network-builder.git++library+ exposed-modules: Network.Builder+ , Network.Builder.Namespace+ , Network.Builder.Tunnel+ -- other-modules: + -- other-extensions: + build-depends: base >=4 && <5+ ,aeson+ ,yaml+ ,shelly+ ,text+ ,bytestring++ -- hs-source-dirs: + ghc-options: -Wall -O2+ default-language: Haskell2010++executable network-builder+ main-is: network-builder.hs+ -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <5+ ,aeson+ ,yaml+ ,shelly+ ,text+ ,bytestring+ ,optparse-applicative+ ,network-builder+ -- hs-source-dirs: + default-language: Haskell2010+ ghc-options: -Wall++test-suite test+ type: exitcode-stdio-1.0+ main-is: test.hs+ hs-source-dirs: tests,dist/build/autogen+ ghc-options: -Wall++ build-depends: base+ ,hspec+ ,hspec-server+ ,cabal-test-bin+ ,process+ Default-Language: Haskell2010
+ network-builder.hs view
@@ -0,0 +1,102 @@+{-#LANGUAGE OverloadedStrings#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE ExtendedDefaultRules #-}+{-#LANGUAGE RecordWildCards #-}+{-#LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+import Prelude hiding (FilePath)+import Shelly hiding (command)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++import Data.Monoid+import Options.Applicative+import qualified Data.Yaml as Y+import Network.Builder++default (T.Text)++data Command+ = Create String+ | Destroy String+ | Show String+ | CreateTunnel String+ | DestroyTunnel String+ | ShowTunnel String++create :: Parser Command+create = Create+ <$> option str (long "conf" <> value "network-builder.yml" <> metavar "CONFILE")++destroy :: Parser Command+destroy = Destroy+ <$> option str (long "conf" <> value "network-builder.yml" <> metavar "CONFILE")++createTun :: Parser Command+createTun = CreateTunnel+ <$> argument str (metavar "TUNNELFILE")++destroyTun :: Parser Command+destroyTun = DestroyTunnel+ <$> argument str (metavar "TUNNELFILE")++showTun :: Parser Command+showTun = ShowTunnel+ <$> argument str (metavar "TUNNELFILE")++showYaml :: Parser Command+showYaml = Show+ <$> option auto (long "conf" <> value "network-builder.yml" <> metavar "CONFILE")++parse :: Parser Command+parse = subparser $ + command "create" (info create (progDesc "create linux-network-namespaces")) <>+ command "destroy" (info destroy (progDesc "destroy linux-network-namespaces")) <>+ command "show" (info showYaml (progDesc "show decoded yaml-conf")) <>+ command "create-tunnel" (info createTun (progDesc "create tunnel")) <>+ command "destroy-tunnel" (info destroyTun (progDesc "destroy tunnel")) <>+ command "show-tunnel" (info showTun (progDesc "show tunnel"))++runCmd' :: String -> (HostServer -> Sh a) -> IO a+runCmd' file action' = shelly $ do+ echo $ T.pack file+ eyaml <- liftIO $ Y.decodeFileEither file+ case eyaml of+ Right conf -> action' conf+ Left err -> do+ echo $ T.pack $ show err+ exit 1++runCmd'' :: String+ -> (NetworkNameSpace -> Tunnel -> Sh a)+ -> (HostServer -> Tunnel -> Sh a)+ -> IO a+runCmd'' file act0 act1 = shelly $ do+ eyaml <- liftIO $ Y.decodeFileEither file :: Sh (Either Y.ParseException (NetworkNameSpace,Tunnel))+ case eyaml of+ Right (netconf,tunnelconf) -> act0 netconf tunnelconf+ Left _err -> do+ eyaml' <- liftIO $ Y.decodeFileEither file :: Sh (Either Y.ParseException (HostServer,Tunnel))+ case eyaml' of+ Right (netconf,tunnelconf) -> act1 netconf tunnelconf+ Left err -> do+ echo $ T.pack $ show err+ exit 1++runCmd :: Command -> IO ()+runCmd (Create file) = runCmd' file createNetworkNameSpaces+runCmd (Destroy file) = runCmd' file deleteNetworkNameSpaces+runCmd (Show file) = runCmd' file $ echo . T.pack . show+runCmd (CreateTunnel file) = runCmd'' file createTunnel createTunnel+runCmd (DestroyTunnel file) = runCmd'' file deleteTunnel deleteTunnel+runCmd (ShowTunnel file) = runCmd'' file + (\n t -> echo $ T.decodeUtf8 $ Y.encode (n,t))+ (\n t -> echo $ T.decodeUtf8 $ Y.encode (n,t))++opts :: ParserInfo Command+opts = info (parse <**> helper) idm++main :: IO ()+main = execParser opts >>= runCmd+
+ tests/test.hs view
@@ -0,0 +1,133 @@+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}++import Test.Hspec+import Test.Hspec.Server++import Test.Cabal.Path+import System.Process++data NameSpace = NameSpace{+ nName :: String+, nOS :: !(Maybe ServerOS)+} deriving (Show,Eq)++namespace :: String -> NameSpace+namespace name = NameSpace name Nothing++instance ServerType NameSpace where+ stSetup a = do+ os' <- detectOS a+ return $ a {nOS = os'}+ stOS = nOS+ stName = nName+ stCmd d c arg i = do+ readProcessWithExitCode "sudo" ( ["ip", "netns", "exec", nName d, c] ++ arg ) i++main :: IO ()+main = do+ bin <- getExePath "." "network-builder"+ hspec $ do+ describe "Create Network" $ with localhost $ do+ it "create network" $ do+ command bin ["create","--conf","sample/sample-gre/network-builder.yml"] [] @>= exit 0+ describe "Test Network from server2" $ with (namespace "server2") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.4" @>= reachable+ host "192.168.12.1" @== none+ host "192.168.12.4" @== none+ describe "Test Network from server3" $ with (namespace "server3") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.4" @>= reachable+ host "192.168.12.1" @== none+ host "192.168.12.4" @== none+ describe "Create Gre Tunnel" $ with localhost $ do+ it "create tunnel from server2 to server4" $ do+ command bin ["create-tunnel","sample/sample-gre/tunnel0.yml"] [] @>= exit 0+ it "create tunnel from server4 to server2" $ do+ command bin ["create-tunnel","sample/sample-gre/tunnel1.yml"] [] @>= exit 0+ describe "Test Network from server2" $ with (namespace "server2") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.4" @>= reachable+ host "192.168.12.1" @>= reachable+ host "192.168.12.4" @>= reachable+ describe "Test Network from server3" $ with (namespace "server3") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.4" @>= reachable+ host "192.168.12.1" @== reachable+ host "192.168.12.4" @== reachable+ describe "Destroy Network with Gre Tunnel" $ with localhost $ do+ it "destroy network" $ do+ command bin ["destroy","--conf","sample/sample-gre/network-builder.yml"] [] @>= exit 0+ describe "Create Network with GreTap Tunnel" $ with localhost $ do+ it "create" $ do+ command bin ["create","--conf","sample/sample-gretap/network-builder.yml"] [] @>= exit 0+ describe "Test Network from server2" $ with (namespace "server2") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.2" @>= reachable+ host "192.168.11.3" @== none+ host "192.168.11.4" @== none+ describe "Test Network from server3" $ with (namespace "server3") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.2" @>= reachable+ host "192.168.11.3" @== none+ host "192.168.11.4" @== none+ describe "Create GreTap Tunnel" $ with localhost $ do+ it "create tunnel from server2 to server4" $ do+ command bin ["create-tunnel","sample/sample-gretap/tunnel0.yml"] [] @>= exit 0+ it "create tunnel from server4 to server2" $ do+ command bin ["create-tunnel","sample/sample-gretap/tunnel1.yml"] [] @>= exit 0+ describe "Test Network from server2" $ with (namespace "server2") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.2" @>= reachable+ host "192.168.11.3" @== reachable+ host "192.168.11.4" @== reachable+ describe "Test Network from server3" $ with (namespace "server3") $ do+ it "ping" $ do+ host "127.0.0.1" @>= reachable+ host "192.168.10.1" @>= reachable+ host "192.168.10.2" @>= reachable+ host "192.168.10.3" @>= reachable+ host "192.168.11.1" @>= reachable+ host "192.168.11.2" @>= reachable+ host "192.168.11.3" @== reachable+ host "192.168.11.4" @== reachable+ describe "Destroy Network with GreTap Tunnel" $ with localhost $ do+ it "destroy" $ do+ command bin ["destroy","--conf","sample/sample-gretap/network-builder.yml"] [] @>= exit 0