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

Use conduit instead of raw tls package

Browse source
This commit is contained in:
Erèbe 2016-05-21 18:05:51 +02:00
parent d993e11730
commit 6ec0a45900
2 changed files with 12 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
src/Lib.hs
View file

@ -31,12 +31,7 @@ import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Connection as WS import qualified Network.WebSockets.Connection as WS
import qualified Network.WebSockets.Stream as WS import qualified Network.WebSockets.Stream as WS
import Network.Connection (Connection, import Network.Connection (settingDisableCertificateValidation)
ConnectionParams (..),
TLSSettings (..), connectTo,
connectionGetChunk,
connectionPut,
initConnectionContext)
instance Hashable N.SockAddr where instance Hashable N.SockAddr where
@ -215,34 +210,18 @@ runServer useTLS = if useTLS then runTlsTunnelingServer else runTunnelingServer
runTlsTunnelingClient :: Proto -> (HostName, PortNumber) -> (HostName, PortNumber) -> (WS.Connection -> IO ()) -> IO () runTlsTunnelingClient :: Proto -> (HostName, PortNumber) -> (HostName, PortNumber) -> (WS.Connection -> IO ()) -> IO ()
runTlsTunnelingClient proto (wsHost, wsPort) (remoteHost, remotePort) app = do runTlsTunnelingClient proto (wsHost, wsPort) (remoteHost, remotePort) app = do
putStrLn $ "OPEN tls connection to " <> tshow remoteHost <> ":" <> tshow remotePort putStrLn $ "OPEN tls connection to " <> tshow remoteHost <> ":" <> tshow remotePort
context <- initConnectionContext let tlsCfg = N.tlsClientConfig (fromIntegral wsPort) (BC.pack wsHost)
connection <- connectTo context (connectionParams wsHost (fromIntegral wsPort)) let tlsSettings = (N.tlsClientTLSSettings tlsCfg) { settingDisableCertificateValidation = True }
stream <- WS.makeStream (reader connection) (writer connection) N.runTLSClient (tlsCfg { N.tlsClientTLSSettings = tlsSettings } )$ \appData ->
WS.runClientWithStream stream wsHost (toPath proto remoteHost remotePort) WS.defaultConnectionOptions [] app runApp appData app
putStrLn $ "CLOSE tls connection to " <> tshow remoteHost <> ":" <> tshow remotePort putStrLn $ "CLOSE tls connection to " <> tshow remoteHost <> ":" <> tshow remotePort
where
connectionParams :: HostName -> PortNumber -> ConnectionParams runApp :: N.AppData -> (WS.Connection -> IO ()) -> IO ()
connectionParams host port = ConnectionParams runApp appData app = do
{ connectionHostname = host stream <- WS.makeStream (Just <$> N.appRead appData) (N.appWrite appData . toStrict . fromJust)
, connectionPort = port WS.runClientWithStream stream wsHost (toPath proto remoteHost remotePort) WS.defaultConnectionOptions [] app
, connectionUseSecure = Just tlsSettings
, connectionUseSocks = Nothing
}
tlsSettings :: TLSSettings
tlsSettings = TLSSettingsSimple
{ settingDisableCertificateValidation = True
, settingDisableSession = False
, settingUseServerName = False
}
reader :: Connection -> IO (Maybe ByteString)
reader connection = fmap Just (connectionGetChunk connection)
writer :: Connection -> Maybe LByteString -> IO ()
writer connection = maybe (return ()) (connectionPut connection . toStrict)
toPath :: Proto -> HostName -> PortNumber -> String toPath :: Proto -> HostName -> PortNumber -> String
toPath proto remoteHost remotePort = "/" <> toLower (show proto) <> "/" <> remoteHost <> "/" <> show remotePort toPath proto remoteHost remotePort = "/" <> toLower (show proto) <> "/" <> remoteHost <> "/" <> show remotePort

2
wstunnel.cabal
View file

@ -23,9 +23,9 @@ library
, unordered-containers , unordered-containers
, network , network
, streaming-commons , streaming-commons
, connection
, websockets , websockets
, network-conduit-tls , network-conduit-tls
, connection
default-language: Haskell2010 default-language: Haskell2010