hex/wstunnel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor to modularize more

Browse source 
Former-commit-id: 1d5ae90a514e575706d5a4ed333cb7bcea613fed
Former-commit-id: 9cfc1936086198e0c437346608794694e0e95b90 [formerly 33e7bbb44e5903ddb90b3fe2c0e5555dbc546bd5 [formerly 33e7bbb44e5903ddb90b3fe2c0e5555dbc546bd5 [formerly 33e7bbb44e5903ddb90b3fe2c0e5555dbc546bd5 [formerly c66b2faff45e0b65779d7fed4d3355d859ae8e34]]]]
Former-commit-id: 4d38d80a6e1bd03be92f0939f269803676094da4
Former-commit-id: ad7ee33491764b8111037c046f64b5c288cfe420
Former-commit-id: 7089db6838c542c2a278992e492a421303b20707
Former-commit-id: 00f00a4f5296725498aeb0daa8b21cfa4568627e [formerly fd688a2c91cc9c927fd8fa32f7e62dc432286d86]
Former-commit-id: 991bfe5b8f959fad26e326877e92f168127f0803
This commit is contained in:
Erèbe 2016-08-27 18:31:32 +02:00
parent 4a704f0bd3
commit 1f923c4943
7 changed files with 218 additions and 196 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
app/Main.hs
View file

@ -4,7 +4,6 @@
module Main where
import Tunnel
import ClassyPrelude (ByteString, guard, readMay)
import qualified Data.ByteString.Char8 as BC
@ -13,6 +12,9 @@ import System.Console.CmdArgs
import System.Environment (getArgs, withArgs)
import qualified System.Log.Logger as LOG
import Tunnel
import Types
data WsTunnel = WsTunnel
{ localToRemote :: String
-- , remoteToLocal :: String
@ -135,12 +137,12 @@ main = do
else if not $ null (localToRemote cfg)
then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg)
in runClient TunnelSettings { localBind = lHost
, Tunnel.localPort = fromIntegral lPort
, Types.localPort = fromIntegral lPort
, serverHost = Main.host serverInfo
, serverPort = fromIntegral $ Main.port serverInfo
, destHost = rHost
, destPort = fromIntegral rPort
, Tunnel.useTls = Main.useTls serverInfo
, Types.useTls = Main.useTls serverInfo
, protocol = if udpMode cfg then UDP else TCP
, proxySetting = parseProxyInfo (proxy cfg)
, useSocks = False
@ -148,12 +150,12 @@ main = do
else if not $ null (dynamicToRemote cfg)
then let (TunnelInfo lHost lPort _ _) = parseTunnelInfo $ (dynamicToRemote cfg) ++ ":127.0.0.1:1212"
in runClient TunnelSettings { localBind = lHost
, Tunnel.localPort = fromIntegral lPort
, Types.localPort = fromIntegral lPort
, serverHost = Main.host serverInfo
, serverPort = fromIntegral $ Main.port serverInfo
, destHost = ""
, destPort = 0
, Tunnel.useTls = Main.useTls serverInfo
, Types.useTls = Main.useTls serverInfo
, protocol = SOCKS5
, proxySetting = parseProxyInfo (proxy cfg)
, useSocks = True

36
src/Credentials.hs Normal file
View file

@ -0,0 +1,36 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Credentials where
import ClassyPrelude
-- openssl genrsa 512 > host.key
-- openssl req -new -x509 -nodes -sha1 -days 9999 -key host.key > host.cert
key :: ByteString
key = "-----BEGIN RSA PRIVATE KEY-----\n" <>
"MIIBOgIBAAJBAMEEloIcF3sTGYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5k\n" <>
"Uew8CR58e7c5GgK08ZOJwi2Hpl9MfDm4mGUCAwEAAQJAGP+nHqLUx7PpkqYd8iVX\n" <>
"iQB/nfqEhRnF27GDZTb9RT7e3bR7X1B9oIBnpmqwMG5oPxidoIKv+jzZjsQcxKLu\n" <>
"4QIhAPdcPmFrtLUpTXx21wtVxotsO7+YcQxtRtBoXeiREUInAiEAx8Jx9a6eVRIh\n" <>
"slSTJMPuy/LbvK8VUTqtx9x2EhFhBJMCIQC68qlmwZs6y/N3HO4b8AD1gKCLhm/y\n" <>
"P2ikvCw1R+ZuQwIgdfcgMUPzgK16dMN5OabzaEF8/kouvo92fKZ2m2jj8D0CIFY8\n" <>
"4SkXDkpeUEKKfxHqrEkkxmpRk93Ui1NPyN+wxrgO\n" <>
"-----END RSA PRIVATE KEY-----"
certificate :: ByteString
certificate = "-----BEGIN CERTIFICATE-----\n" <>
"MIICXTCCAgegAwIBAgIJAJf1Sm7DI0KcMA0GCSqGSIb3DQEBBQUAMIGJMQswCQYD\n" <>
"VQQGEwJGUjESMBAGA1UECAwJQXF1aXRhaW5lMRAwDgYDVQQHDAdCYXlvbm5lMQ4w\n" <>
"DAYDVQQKDAVFcmViZTELMAkGA1UECwwCSVQxFjAUBgNVBAMMDXJvbWFpbi5nZXJh\n" <>
"cmQxHzAdBgkqhkiG9w0BCQEWEHdoeW5vdEBnbWFpbC5jb20wHhcNMTYwNTIxMTUy\n" <>
"MzIyWhcNNDMxMDA2MTUyMzIyWjCBiTELMAkGA1UEBhMCRlIxEjAQBgNVBAgMCUFx\n" <>
"dWl0YWluZTEQMA4GA1UEBwwHQmF5b25uZTEOMAwGA1UECgwFRXJlYmUxCzAJBgNV\n" <>
"BAsMAklUMRYwFAYDVQQDDA1yb21haW4uZ2VyYXJkMR8wHQYJKoZIhvcNAQkBFhB3\n" <>
"aHlub3RAZ21haWwuY29tMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAMEEloIcF3sT\n" <>
"GYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5kUew8CR58e7c5GgK08ZOJwi2H\n" <>
"pl9MfDm4mGUCAwEAAaNQME4wHQYDVR0OBBYEFLY0HsQst1t3QRXU0aTWg3V1IvGX\n" <>
"MB8GA1UdIwQYMBaAFLY0HsQst1t3QRXU0aTWg3V1IvGXMAwGA1UdEwQFMAMBAf8w\n" <>
"DQYJKoZIhvcNAQEFBQADQQCP4oYOIrX7xvmQih3hvF4kUnbKjtttImdGruonsLAz\n" <>
"OL2VExC6OqlDP2yu14BlsjTt+X2v6mhHnSM16c6AkpM/\n" <>
"-----END CERTIFICATE-----"

2
src/Utils.hs → src/Logger.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
module Utils where
module Logger where
import ClassyPrelude
import Network.Socket (HostName, PortNumber)

49
src/Protocols.hs
View file

@ -1,10 +1,8 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
module Protocols where
@ -22,25 +20,11 @@ import qualified Network.Socket as N hiding (recv, recvFrom, send,
sendTo)
import qualified Network.Socket.ByteString as N
import Utils
import Data.Binary (decode, encode)
deriving instance Generic PortNumber
deriving instance Hashable PortNumber
deriving instance Generic N.SockAddr
deriving instance Hashable N.SockAddr
data Protocol = UDP | TCP | SOCKS5 deriving (Show, Read, Eq)
data UdpAppData = UdpAppData
{ appAddr :: N.SockAddr
, appSem :: MVar ByteString
, appRead :: IO ByteString
, appWrite :: ByteString -> IO ()
}
instance N.HasReadWrite UdpAppData where
readLens f appData = fmap (\getData -> appData { appRead = getData}) (f $ appRead appData)
writeLens f appData = fmap (\writeData -> appData { appWrite = writeData}) (f $ appWrite appData)
import Logger
import qualified Socks5
import Types
runTCPServer :: (HostName, PortNumber) -> (N.AppData -> IO ()) -> IO ()
@ -108,3 +92,26 @@ runUDPServer endPoint@(host, port) app = do
(addNewClient clientsCtx socket addr payload)
(removeClient clientsCtx)
(void . timeout (30 * 10^(6 :: Int)) . app)
runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO ()
runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do
info $ "Starting socks5 proxy " <> show socksSettings
N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do
-- Get the auth request and response with a no Auth
authRequest <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.ResponseAuth
debug $ "Socks5 authentification request " <> show authRequest
let responseAuth = encode $ Socks5.ResponseAuth (fromIntegral Socks5.socksVersion) Socks5.NoAuth
N.appWrite cnx (toStrict responseAuth)
-- Get the request and update dynamically the tunnel config
request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request
debug $ "Socks5 forward request " <> show request
let responseRequest = encode $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request)
let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request }
N.appWrite cnx (toStrict responseRequest)
inner cfg' cnx
info $ "Closing socks5 proxy " <> show socksSettings

197
src/Tunnel.hs
View file

@ -9,9 +9,6 @@
module Tunnel
( runClient
, runServer
, TunnelSettings(..)
, Protocol(..)
, ProxySettings(..)
) where
import ClassyPrelude
@ -34,93 +31,18 @@ import qualified Network.WebSockets.Stream as WS
import Control.Monad.Except
import qualified Network.Connection as NC
import Protocols
import System.IO (IOMode (ReadWriteMode))
import System.Timeout
import qualified Data.ByteString.Base64 as B64
import Utils
import Types
import Protocols
import qualified Socks5
import Data.Binary (encode, decode)
data ProxySettings = ProxySettings
{ host :: HostName
, port :: PortNumber
, credentials :: Maybe (ByteString, ByteString)
} deriving (Show)
data TunnelSettings = TunnelSettings
{ proxySetting :: Maybe ProxySettings
, localBind :: HostName
, localPort :: PortNumber
, serverHost :: HostName
, serverPort :: PortNumber
, destHost :: HostName
, destPort :: PortNumber
, protocol :: Protocol
, useTls :: Bool
, useSocks :: Bool
}
instance Show TunnelSettings where
show TunnelSettings{..} = localBind <> ":" <> show localPort
<> (if isNothing proxySetting
then mempty
else " <==PROXY==> " <> host (fromJust proxySetting) <> ":" <> (show . port $ fromJust proxySetting)
)
<> " <==" <> (if useTls then "WSS" else "WS") <> "==> "
<> serverHost <> ":" <> show serverPort
<> " <==" <> show (if protocol == SOCKS5 then TCP else protocol) <> "==> " <> destHost <> ":" <> show destPort
import Logger
import qualified Credentials
data Connection = Connection
{ read :: IO (Maybe ByteString)
, write :: ByteString -> IO ()
, close :: IO ()
, rawConnection :: Maybe N.Socket
}
data Error = ProxyConnectionError String
| ProxyForwardError String
| LocalServerError String
| TunnelError String
| WebsocketError String
| TlsError String
| Other String
deriving (Show)
class ToConnection a where
toConnection :: a -> Connection
instance ToConnection WS.Connection where
toConnection conn = Connection { read = Just <$> WS.receiveData conn
, write = WS.sendBinaryData conn
, close = WS.sendClose conn (mempty :: LByteString)
, rawConnection = Nothing
}
instance ToConnection N.AppData where
toConnection conn = Connection { read = Just <$> N.appRead conn
, write = N.appWrite conn
, close = N.appCloseConnection conn
, rawConnection = Nothing
}
instance ToConnection UdpAppData where
toConnection conn = Connection { read = Just <$> appRead conn
, write = appWrite conn
, close = return ()
, rawConnection = Nothing
}
instance ToConnection NC.Connection where
toConnection conn = Connection { read = Just <$> NC.connectionGetChunk conn
, write = NC.connectionPut conn
, close = NC.connectionClose conn
, rawConnection = Nothing
}
rrunTCPClient :: N.ClientSettings -> (Connection -> IO a) -> IO a
rrunTCPClient cfg app = bracket
@ -252,49 +174,18 @@ runClient cfg@TunnelSettings{..} = do
TCP -> runTCPServer (localBind, localPort) (app cfg)
SOCKS5 -> runSocks5Server (Socks5.ServerSettings localPort localBind) cfg app
handleError :: Either Error () -> IO ()
handleError (Right ()) = return ()
handleError (Left errMsg) =
case errMsg of
ProxyConnectionError msg -> err "Cannot connect to the proxy" >> debugPP msg
ProxyForwardError msg -> err "Connection not allowed by the proxy" >> debugPP msg
TunnelError msg -> err "Cannot establish the connection to the server" >> debugPP msg
LocalServerError msg -> err "Cannot create the localServer, port already binded ?" >> debugPP msg
WebsocketError msg -> err "Cannot establish websocket connection with the server" >> debugPP msg
TlsError msg -> err "Cannot do tls handshake with the server" >> debugPP msg
Other msg -> debugPP msg
where
debugPP msg = debug $ "====\n" <> msg <> "\n===="
(<==>) :: Connection -> Connection -> IO (Either Error ())
(<==>) hTunnel hOther =
myTry $ race_ (propagateReads hTunnel hOther) (propagateWrites hTunnel hOther)
propagateReads :: Connection -> Connection -> IO ()
propagateReads hTunnel hOther = forever $ read hTunnel >>= write hOther . fromJust
propagateWrites :: Connection -> Connection -> IO ()
propagateWrites hTunnel hOther = do
payload <- fromJust <$> read hOther
unless (null payload) (write hTunnel payload >> propagateWrites hTunnel hOther)
myTry :: MonadError Error m => IO a -> IO (m ())
myTry f = either (\(e :: SomeException) -> throwError . Other $ show e) (const $ return ()) <$> try f
--
-- Server
--
runTlsTunnelingServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()
runTlsTunnelingServer endPoint@(bindTo, portNumber) isAllowed = do
info $ "WAIT for TLS connection on " <> toStr endPoint
N.runTCPServerTLS (N.tlsConfigBS (fromString bindTo) (fromIntegral portNumber) serverCertificate serverKey) $ \sClient ->
N.runTCPServerTLS (N.tlsConfigBS (fromString bindTo) (fromIntegral portNumber) Credentials.certificate Credentials.key) $ \sClient ->
runApp sClient WS.defaultConnectionOptions (serverEventLoop isAllowed)
info "SHUTDOWN server"
@ -344,43 +235,9 @@ runServer useTLS = if useTLS then runTlsTunnelingServer else runTunnelingServer
-- openssl genrsa 512 > host.key
-- openssl req -new -x509 -nodes -sha1 -days 9999 -key host.key > host.cert
serverKey :: ByteString
serverKey = "-----BEGIN RSA PRIVATE KEY-----\n" <>
"MIIBOgIBAAJBAMEEloIcF3sTGYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5k\n" <>
"Uew8CR58e7c5GgK08ZOJwi2Hpl9MfDm4mGUCAwEAAQJAGP+nHqLUx7PpkqYd8iVX\n" <>
"iQB/nfqEhRnF27GDZTb9RT7e3bR7X1B9oIBnpmqwMG5oPxidoIKv+jzZjsQcxKLu\n" <>
"4QIhAPdcPmFrtLUpTXx21wtVxotsO7+YcQxtRtBoXeiREUInAiEAx8Jx9a6eVRIh\n" <>
"slSTJMPuy/LbvK8VUTqtx9x2EhFhBJMCIQC68qlmwZs6y/N3HO4b8AD1gKCLhm/y\n" <>
"P2ikvCw1R+ZuQwIgdfcgMUPzgK16dMN5OabzaEF8/kouvo92fKZ2m2jj8D0CIFY8\n" <>
"4SkXDkpeUEKKfxHqrEkkxmpRk93Ui1NPyN+wxrgO\n" <>
"-----END RSA PRIVATE KEY-----"
serverCertificate :: ByteString
serverCertificate = "-----BEGIN CERTIFICATE-----\n" <>
"MIICXTCCAgegAwIBAgIJAJf1Sm7DI0KcMA0GCSqGSIb3DQEBBQUAMIGJMQswCQYD\n" <>
"VQQGEwJGUjESMBAGA1UECAwJQXF1aXRhaW5lMRAwDgYDVQQHDAdCYXlvbm5lMQ4w\n" <>
"DAYDVQQKDAVFcmViZTELMAkGA1UECwwCSVQxFjAUBgNVBAMMDXJvbWFpbi5nZXJh\n" <>
"cmQxHzAdBgkqhkiG9w0BCQEWEHdoeW5vdEBnbWFpbC5jb20wHhcNMTYwNTIxMTUy\n" <>
"MzIyWhcNNDMxMDA2MTUyMzIyWjCBiTELMAkGA1UEBhMCRlIxEjAQBgNVBAgMCUFx\n" <>
"dWl0YWluZTEQMA4GA1UEBwwHQmF5b25uZTEOMAwGA1UECgwFRXJlYmUxCzAJBgNV\n" <>
"BAsMAklUMRYwFAYDVQQDDA1yb21haW4uZ2VyYXJkMR8wHQYJKoZIhvcNAQkBFhB3\n" <>
"aHlub3RAZ21haWwuY29tMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAMEEloIcF3sT\n" <>
"GYhQmybyDm1NOpXmf94rR1fOwENjuW6jh4WTaz5kUew8CR58e7c5GgK08ZOJwi2H\n" <>
"pl9MfDm4mGUCAwEAAaNQME4wHQYDVR0OBBYEFLY0HsQst1t3QRXU0aTWg3V1IvGX\n" <>
"MB8GA1UdIwQYMBaAFLY0HsQst1t3QRXU0aTWg3V1IvGXMAwGA1UdEwQFMAMBAf8w\n" <>
"DQYJKoZIhvcNAQEFBQADQQCP4oYOIrX7xvmQih3hvF4kUnbKjtttImdGruonsLAz\n" <>
"OL2VExC6OqlDP2yu14BlsjTt+X2v6mhHnSM16c6AkpM/\n" <>
"-----END CERTIFICATE-----"
--
-- Commons
--
toPath :: TunnelSettings -> String
toPath TunnelSettings{..} = "/" <> toLower (show $ if protocol == SOCKS5 then TCP else protocol) <> "/" <> destHost <> "/" <> show destPort
@ -393,29 +250,33 @@ fromPath path = let rets = BC.split '/' . BC.drop 1 $ path
proto <- readMay . toUpper . BC.unpack $ protocol :: Maybe Protocol
return (proto, h, prt')
handleError :: Either Error () -> IO ()
handleError (Right ()) = return ()
handleError (Left errMsg) =
case errMsg of
ProxyConnectionError msg -> err "Cannot connect to the proxy" >> debugPP msg
ProxyForwardError msg -> err "Connection not allowed by the proxy" >> debugPP msg
TunnelError msg -> err "Cannot establish the connection to the server" >> debugPP msg
LocalServerError msg -> err "Cannot create the localServer, port already binded ?" >> debugPP msg
WebsocketError msg -> err "Cannot establish websocket connection with the server" >> debugPP msg
TlsError msg -> err "Cannot do tls handshake with the server" >> debugPP msg
Other msg -> debugPP msg
runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO ()
runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do
debug $ "Starting socks5 proxy " <> show socksSettings
where
debugPP msg = debug $ "====\n" <> msg <> "\n===="
N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do
-- Get the auth request and response with a no Auth
authRequest <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.ResponseAuth
debug $ "Socks5 authentification request " <> show authRequest
let responseAuth = encode $ Socks5.ResponseAuth (fromIntegral Socks5.socksVersion) Socks5.NoAuth
N.appWrite cnx (toStrict responseAuth)
-- Get the request and update dynamically the tunnel config
request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request
debug $ "Socks5 forward request " <> show request
let responseRequest = encode $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request)
let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request }
N.appWrite cnx (toStrict responseRequest)
inner cfg' cnx
debug $ "Closing socks5 proxy " <> show socksSettings
myTry :: MonadError Error m => IO a -> IO (m ())
myTry f = either (\(e :: SomeException) -> throwError . Other $ show e) (const $ return ()) <$> try f
(<==>) :: Connection -> Connection -> IO (Either Error ())
(<==>) hTunnel hOther =
myTry $ race_ (propagateReads hTunnel hOther) (propagateWrites hTunnel hOther)
propagateReads :: Connection -> Connection -> IO ()
propagateReads hTunnel hOther = forever $ read hTunnel >>= write hOther . fromJust
propagateWrites :: Connection -> Connection -> IO ()
propagateWrites hTunnel hOther = do
payload <- fromJust <$> read hOther
unless (null payload) (write hTunnel payload >> propagateWrites hTunnel hOther)

116
src/Types.hs Normal file
View file

@ -0,0 +1,116 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module Types where
import ClassyPrelude
import Data.Maybe
import qualified Data.Streaming.Network as N
import qualified Network.Connection as NC
import Network.Socket (HostName, PortNumber)
import qualified Network.Socket as N hiding (recv, recvFrom,
send, sendTo)
import qualified Network.Socket.ByteString as N
import qualified Network.WebSockets.Connection as WS
deriving instance Generic PortNumber
deriving instance Hashable PortNumber
deriving instance Generic N.SockAddr
deriving instance Hashable N.SockAddr
data Protocol = UDP | TCP | SOCKS5 deriving (Show, Read, Eq)
data UdpAppData = UdpAppData
{ appAddr :: N.SockAddr
, appSem :: MVar ByteString
, appRead :: IO ByteString
, appWrite :: ByteString -> IO ()
}
instance N.HasReadWrite UdpAppData where
readLens f appData = fmap (\getData -> appData { appRead = getData}) (f $ appRead appData)
writeLens f appData = fmap (\writeData -> appData { appWrite = writeData}) (f $ appWrite appData)
data ProxySettings = ProxySettings
{ host :: HostName
, port :: PortNumber
, credentials :: Maybe (ByteString, ByteString)
} deriving (Show)
data TunnelSettings = TunnelSettings
{ proxySetting :: Maybe ProxySettings
, localBind :: HostName
, localPort :: PortNumber
, serverHost :: HostName
, serverPort :: PortNumber
, destHost :: HostName
, destPort :: PortNumber
, protocol :: Protocol
, useTls :: Bool
, useSocks :: Bool
}
instance Show TunnelSettings where
show TunnelSettings{..} = localBind <> ":" <> show localPort
<> (if isNothing proxySetting
then mempty
else " <==PROXY==> " <> host (fromJust proxySetting) <> ":" <> (show . port $ fromJust proxySetting)
)
<> " <==" <> (if useTls then "WSS" else "WS") <> "==> "
<> serverHost <> ":" <> show serverPort
<> " <==" <> show (if protocol == SOCKS5 then TCP else protocol) <> "==> " <> destHost <> ":" <> show destPort
data Connection = Connection
{ read :: IO (Maybe ByteString)
, write :: ByteString -> IO ()
, close :: IO ()
, rawConnection :: Maybe N.Socket
}
class ToConnection a where
toConnection :: a -> Connection
instance ToConnection WS.Connection where
toConnection conn = Connection { read = Just <$> WS.receiveData conn
, write = WS.sendBinaryData conn
, close = WS.sendClose conn (mempty :: LByteString)
, rawConnection = Nothing
}
instance ToConnection N.AppData where
toConnection conn = Connection { read = Just <$> N.appRead conn
, write = N.appWrite conn
, close = N.appCloseConnection conn
, rawConnection = Nothing
}
instance ToConnection UdpAppData where
toConnection conn = Connection { read = Just <$> appRead conn
, write = appWrite conn
, close = return ()
, rawConnection = Nothing
}
instance ToConnection NC.Connection where
toConnection conn = Connection { read = Just <$> NC.connectionGetChunk conn
, write = NC.connectionPut conn
, close = NC.connectionClose conn
, rawConnection = Nothing
}
data Error = ProxyConnectionError String
| ProxyForwardError String
| LocalServerError String
| TunnelError String
| WebsocketError String
| TlsError String
| Other String
deriving (Show)

2
wstunnel.cabal
View file

@ -15,7 +15,7 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Tunnel, Protocols, Utils, Socks5
exposed-modules: Tunnel, Protocols, Types, Logger, Socks5, Credentials
build-depends: async
, base
, base64-bytestring >= 1.0