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

Maj restricted option

Browse source
This commit is contained in:
Erèbe 2016-05-16 23:55:06 +02:00
parent b40e0e677c
commit 0340dc49f1
2 changed files with 12 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
app/Main.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_GHC -fno-cse #-}
@ -5,7 +6,7 @@ module Main where
import Lib import Lib
import ClassyPrelude (guard, readMay) import ClassyPrelude (ByteString, guard, readMay)
import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.Console.CmdArgs import System.Console.CmdArgs
@ -78,16 +79,16 @@ parseTunnelInfo str = mk $ BC.unpack <$> BC.split ':' (BC.pack str)
mk _ = error $ "Invalid tunneling information `" ++ str ++ "`, please use format [BIND:]PORT:HOST:PORT" mk _ = error $ "Invalid tunneling information `" ++ str ++ "`, please use format [BIND:]PORT:HOST:PORT"
parseRestrictTo :: String -> ((String, Int)-> Bool) parseRestrictTo :: String -> ((ByteString, Int)-> Bool)
parseRestrictTo "" = const True parseRestrictTo "" = const True
parseRestrictTo str = let (h, p) = fromMaybe (error "Invalid Parameter restart") parse parseRestrictTo str = let (!h, !p) = fromMaybe (error "Invalid Parameter restart") parse
in (\(hst, port) -> hst == h && port == p) in (\(!hst, !port) -> hst == h && port == p)
where where
parse = do parse = do
let ret = BC.unpack <$> BC.split ':' (BC.pack str) let ret = BC.unpack <$> BC.split ':' (BC.pack str)
guard (length ret == 2) guard (length ret == 2)
portNumber <- readMay $ ret !! 1 :: Maybe Int portNumber <- readMay $ ret !! 1 :: Maybe Int
return (head ret, portNumber) return (BC.pack (head ret), portNumber)
main :: IO () main :: IO ()
main = do main = do

12
src/Lib.hs
View file

@ -136,14 +136,15 @@ runTunnelingServer (host, port) isAllowed = do
case path of case path of
Nothing -> putStrLn "Rejecting connection" >> WS.rejectRequest pendingConn "Invalid tunneling information" Nothing -> putStrLn "Rejecting connection" >> WS.rejectRequest pendingConn "Invalid tunneling information"
Just (!proto, !rhost, !rport) -> Just (!proto, !rhost, !rport) ->
if isAllowed (rhost, rport) if not $ isAllowed (rhost, rport)
then do then do
putStrLn "Rejecting tunneling"
WS.rejectRequest pendingConn "Restriction is on, You cannot request this tunneling"
else do
conn <- WS.acceptRequest pendingConn conn <- WS.acceptRequest pendingConn
case proto of case proto of
UDP -> runUDPClient (BC.unpack rhost, fromIntegral rport) (propagateRW conn) UDP -> runUDPClient (BC.unpack rhost, fromIntegral rport) (propagateRW conn)
TCP -> runTCPClient (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" putStrLn "CLOSE server"
@ -180,9 +181,8 @@ runClient useTls proto local wsServer remote = do
TCP -> runTCPServer local (\hOther -> out (`propagateRW` hOther)) TCP -> runTCPServer local (\hOther -> out (`propagateRW` hOther))
runServer :: (HostName, PortNumber) -> ((String, Int) -> Bool) -> IO () runServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()
runServer wsInfo isAllowed = let isAllowed' (str, port) = isAllowed (BC.unpack str, fromIntegral port) runServer = runTunnelingServer
in runTunnelingServer wsInfo isAllowed'
runTlsTunnelingClient :: Proto -> (HostName, PortNumber) -> (HostName, PortNumber) -> (WS.Connection -> IO ()) -> IO () runTlsTunnelingClient :: Proto -> (HostName, PortNumber) -> (HostName, PortNumber) -> (WS.Connection -> IO ()) -> IO ()