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

Add restric to for the server

Browse source
This commit is contained in:
Erèbe 2016-05-16 23:33:00 +02:00
parent 58a313f354
commit b40e0e677c
2 changed files with 29 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/Lib.hs
View file

@ -128,18 +128,22 @@ runTunnelingClient proto (wsHost, wsPort) (remoteHost, remotePort) app = do
putStrLn $ "CLOSE connection to " <> tshow remoteHost <> ":" <> tshow remotePort
runTunnelingServer :: (HostName, PortNumber) -> IO ()
runTunnelingServer (host, port) = do
runTunnelingServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()
runTunnelingServer (host, port) isAllowed = do
putStrLn $ "WAIT for connection on " <> tshow host <> ":" <> tshow port
WS.runServer host (fromIntegral port) $ \pendingConn -> do
let path = parsePath . WS.requestPath $ WS.pendingRequest pendingConn
let path = parsePath . WS.requestPath $ WS.pendingRequest pendingConn
case path of
Nothing -> putStrLn "Rejecting connection" >> WS.rejectRequest pendingConn "Invalid tunneling information"
Just (!proto, !rhost, !rport) -> do
conn <- WS.acceptRequest pendingConn
case proto of
UDP -> runUDPClient (BC.unpack rhost, fromIntegral rport) (propagateRW conn)
TCP -> runTCPClient (BC.unpack rhost, fromIntegral rport) (propagateRW conn)
Just (!proto, !rhost, !rport) ->
if isAllowed (rhost, rport)
then do
conn <- WS.acceptRequest pendingConn
case proto of
UDP -> runUDPClient (BC.unpack rhost, fromIntegral rport) (propagateRW conn)
TCP -> runTCPClient (BC.unpack rhost, fromIntegral rport) (propagateRW conn)
else
putStrLn "Rejecting tunneling" >> WS.rejectRequest pendingConn "Restriction is on, You cannot request this tunneling"
putStrLn "CLOSE server"
@ -176,8 +180,9 @@ runClient useTls proto local wsServer remote = do
TCP -> runTCPServer local (\hOther -> out (`propagateRW` hOther))
runServer :: (HostName, PortNumber) -> IO ()
runServer = runTunnelingServer
runServer :: (HostName, PortNumber) -> ((String, Int) -> Bool) -> IO ()
runServer wsInfo isAllowed = let isAllowed' (str, port) = isAllowed (BC.unpack str, fromIntegral port)
in runTunnelingServer wsInfo isAllowed'
runTlsTunnelingClient :: Proto -> (HostName, PortNumber) -> (HostName, PortNumber) -> (WS.Connection -> IO ()) -> IO ()