Add tests
Former-commit-id: 784e7ccb82c0d876e4b7221799d76b7323fed37d Former-commit-id: 2147af8d557978e41ac2b6cc8070e263b812f5af [formerly 409f5e7f3f1efaa572b5204734f7b98ba45691f8] [formerly 8ec0c0a6f589c7b550f84ca5f8413659dae0cec6 [formerly 75b709eacf85d0ec4510f1e92718613921d4f71e [formerly 75b709eacf85d0ec4510f1e92718613921d4f71e [formerly 75b709eacf85d0ec4510f1e92718613921d4f71e [formerly f30b98f39fbf0b640df77a3014419ffd2330a166]]]]] Former-commit-id: d5a419daa10be6c65d58dcbd848e89eef5185c57 [formerly 2dfce717ba105274f52114e53fcb9e115782e8ea] Former-commit-id: 0ee61f2da6b6fb2e67ca83e10110d8fc7471570f Former-commit-id: 3ed9511801de3f101c54d40dafab73e3178f3bdb Former-commit-id: a8cf76cf8663e8e052cae6e4302da48342cd394d Former-commit-id: 0730d51e0fe05af0f7e21d66ab0029879afbfbe9 [formerly 1f4ce8c620ba9909e24757d90eebd189958a6299] Former-commit-id: a8a721fe1165d376eeebe8f12ab62f5c0029a981
This commit is contained in:
Romain GÉRARD
parent
0a788ca3f7
commit
cce0c73296
3 changed files with 226 additions and 1 deletions
|
|
@ -5,6 +5,7 @@
|
|||
module Tunnel
|
||||
( runClient
|
||||
, runServer
|
||||
, rrunTCPClient
|
||||
) where
|
||||
|
||||
import ClassyPrelude
|
||||
|
|
|
|||
217
test/Spec.hs
217
test/Spec.hs
|
|
@ -1,2 +1,217 @@
|
|||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import ClassyPrelude hiding (getArgs, head)
|
||||
import qualified Logger
|
||||
import qualified Network.Socket as N hiding (recv, recvFrom,
|
||||
send, sendTo)
|
||||
import qualified Network.Socket.ByteString as N
|
||||
import qualified Data.Conduit.Network.TLS as N
|
||||
import qualified Data.Streaming.Network as N
|
||||
|
||||
import Control.Concurrent.Async as Async
|
||||
import Data.ByteString (hPutStr)
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Test.Hspec
|
||||
import Data.Binary (decode, encode)
|
||||
|
||||
|
||||
import Tunnel
|
||||
import Types
|
||||
import Protocols
|
||||
import qualified Socks5 as Socks5
|
||||
|
||||
testTCPLocalToRemote :: Bool -> IO ()
|
||||
testTCPLocalToRemote useTLS = do
|
||||
|
||||
Logger.init Logger.VERBOSE
|
||||
|
||||
success <- newIORef False
|
||||
let needle = "toto"
|
||||
|
||||
-- SERVER
|
||||
let serverPort = 8080
|
||||
let serverWithoutTLS = runServer useTLS ("0.0.0.0", serverPort) (const True)
|
||||
|
||||
-- CLIENT
|
||||
let tunnelSetting = TunnelSettings {
|
||||
localBind = "localhost"
|
||||
, Types.localPort = fromIntegral 8081
|
||||
, serverHost = "localhost"
|
||||
, serverPort = fromIntegral serverPort
|
||||
, destHost = "localhost"
|
||||
, destPort = fromIntegral 8082
|
||||
, Types.useTls = useTLS
|
||||
, protocol = TCP
|
||||
, proxySetting = Nothing
|
||||
, useSocks = False
|
||||
, upgradePrefix = "wstunnel"
|
||||
, udpTimeout = 0
|
||||
}
|
||||
let client = runClient tunnelSetting
|
||||
|
||||
-- Remote STUB ENDPOINT
|
||||
let remoteSetting = N.serverSettingsTCP (fromIntegral 8082) "localhost"
|
||||
let remoteServerEndpoint = N.runTCPServer remoteSetting $ (\sClient -> do N.appRead sClient >>= \payload -> if payload == needle then writeIORef success True else writeIORef success False)
|
||||
|
||||
-- local STUB ENDPOINT
|
||||
let localClient = rrunTCPClient (N.clientSettingsTCP (fromIntegral 8081) "localhost") (\cnx -> write cnx needle)
|
||||
|
||||
putStrLn "Starting remote endpoint"
|
||||
Async.async $ timeout (10 * 10^6) remoteServerEndpoint
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Starting wstunnel server"
|
||||
Async.async $ timeout (10 * 10^6) serverWithoutTLS
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Starting wstunnel client"
|
||||
Async.async $ timeout (10 * 10^6) client
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Writing data to the pipeline"
|
||||
_ <- localClient
|
||||
threadDelay (7 * 10^6)
|
||||
|
||||
isSuccess <- readIORef success
|
||||
if not isSuccess
|
||||
then throwString "Tunnel is not working"
|
||||
else putStrLn "Success"
|
||||
|
||||
testUDPLocalToRemote :: Bool -> IO ()
|
||||
testUDPLocalToRemote useTLS = do
|
||||
|
||||
Logger.init Logger.VERBOSE
|
||||
|
||||
success <- newIORef False
|
||||
let needle = "toto"
|
||||
|
||||
-- SERVER
|
||||
let serverPort = 8080
|
||||
let serverWithoutTLS = runServer useTLS ("0.0.0.0", serverPort) (const True)
|
||||
|
||||
-- CLIENT
|
||||
let tunnelSetting = TunnelSettings {
|
||||
localBind = "localhost"
|
||||
, Types.localPort = fromIntegral 8081
|
||||
, serverHost = "localhost"
|
||||
, serverPort = fromIntegral serverPort
|
||||
, destHost = "localhost"
|
||||
, destPort = fromIntegral 8082
|
||||
, Types.useTls = useTLS
|
||||
, protocol = UDP
|
||||
, proxySetting = Nothing
|
||||
, useSocks = False
|
||||
, upgradePrefix = "wstunnel"
|
||||
, udpTimeout = -1
|
||||
}
|
||||
let client = runClient tunnelSetting
|
||||
|
||||
-- Remote STUB ENDPOINT
|
||||
let remoteServerEndpoint = runUDPServer ("localhost", fromIntegral 8082) (-1) $ (\sClient -> do read (toConnection sClient) >>= \(Just payload) -> if payload == needle then writeIORef success True else writeIORef success False)
|
||||
|
||||
-- local STUB ENDPOINT
|
||||
let localClient = runUDPClient ("localhost", fromIntegral 8081) (\cnx -> write (toConnection cnx) needle)
|
||||
|
||||
putStrLn "Starting remote endpoint"
|
||||
Async.async $ timeout (10 * 10^6) remoteServerEndpoint
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Starting wstunnel server"
|
||||
Async.async $ timeout (10 * 10^6) serverWithoutTLS
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Starting wstunnel client"
|
||||
Async.async $ timeout (10 * 10^6) client
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Writing data to the pipeline"
|
||||
_ <- localClient
|
||||
threadDelay (7 * 10^6)
|
||||
|
||||
isSuccess <- readIORef success
|
||||
if not isSuccess
|
||||
then throwString "Tunnel is not working"
|
||||
else putStrLn "Success"
|
||||
|
||||
testSocks5Tunneling :: Bool -> IO ()
|
||||
testSocks5Tunneling useTLS = do
|
||||
|
||||
Logger.init Logger.VERBOSE
|
||||
|
||||
success <- newIORef False
|
||||
let needle = "toto"
|
||||
|
||||
-- SERVER
|
||||
let serverPort = 8080
|
||||
let serverWithoutTLS = runServer useTLS ("0.0.0.0", serverPort) (const True)
|
||||
|
||||
-- CLIENT
|
||||
let tunnelSetting = TunnelSettings {
|
||||
localBind = "localhost"
|
||||
, Types.localPort = fromIntegral 8081
|
||||
, serverHost = "localhost"
|
||||
, serverPort = fromIntegral serverPort
|
||||
, destHost = ""
|
||||
, destPort = 0
|
||||
, Types.useTls = useTLS
|
||||
, protocol = SOCKS5
|
||||
, proxySetting = Nothing
|
||||
, useSocks = False
|
||||
, upgradePrefix = "wstunnel"
|
||||
, udpTimeout = -1
|
||||
}
|
||||
let client = runClient tunnelSetting
|
||||
|
||||
-- Remote STUB ENDPOINT
|
||||
let remoteSetting = N.serverSettingsTCP (fromIntegral 8082) "localhost"
|
||||
let remoteServerEndpoint = N.runTCPServer remoteSetting $ (\sClient -> do N.appRead sClient >>= \payload -> if payload == needle then writeIORef success True else writeIORef success False)
|
||||
|
||||
|
||||
putStrLn "Starting remote endpoint"
|
||||
Async.async $ timeout (10 * 10^6) remoteServerEndpoint
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Starting wstunnel server"
|
||||
Async.async $ timeout (10 * 10^6) serverWithoutTLS
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Starting wstunnel client"
|
||||
Async.async $ timeout (10 * 10^6) client
|
||||
threadDelay (1 * 10^6)
|
||||
|
||||
putStrLn "Writing data to the pipeline"
|
||||
rrunTCPClient (N.clientSettingsTCP (fromIntegral 8081) "localhost") $ \cnx -> do
|
||||
write cnx (toStrict . encode $ Socks5.RequestAuth (fromIntegral Socks5.socksVersion) (fromList [Socks5.NoAuth]))
|
||||
_ <- read cnx
|
||||
write cnx (toStrict . encode $ Socks5.Request (fromIntegral Socks5.socksVersion) Socks5.Connect "localhost" 8082)
|
||||
_ <- read cnx
|
||||
write cnx needle
|
||||
|
||||
threadDelay (7 * 10^6)
|
||||
|
||||
isSuccess <- readIORef success
|
||||
if not isSuccess
|
||||
then throwString "Tunnel is not working"
|
||||
else putStrLn "Success"
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
||||
main = hspec $ do
|
||||
describe "Socks5 tunneling" $ do
|
||||
it "Testing socks5 -D without TLS" $ do
|
||||
testSocks5Tunneling False
|
||||
it "Testing socks5 -D with TLS" $ do
|
||||
testSocks5Tunneling True
|
||||
|
||||
describe "TCP tunneling" $ do
|
||||
it "Testing TCP -L without TLS" $ do
|
||||
testTCPLocalToRemote False
|
||||
it "Testing TCP -L with TLS" $ do
|
||||
testTCPLocalToRemote True
|
||||
|
||||
describe "UDP tunneling" $ do
|
||||
it "Testing UDP -L without TLS" $ do
|
||||
testUDPLocalToRemote False
|
||||
it "Testing UDP -L with TLS" $ do
|
||||
testUDPLocalToRemote True
|
||||
|
||||
|
|
|
|||
|
|
@ -40,9 +40,18 @@ test-suite wstunnel-test
|
|||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Spec.hs
|
||||
default-extensions: NoImplicitPrelude, ScopedTypeVariables, BangPatterns, RecordWildCards
|
||||
build-depends: base
|
||||
, async
|
||||
, text >= 1.2.2.1
|
||||
, classy-prelude
|
||||
, bytestring
|
||||
, network
|
||||
, network-conduit-tls
|
||||
, streaming-commons
|
||||
, wstunnel
|
||||
, hspec
|
||||
, binary
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
default-language: Haskell2010
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue