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

fix linter warnings

Browse source 
Former-commit-id: ceecd6cd0b6e75f81d85901bd7ad1890e838e8eb [formerly e274544a535fa2e171063a043b2189dc4cb15268] [formerly b0649ee32ec63fa8c766878ca498d985ea04251c [formerly bd3f6d274fe0be3a8e54ad3f162dcde17e5691a4 [formerly bd3f6d274fe0be3a8e54ad3f162dcde17e5691a4 [formerly bd3f6d274fe0be3a8e54ad3f162dcde17e5691a4 [formerly 41664826ae67c0a742c71613a10af7014176cac1]]]]]
Former-commit-id: fc0f22afe3e2a3ce4caab6e509c0f6167ab1bd68 [formerly 0ef98eae2265b9afad17f19fb7e2bf8411050934]
Former-commit-id: 74eccd0fac7d327fdd391f0a2b7dc7c8ee4c71e0
Former-commit-id: 768b8e64c5cc5df505195ab0b43452073a0be2ec
Former-commit-id: 17e03e49916bcf718585aba21c58b1ee1aa2d054
Former-commit-id: d7f69f46257675857526004dca3f525189612ba0 [formerly f7c06993bd3718de1e080d73116f3dfc78ba05fd]
Former-commit-id: eaec27d94ca6e9c005298207930d6c0a16a1fb76
This commit is contained in:
Σrebe - Romain GERARD 2023-07-29 11:02:25 +02:00
parent 7b618fd37c
commit d0868f6630
4 changed files with 9 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/HttpProxy.hs
View file

@ -11,14 +11,10 @@ import ClassyPrelude
import qualified Data.ByteString.Char8 as BC
import Control.Monad.Except
import qualified Data.Conduit.Network.TLS as N
import qualified Data.Streaming.Network as N
import qualified Data.ByteString.Base64 as B64
import Network.Socket (HostName, PortNumber)
import qualified Network.Socket as N hiding (recv, recvFrom, send,
sendTo)
import qualified Network.Socket.ByteString as N
import Logger
import Types

6
src/Protocols.hs
View file

@ -6,15 +6,13 @@ module Protocols where
import ClassyPrelude
import Control.Concurrent (forkFinally, threadDelay)
import qualified Data.HashMap.Strict as H
import System.IO hiding (hSetBuffering, hGetBuffering)
import qualified Data.ByteString.Char8 as BC
import qualified Data.Streaming.Network as N
import Network.Socket (HostName, PortNumber)
import qualified Network.Socket as N hiding (recv, recvFrom, send,
sendTo)
import qualified Network.Socket as N
import qualified Network.Socket.ByteString as N
import Data.Binary (decode, encode)
@ -123,7 +121,7 @@ runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings ->
runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do
info $ "Starting socks5 proxy " <> show socksSettings
N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do
_ <- 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.RequestAuth
debug $ "Socks5 authentification request " <> show authRequest

15
src/Socks5.hs
View file

@ -12,7 +12,6 @@ import ClassyPrelude
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString as BC
import qualified Data.ByteString.Char8 as BC8
import Data.Either
import qualified Data.Text as T
@ -21,10 +20,6 @@ import qualified Data.Text.Encoding as E
import Network.Socket (HostName, PortNumber)
import Numeric (showHex)
import Control.Monad.Except (MonadError)
import qualified Data.Streaming.Network as N
socksVersion :: Word8
socksVersion = 0x05
@ -145,8 +140,8 @@ instance Binary Request where
host <- if opCode == 0x03
then do
length <- fromIntegral <$> getWord8
fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8
nbWords <- fromIntegral <$> getWord8
fromRight T.empty . E.decodeUtf8' <$> replicateM nbWords getWord8
else do
ipv4 <- replicateM 4 getWord8 :: Get [Word8]
let ipv4Str = T.intercalate "." $ fmap (tshow . fromEnum) ipv4
@ -216,13 +211,13 @@ instance Binary Response where
version <- fromIntegral <$> getWord8
guard(version == fromIntegral socksVersion)
ret <- toEnum . min maxBound . fromIntegral <$> getWord8
getWord8 -- RESERVED
_ <- getWord8 -- RESERVED
opCode <- fromIntegral <$> getWord8 -- Type
guard(opCode == 0x03 || opCode == 0x01)
host <- if opCode == 0x03
then do
length <- fromIntegral <$> getWord8
fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8
nbWords <- fromIntegral <$> getWord8
fromRight T.empty . E.decodeUtf8' <$> replicateM nbWords getWord8
else do
ipv4 <- replicateM 4 getWord8 :: Get [Word8]
let ipv4Str = T.intercalate "." $ fmap (tshow . fromEnum) ipv4

7
src/Tunnel.hs
View file

@ -17,8 +17,7 @@ import qualified Data.Conduit.Network.TLS as N
import qualified Data.Streaming.Network as N
import Network.Socket (HostName, PortNumber)
import qualified Network.Socket as N hiding (recv, recvFrom,
send, sendTo)
import qualified Network.Socket as N
import qualified Network.Socket.ByteString as N
import qualified Network.Socket.ByteString.Lazy as NL
@ -28,7 +27,6 @@ import qualified Network.WebSockets.Stream as WS
import Control.Monad.Except
import qualified Network.Connection as NC
import System.IO (IOMode (ReadWriteMode))
import qualified Data.ByteString.Base64 as B64
@ -36,7 +34,6 @@ import Types
import Protocols
import qualified Socks5
import Logger
import qualified Credentials
@ -227,7 +224,7 @@ runTunnelingServer endPoint@(host, port) isAllowed = do
serverEventLoop :: N.SockAddr -> ((ByteString, Int) -> Bool) -> WS.PendingConnection -> IO ()
serverEventLoop sClient isAllowed pendingConn = do
let path = fromPath . WS.requestPath $ WS.pendingRequest pendingConn
let forwardedFor = filter (\(header,val) -> header == "x-forwarded-for") $ WS.requestHeaders $ WS.pendingRequest pendingConn
let forwardedFor = filter (\(header, _) -> header == "x-forwarded-for") $ WS.requestHeaders $ WS.pendingRequest pendingConn
info $ "NEW incoming connection from " <> show sClient <> " " <> show forwardedFor
case path of
Nothing -> info "Rejecting connection" >> WS.rejectRequest pendingConn "Invalid tunneling information"