moesocks 0.1.0.25 → 0.1.0.26
raw patch · 11 files changed
+147/−103 lines, 11 filesdep +iproutedep −safe
Dependencies added: iproute
Dependencies removed: safe
Files
- CHANGELOG.md +4/−0
- moesocks.cabal +2/−2
- src/Network/MoeSocks/App.hs +4/−4
- src/Network/MoeSocks/BuilderAndParser.hs +1/−2
- src/Network/MoeSocks/Common.hs +45/−23
- src/Network/MoeSocks/Config.hs +3/−3
- src/Network/MoeSocks/Helper.hs +31/−22
- src/Network/MoeSocks/Options.hs +17/−7
- src/Network/MoeSocks/TCP.hs +14/−19
- src/Network/MoeSocks/Type.hs +5/−4
- src/Network/MoeSocks/UDP.hs +21/−17
CHANGELOG.md view
@@ -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
moesocks.cabal view
@@ -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
src/Network/MoeSocks/App.hs view
@@ -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
src/Network/MoeSocks/BuilderAndParser.hs view
@@ -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 ->
src/Network/MoeSocks/Common.hs view
@@ -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
src/Network/MoeSocks/Config.hs view
@@ -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 = [] }
src/Network/MoeSocks/Helper.hs view
@@ -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+
src/Network/MoeSocks/Options.hs view
@@ -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)
src/Network/MoeSocks/TCP.hs view
@@ -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
src/Network/MoeSocks/Type.hs view
@@ -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 }
src/Network/MoeSocks/UDP.hs view
@@ -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