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

lint

Browse source 
Former-commit-id: c28e4cf38fd7e8b55d6453cc7ada8eef3cb722a8
Former-commit-id: 0e8573342851be0e0812a9d92548d65e1d234fdf [formerly 0ec3417203a97ffba77fad8074234e0009bbd578] [formerly 354294f60f429b260e49e3cd647d36b0aa360cf2 [formerly 01a7d505fdc8d95fe4f2bd591f91863a2d94f82d [formerly 01a7d505fdc8d95fe4f2bd591f91863a2d94f82d [formerly 01a7d505fdc8d95fe4f2bd591f91863a2d94f82d [formerly 2b55b3e5cefc3c9c908a54600772774d92aea898]]]]]
Former-commit-id: 2fd3f1de8cdd14032219415083519e8f5b49283f [formerly 85e94bf33bd4caa21f9db9bf0d4013f1218b94c3]
Former-commit-id: 86e9b904cd8018f72094e3da79d05d072cee9d9a
Former-commit-id: 4601d50c8322c295bc91572481a13d15c4d3d4f7
Former-commit-id: eea6001db6f78629d3b22b094c02f1aad0f7e754
Former-commit-id: 68980f8021f05d20bcb61de43d008e9fae3ad611 [formerly 77587a0a95a23f76bd395ddd6078f85114e1c606]
Former-commit-id: f80fc49e44f9cfe329f76d4f02e7742e8fa41f9b
This commit is contained in:
Σrebe - Romain GERARD 2022-10-29 19:42:49 +02:00
parent f5dbfd7cfa
commit 001619f7b1
3 changed files with 10 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/HttpProxy.hs
View file

@ -58,7 +58,7 @@ httpProxyConnection HttpProxySettings{..} (host, port) app = onError $ do
sendConnectRequest :: Connection -> IO ()
sendConnectRequest h = write h $ "CONNECT " <> fromString host <> ":" <> fromString (show port) <> " HTTP/1.0\r\n"
<> "Host: " <> fromString host <> ":" <> (fromString $ show port) <> "\r\n"
<> "Host: " <> fromString host <> ":" <> fromString (show port) <> "\r\n"
<> maybe mempty credentialsToHeader credentials
<> "\r\n"
@ -75,6 +75,6 @@ httpProxyConnection HttpProxySettings{..} (host, port) app = onError $ do
isAuthorized response = " 200 " `isInfixOf` response
onError f = catch f $ \(e :: SomeException) -> return $
if (take 10 (show e) == "user error")
if take 10 (show e) == "user error"
then throwError $ ProxyConnectionError (show e)
else throwError $ ProxyConnectionError ("Unknown Error :: " <> show e)

18
src/Socks5.hs
View file

@ -1,4 +1,3 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
@ -73,7 +72,7 @@ instance Binary RequestAuth where
put RequestAuth{..} = do
putWord8 (fromIntegral version)
putWord8 (fromIntegral $ length methods)
sequence_ (put <$> methods)
mapM_ put methods
-- Check length <= 255
get = do
@ -134,8 +133,7 @@ instance Binary Request where
host <- if opCode == 0x03
then do
length <- fromIntegral <$> getWord8
host <- either (const T.empty) id . E.decodeUtf8' <$> replicateM length getWord8
return host
fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8
else do
ipv4 <- replicateM 4 getWord8 :: Get [Word8]
let ipv4Str = T.intercalate "." $ fmap (tshow . fromEnum) ipv4
@ -200,7 +198,7 @@ instance Binary Response where
opCode <- fromIntegral <$> getWord8 -- Type
guard(opCode == 0x03)
length <- fromIntegral <$> getWord8
host <- either (const T.empty) id . E.decodeUtf8' <$> replicateM length getWord8
host <- fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8
guard (not $ null host)
port <- getWord16be
@ -219,12 +217,4 @@ data ServerSettings = ServerSettings
, bindOn :: HostName
-- , onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth
-- , onRequest :: (MonadIO m, MonadError IOException m) => Request -> m Response
} deriving (Show)
--
} deriving (Show)

6
src/Tunnel.hs
View file

@ -64,9 +64,9 @@ tunnelingClientP cfg@TunnelSettings{..} app conn = onError $ do
debug "Opening Websocket stream"
stream <- connectionToStream conn
let authorization = if not (null upgradeCredentials) then [("Authorization", "Basic " <> B64.encode upgradeCredentials)] else []
let authorization = ([("Authorization", "Basic " <> B64.encode upgradeCredentials) | not (null upgradeCredentials)])
let headers = authorization <> customHeaders
let hostname = if not (null hostHeader) then (BC.unpack hostHeader) else serverHost
let hostname = if not (null hostHeader) then BC.unpack hostHeader else serverHost
ret <- WS.runClientWithStream stream hostname (toPath cfg) WS.defaultConnectionOptions headers run
@ -240,6 +240,8 @@ serverEventLoop sClient isAllowed pendingConn = do
case proto of
UDP -> runUDPClient (BC.unpack rhost, fromIntegral rport) (\cnx -> void $ toConnection conn <==> toConnection cnx)
TCP -> runTCPClient (BC.unpack rhost, fromIntegral rport) (\cnx -> void $ toConnection conn <==> toConnection cnx)
STDIO -> mempty
SOCKS5 -> mempty
runServer :: Bool -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()