diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +0.1.0.26 +-------- +* enable CIDR format in `forbidden-ip` + 0.1.0.25 -------- * Add `forbidden-ip` option, which defaults to `127.0.0.1`, to prevent misuse diff --git a/moesocks.cabal b/moesocks.cabal --- a/moesocks.cabal +++ b/moesocks.cabal @@ -1,6 +1,6 @@ name: moesocks category: Network -version: 0.1.0.25 +version: 0.1.0.26 license: Apache-2.0 synopsis: A functional firewall killer description: A socks5 proxy using the client / server architecture. @@ -35,12 +35,12 @@ , containers , cryptohash , hslogger + , iproute , lens , mtl , network , optparse-applicative , random - , safe , stm , strict , text diff --git a/src/Network/MoeSocks/App.hs b/src/Network/MoeSocks/App.hs --- a/src/Network/MoeSocks/App.hs +++ b/src/Network/MoeSocks/App.hs @@ -322,7 +322,7 @@ localRun :: IO () localRun = do let _forward_TCP_Apps = do - forM_ (_options ^. forwardTCP) - \forwarding -> forkIO - do + forM_ (_options ^. forward_TCP) - \forwarding -> forkIO - do foreverRun - catchExceptAsyncLog "L TCPForwarding app" - do getSocket (_c ^. local) (forwarding ^. forwardLocalPort) @@ -330,7 +330,7 @@ >>= forward_TCP_App forwarding let _forward_UDP_Apps = do - forM_ (_options ^. forwardUDP) - \forwarding -> forkIO - do + forM_ (_options ^. forward_UDP) - \forwarding -> forkIO - do foreverRun - catchExceptAsyncLog "L UDPForwarding app" - do getSocket (_c ^. local) (forwarding ^. forwardLocalPort) @@ -345,8 +345,8 @@ _forward_UDP_Apps if (_options ^. disableSocks5) then - if (_options ^. forwardTCP & isn't _Empty) - || (_options ^. forwardUDP & isn't _Empty) + if (_options ^. forward_TCP & isn't _Empty) + || (_options ^. forward_UDP & isn't _Empty) then forever - sleep 1000 else diff --git a/src/Network/MoeSocks/BuilderAndParser.hs b/src/Network/MoeSocks/BuilderAndParser.hs --- a/src/Network/MoeSocks/BuilderAndParser.hs +++ b/src/Network/MoeSocks/BuilderAndParser.hs @@ -15,7 +15,6 @@ import Network.MoeSocks.Type import Network.Socket import Prelude hiding ((-), take) -import Safe (readMay) import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B import qualified Prelude as P @@ -70,7 +69,7 @@ in ( Domain_name - (_host & review _Text) - , fromMaybe 0 - readMay _port + , fromMaybe 0 - _port ^? _Show ) x -> diff --git a/src/Network/MoeSocks/Common.hs b/src/Network/MoeSocks/Common.hs --- a/src/Network/MoeSocks/Common.hs +++ b/src/Network/MoeSocks/Common.hs @@ -4,6 +4,8 @@ import Control.Lens import Control.Monad.Writer hiding (listen) +import Data.IP +import Data.Maybe import Data.Text (Text) import Data.Text.Lens import Network.MoeSocks.Helper @@ -12,16 +14,39 @@ import Prelude hiding ((-), take) import qualified Data.List as L - showAddressType :: AddressType -> Text -showAddressType (IPv4_address xs) = view (from _Text) - - concat - L.intersperse "." - - map show - xs ^.. each +showAddressType (IPv4_address xs) = xs ^.. each . to show + ^.. folding (concat . L.intersperse ".") + ^. from _Text + showAddressType (Domain_name x) = x -showAddressType (IPv6_address xs) = view (from _Text) - - concat - L.intersperse ":" - - map show - xs ^.. each +showAddressType (IPv6_address xs) = xs ^.. each . to show + ^.. folding (concat . L.intersperse ":") + ^. from _Text +checkForbidden_IP_List :: AddressType -> [IPRange] -> Bool +checkForbidden_IP_List _address@(IPv4_address _) aForbidden_IP_List = + isJust - + do + _ip <- showAddressType _address ^. _Text ^? _Show + findOf (each . _IPv4Range) (isMatchedTo _ip) aForbidden_IP_List + +checkForbidden_IP_List _address@(IPv6_address _) aForbidden_IP_List = + isJust - + do + _ip <- showAddressType _address ^. _Text ^? _Show + findOf (each . _IPv6Range) (isMatchedTo _ip) - aForbidden_IP_List + +checkForbidden_IP_List _ _ = False + +withCheckedForbidden_IP_List :: AddressType -> [IPRange] -> IO a -> IO () +withCheckedForbidden_IP_List aAddressType aForbidden_IP_List aIO = + if checkForbidden_IP_List aAddressType aForbidden_IP_List + then pute - showAddressType aAddressType ^. _Text + <> " is in forbidden-ip list" + else () <$ aIO + + showConnectionType :: ConnectionType -> String showConnectionType TCP_IP_stream_connection = "TCP_Stream" showConnectionType TCP_IP_port_binding = "TCP_Bind " @@ -29,30 +54,27 @@ showRequest :: ClientRequest -> String showRequest _r = - view _Text (showAddressType (_r ^. addressType)) + _r ^. addressType . to showAddressType . _Text <> ":" - <> show (_r ^. portNumber) + <> _r ^. portNumber . to show addressType_To_Family :: AddressType -> Maybe Family addressType_To_Family (IPv4_address _) = Just AF_INET addressType_To_Family (IPv6_address _) = Just AF_INET6 addressType_To_Family _ = Nothing +connectionType_To_SocketType :: ConnectionType -> SocketType +connectionType_To_SocketType TCP_IP_stream_connection = Stream +connectionType_To_SocketType TCP_IP_port_binding = NoSocketType +connectionType_To_SocketType UDP_port = Datagram + initTarget :: ClientRequest -> IO (Socket, SockAddr) initTarget _clientRequest = do - let - connectionType_To_SocketType :: ConnectionType -> SocketType - connectionType_To_SocketType TCP_IP_stream_connection = Stream - connectionType_To_SocketType TCP_IP_port_binding = NoSocketType - connectionType_To_SocketType UDP_port = Datagram - - _socketType = connectionType_To_SocketType - - _clientRequest ^. connectionType - - - _hostName = _clientRequest ^. addressType . to showAddressType - _port = _clientRequest ^. portNumber - _family = _clientRequest ^. addressType . to addressType_To_Family - + let + _socketType = _clientRequest ^. + connectionType . to connectionType_To_SocketType + _hostName = _clientRequest ^. addressType . to showAddressType + _port = _clientRequest ^. portNumber + _family = _clientRequest ^. addressType . to addressType_To_Family getSocketWithHint _family _hostName _port _socketType diff --git a/src/Network/MoeSocks/Config.hs b/src/Network/MoeSocks/Config.hs --- a/src/Network/MoeSocks/Config.hs +++ b/src/Network/MoeSocks/Config.hs @@ -28,10 +28,10 @@ _runningMode = DebugMode , _configFile = Nothing , _verbosity = DEBUG - , _forwardTCP = [] - , _forwardUDP = [] + , _forward_TCP = [] + , _forward_UDP = [] , _disableSocks5 = False , _obfuscation = False - , _forbidden_IP = ["127.0.0.1"] + , _forbidden_IP = ["127.0.0.1", "::1"] , _params = [] } diff --git a/src/Network/MoeSocks/Helper.hs b/src/Network/MoeSocks/Helper.hs --- a/src/Network/MoeSocks/Helper.hs +++ b/src/Network/MoeSocks/Helper.hs @@ -14,6 +14,7 @@ import Data.Binary import Data.Binary.Put import Data.ByteString (ByteString) +import Data.IP import Data.Maybe import Data.Monoid import Data.Text (Text) @@ -180,10 +181,6 @@ puts - "All done for " <> _hID pure () -{-connectTunnel :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO ()-} -{--- connectTunnel x y = finally (waitBothDebug x y) performGC-} -{-connectTunnel = waitBothDebug-} - connectTunnel :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO () connectTunnel x y = let _prolong _io = _io >> sleep 10 @@ -233,7 +230,8 @@ where _family = maybeFamily & fromMaybe AF_INET - hints = defaultHints { + hints = defaultHints + { addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV] , addrSocketType = aSocketType , addrFamily = _family @@ -242,11 +240,6 @@ builder_To_ByteString :: B.Builder -> ByteString builder_To_ByteString = LB.toStrict . B.toLazyByteString - - -fromWord8 :: forall t. Binary t => [Word8] -> t -fromWord8 = decode . runPut . mapM_ put - portPairToInt :: (Word8, Word8) -> Int portPairToInt = fromIntegral . portPairToWord16 where @@ -296,13 +289,24 @@ data ParseException = ParseException String instance Show ParseException where - show (ParseException s) = "Parse exception: " ++ s + show (ParseException s) = "Parse exception: " <> s instance Exception ParseException +type Timeout = Int + +timeoutFor :: String -> Timeout -> IO a -> IO a +timeoutFor aID aTimeout aIO = do + timeout aTimeout aIO >>= \case + Nothing -> throw - TimeoutException aID + Just _r -> pure _r + parseSocket :: String -> ByteString -> HCipher -> Parser a -> Socket -> IO (ByteString, a) -parseSocket aID _partial _decrypt aParser = parseSocketWith aID - parse aParser +parseSocket aID _partial _decrypt aParser aSocket = do + let _timeout = 5 * 1000 * 1000 -- 5 secs + timeoutFor aID _timeout - parseSocketWith aID (parse aParser) aSocket + where parseSocketWith :: String -> (ByteString -> Result a) -> Socket -> IO (ByteString, a) @@ -317,14 +321,7 @@ "Failed to parse " <> _id <> ": " <> msg Partial _p -> parseSocketWith _id _p _socket -type Timeout = Int -timeoutFor :: String -> Timeout -> IO a -> IO a -timeoutFor aID aTimeout aIO = do - timeout aTimeout aIO >>= \case - Nothing -> throw - TimeoutException aID - Just _r -> pure _r - -- throttle speed in kilobytes per second produceLoop :: String -> Timeout -> Maybe Double -> Socket -> HQueue -> @@ -334,7 +331,6 @@ let _shutdown = do tryIO aID - shutdown aSocket ShutdownReceive - {-tryIO aID - close aSocket-} _produce :: Int -> IO () _produce _bytesReceived = flip onException (f S.Nothing) - do @@ -384,7 +380,6 @@ let _shutdown = do tryIO aID - shutdown aSocket ShutdownSend - {-tryIO aID - close aSocket-} _consume :: Int -> IO () _consume _allBytesSent = do @@ -433,9 +428,23 @@ -- https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs setSocketCloseOnExec :: Socket -> IO () setSocketCloseOnExec aSocket = - setFdOption (fromIntegral $ fdSocket aSocket) CloseOnExec True + setFdOption (fromIntegral - fdSocket aSocket) CloseOnExec True tryIO :: String -> IO a -> IO (Either IOException a) tryIO _ = try -- . logException aID +maybeIPv4Range :: IPRange -> Maybe (AddrRange IPv4) +maybeIPv4Range (IPv4Range x) = Just x +maybeIPv4Range _ = Nothing + +maybeIPv6Range :: IPRange -> Maybe (AddrRange IPv6) +maybeIPv6Range (IPv6Range x) = Just x +maybeIPv6Range _ = Nothing + +_IPv4Range :: Prism' IPRange (AddrRange IPv4) +_IPv4Range = prism' IPv4Range maybeIPv4Range + +_IPv6Range :: Prism' IPRange (AddrRange IPv6) +_IPv6Range = prism' IPv6Range maybeIPv6Range + diff --git a/src/Network/MoeSocks/Options.hs b/src/Network/MoeSocks/Options.hs --- a/src/Network/MoeSocks/Options.hs +++ b/src/Network/MoeSocks/Options.hs @@ -3,17 +3,18 @@ module Network.MoeSocks.Options where import Control.Lens -import Data.Text.Lens import Data.Aeson +import Data.IP import Data.Maybe import Data.Text (Text) -import qualified Data.Text as T +import Data.Text.Lens +import Network.MoeSocks.Config import Network.MoeSocks.Helper import Network.MoeSocks.Type -import Network.MoeSocks.Config import Options.Applicative hiding (Parser) import Prelude hiding ((-), takeWhile) import System.Log.Logger +import qualified Data.Text as T import qualified Options.Applicative as O import Data.Attoparsec.Text (Parser, takeWhile, char, decimal, skipSpace, parseOnly, many', choice) @@ -193,14 +194,23 @@ _forbidden_IP = optional - textOption - long "forbidden-ip" <> metavar "IPLIST" - <> help ("" + <> defaultHelp (defaultMoeOptions ^. forbidden_IP + & map show + & map (view - from _Text) + & T.intercalate ", ") + ("" <> "comma seperated IP list forbidden to " <> "connect" ) - parseForbidden_IP :: Maybe Text -> [Text] - parseForbidden_IP = maybe (defaultMoeOptions ^. forbidden_IP) - (map T.strip . T.splitOn ",") + parseForbidden_IP :: Maybe Text -> [IPRange] + parseForbidden_IP = maybe (defaultMoeOptions ^. forbidden_IP) - + (toListOf - each + . to T.strip + . _Text + . _Show + ) . T.splitOn "," + tag :: a -> O.Parser (Maybe b) -> O.Parser (Maybe (a, b)) tag x = fmap . fmap - ((,) x) diff --git a/src/Network/MoeSocks/TCP.hs b/src/Network/MoeSocks/TCP.hs --- a/src/Network/MoeSocks/TCP.hs +++ b/src/Network/MoeSocks/TCP.hs @@ -50,8 +50,7 @@ -> ByteString -> (Socket, SockAddr) -> IO () -local_TCP_ForwardRequestHandler aEnv aForwarding _ (aSocket,_) = - do +local_TCP_ForwardRequestHandler aEnv aForwarding _ (aSocket,_) = do let _clientRequest = ClientRequest TCP_IP_stream_connection (Domain_name - aForwarding ^. @@ -100,7 +99,7 @@ _log - "L T: " <> _msg let handleLocal _remoteSocket = do - _encodeIV <- _cipherBox ^. generateIV + _encodeIV <- _cipherBox ^. generate_IV _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV let @@ -184,11 +183,11 @@ remote_TCP_RequestHandler :: Env -> Socket -> IO () remote_TCP_RequestHandler aEnv aSocket = do let - _obfuscation = aEnv ^. options . obfuscation - _cipherBox = aEnv ^. cipherBox - _c = aEnv ^. config - _options = aEnv ^. options - _flushBound = _c ^. obfuscationFlushBound + _obfuscation = aEnv ^. options . obfuscation + _cipherBox = aEnv ^. cipherBox + _c = aEnv ^. config + _options = aEnv ^. options + _flushBound = _c ^. obfuscationFlushBound _decodeIV <- recv aSocket (_cipherBox ^. ivLength) _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV @@ -200,18 +199,14 @@ (shadowSocksRequestParser TCP_IP_stream_connection) aSocket - - - {-puts - "Remote get: " <> show _clientRequest-} - - let _requestAddr = showAddressType - _clientRequest ^. addressType - if (_requestAddr `elem` (_options ^. forbidden_IP)) - then pute - show _requestAddr <> " is in forbidden-ip list" - else - logSA "R target socket" (initTarget _clientRequest) - \_r -> do - let (_targetSocket, _targetSocketAddress) = _r + logSA "R target socket" (initTarget _clientRequest) - \_r -> do + let (_targetSocket, _targetSocketAddress) = _r + (_addr, _) = sockAddr_To_Pair _targetSocketAddress + _forbidden_IP = _options ^. forbidden_IP + puts - "checking: " <> show _addr <> " ? " <> show _forbidden_IP + withCheckedForbidden_IP_List _addr _forbidden_IP - do connect _targetSocket _targetSocketAddress _remotePeerAddr <- getPeerName aSocket @@ -265,7 +260,7 @@ pure () let receiveThread = do - _encodeIV <- _cipherBox ^. generateIV + _encodeIV <- _cipherBox ^. generate_IV _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV sendBytes _receiveChannel _encodeIV diff --git a/src/Network/MoeSocks/Type.hs b/src/Network/MoeSocks/Type.hs --- a/src/Network/MoeSocks/Type.hs +++ b/src/Network/MoeSocks/Type.hs @@ -9,6 +9,7 @@ import Data.Aeson import Data.ByteString (ByteString) import Data.Text (Text) +import Data.IP import Data.Word import GHC.Generics import System.Log.Logger @@ -90,11 +91,11 @@ _runningMode :: RunningMode , _configFile :: Maybe Text , _verbosity :: Priority - , _forwardTCP :: [Forward] - , _forwardUDP :: [Forward] + , _forward_TCP :: [Forward] + , _forward_UDP :: [Forward] , _disableSocks5 :: Bool , _obfuscation :: Bool - , _forbidden_IP :: [Text] + , _forbidden_IP :: [IPRange] , _params :: [(Text, Value)] } deriving (Show, Eq) @@ -108,7 +109,7 @@ data CipherBox = CipherBox { _ivLength :: Int - , _generateIV :: IO IV + , _generate_IV :: IO IV , _encryptBuilder :: CipherBuilder , _decryptBuilder :: CipherBuilder } diff --git a/src/Network/MoeSocks/UDP.hs b/src/Network/MoeSocks/UDP.hs --- a/src/Network/MoeSocks/UDP.hs +++ b/src/Network/MoeSocks/UDP.hs @@ -8,7 +8,6 @@ import Control.Monad.Writer hiding (listen) import Data.Attoparsec.ByteString import Data.ByteString (ByteString) -import qualified Data.ByteString as S import Network.MoeSocks.BuilderAndParser import Network.MoeSocks.Common import Network.MoeSocks.Helper @@ -16,6 +15,7 @@ import Network.Socket hiding (send, recv, recvFrom, sendTo) import Network.Socket.ByteString import Prelude hiding ((-), take) +import qualified Data.ByteString as S import qualified Data.Strict as S @@ -42,8 +42,10 @@ -> ByteString -> (Socket,SockAddr) -> IO () -local_UDP_ForwardRequestHandler aEnv aForwarding aMessage - (aSocket, aSockAddr) = do +local_UDP_ForwardRequestHandler aEnv + aForwarding + aMessage + (aSocket, aSockAddr) = do let _c = aEnv ^. config _cipherBox = _cipherBox @@ -62,7 +64,7 @@ \(_remoteSocket, _remoteAddr) -> do connect _remoteSocket _remoteAddr - _encodeIV <- _cipherBox ^. generateIV + _encodeIV <- _cipherBox ^. generate_IV _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV {-let (_encrypt, _decrypt) = (pure, pure)-} @@ -95,7 +97,9 @@ -> ByteString -> (Socket, SockAddr) -> IO () -remote_UDP_RequestHandler aEnv aMessage (aSocket, aSockAddr) = do +remote_UDP_RequestHandler aEnv + aMessage + (aSocket, aSockAddr) = do let _cipherBox = aEnv ^. cipherBox _options = aEnv ^. options @@ -110,28 +114,28 @@ {-puts - "R UDP: " <> show _clientRequest-} {-puts - "R UDP: " <> show _decryptedMessage-} - let _requestAddr = showAddressType - _clientRequest ^. addressType - if (_requestAddr `elem` (_options ^. forbidden_IP)) - then pute - show _requestAddr <> " is in forbidden-ip list" - else - logSA "R UDP -->:" (initTarget _clientRequest) - \_r -> do - let (_clientSocket, _clientAddr) = _r + logSA "R UDP -->:" (initTarget _clientRequest) - \_r -> do + {-puts - "R UDP targetSocket: " <> show _r-} + + let (_targetSocket, _targetSocketAddress) = _r + (_addr, _) = sockAddr_To_Pair _targetSocketAddress + _forbidden_IP = _options ^. forbidden_IP - {-puts - "R UDP clientSocket: " <> show _r-} - + puts - "checking: " <> show _addr <> " ? " <> show _forbidden_IP + withCheckedForbidden_IP_List _addr _forbidden_IP - do let _msg = show aSockAddr <> " -> " <> showRequest _clientRequest _log - "R U: " <> _msg - connect _clientSocket _clientAddr + connect _targetSocket _targetSocketAddress - send_ _clientSocket _decryptedMessage + send_ _targetSocket _decryptedMessage - _r <- buildShadowSocksRequest _clientRequest <$> recv_ _clientSocket + _r <- buildShadowSocksRequest _clientRequest <$> recv_ _targetSocket {-puts - "R UDP <--: " <> show _r-} when (_r & isn't _Empty) - do - _encodeIV <- _cipherBox ^. generateIV + _encodeIV <- _cipherBox ^. generate_IV _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV _encryptedMessage <- processAll _encrypt _r