diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/config.json b/config.json new file mode 100644 --- /dev/null +++ b/config.json @@ -0,0 +1,8 @@ +{ + "remote":"127.0.0.1", + "remotePort":1190, + "local":"127.0.0.1", + "localPort":1090, + "password":"birthday!" +} + diff --git a/moesocks.cabal b/moesocks.cabal new file mode 100644 --- /dev/null +++ b/moesocks.cabal @@ -0,0 +1,53 @@ +-- Initial moesocks.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: moesocks +category: Network +version: 0.1.0.0 +license: Apache-2.0 +synopsis: moe for all +description: A socks5 proxy server +homepage: https://github.com/nfjinjing/moesocks +license-file: LICENSE +author: Jinjing Wang +maintainer: Jinjing Wang +build-type: Simple +cabal-version: >=1.10 +copyright: Copyright (C) 2015 Jinjing Wang +tested-with: GHC == 7.10.1 + +extra-source-files: config.json + +source-repository head + type: git + location: git://github.com/nfjinjing/moesocks.git + +executable moesocks + main-is: Main.hs + ghc-options: -Wall -fno-warn-unused-do-bind + build-depends: base > 4 && <= 5 + , lens + , network + , io-streams + , binary + , bytestring + , unix + , attoparsec + , text + , random + , cipher-aes + , optparse-applicative + , aeson + , unordered-containers + , transformers + + hs-source-dirs: src + default-language: Haskell2010 + other-modules: + Network.MoeSocks.App + Network.MoeSocks.Config + Network.MoeSocks.Helper + Network.MoeSocks.Type + Network.MoeSocks.BuilderAndParser + Network.MoeSocks.Constant + Network.MoeSocks.OptionParser diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} + +module Main where + +import Network.MoeSocks.App +import Network.MoeSocks.OptionParser +import Options.Applicative hiding (Parser) + +main :: IO () +main = execParser opts >>= moeApp + diff --git a/src/Network/MoeSocks/App.hs b/src/Network/MoeSocks/App.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/App.hs @@ -0,0 +1,383 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE DeriveGeneric #-} + +module Network.MoeSocks.App where + +import "cipher-aes" Crypto.Cipher.AES +import Control.Concurrent +import Control.Exception +import Control.Lens +import Control.Monad +import Data.Aeson +import Data.Attoparsec.ByteString +import Data.Monoid +import Data.Text (Text) +import Data.Text.Lens +import Data.Word +import Network.MoeSocks.BuilderAndParser +import Network.MoeSocks.Config +import Network.MoeSocks.Constant +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import Network.Socket +import Prelude hiding ((-), take) +import System.IO.Streams.Attoparsec +import System.IO.Streams.ByteString +import System.IO.Streams.Network +import System.Random +import qualified Data.ByteString as S +import qualified Data.ByteString.Builder as B +import qualified Data.HashMap.Strict as H +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified Data.Text.Strict.Lens as TS +import qualified Prelude as P +import qualified System.IO.Streams as Stream + +addressType_To_SockAddr :: ClientRequest -> SockAddr +addressType_To_SockAddr aClientRequest = + let portNumber16 = fromWord8 - toListOf both + (aClientRequest ^. portNumber) :: Word16 + in + case aClientRequest ^. addressType of + IPv4_address _address -> SockAddrInet + (fromIntegral portNumber16) + (fromWord8 - reverse _address) + + Domain_name x -> SockAddrUnix - x ^. TS.utf8 . _Text + IPv6_address xs -> + let rs = reverse - xs + in + SockAddrInet6 + (fromIntegral portNumber16) + 0 + ( fromWord8 - P.take 4 - rs + , fromWord8 - P.drop 4 - P.take 4 - rs + , fromWord8 - P.drop 8 - P.take 4 - rs + , fromWord8 - P.drop 12 - rs + ) + 0 + + +localRequestHandler:: MoeConfig -> (Socket, SockAddr) -> IO () +localRequestHandler config (_s, _) = withSocket _s - \aSocket -> do + (inputStream, outputStream) <- socketToStreams aSocket + + let socksVersion = 5 + socksHeader = word8 socksVersion + + let greetingParser = do + socksHeader + let maxNoOfMethods = 5 + _numberOfAuthenticationMethods <- satisfy (<= maxNoOfMethods) + + ClientGreeting <$> + count (fromIntegral _numberOfAuthenticationMethods) anyWord8 + + let connectionParser = do + socksHeader + requestParser + + tryParse - do + r <- parseFromStream greetingParser inputStream + if not - _No_authentication `elem` (r ^. authenticationMethods) + then do + close aSocket + + else do + pushStream outputStream - B.word8 socksVersion + <> B.word8 _No_authentication + + + _clientRequest <- parseFromStream connectionParser inputStream + + let conn = _clientRequest + + _remoteSocket <- socket AF_INET Stream defaultProtocol + + withSocket _remoteSocket - \_remoteSocket -> do + let _c = config + tryAddr (_c ^. remote) (_c ^. remotePort) - \_remoteAddr -> do + connect _remoteSocket _remoteAddr + + _localPeerAddr <- getPeerName aSocket + {-_localSocketAddr <- getSocketName aSocket-} + {-_remotePeerAddr <- getPeerName _remoteSocket-} + {-_remoteSocketAddr <- getSocketName _remoteSocket-} + let _clientAddr = addressType_To_SockAddr _clientRequest + + puts - "L: " <> + ( + concat - L.intersperse " -> " - map show + [ + _localPeerAddr + {-, _localSocketAddr-} + {-, _remotePeerAddr-} + {-, _remoteSocketAddr-} + , _clientAddr + ] + ) + + let handleLocal _remoteSocket = do + let + write x = Stream.write (Just - x) outputStream + push = write . S.singleton + + push socksVersion + push _Request_Granted + push _ReservedByte + + write - builder_To_ByteString - + addressTypeBuilder (conn ^. addressType) + + traverseOf both push - conn ^. portNumber + + (remoteInputStream, remoteOutputStream) <- + socketToStreams _remoteSocket + + _stdGen <- newStdGen + + let _iv = S.pack - P.take _BlockSize - randoms _stdGen + + pushStream remoteOutputStream - B.byteString _iv + + let + _aesKey = aesKey config + _encrypt = encryptCTR _aesKey _iv + _decrypt = decryptCTR _aesKey _iv + + + let + _header = requestBuilder conn + _headerBlock = clamp _PacketSize - + builder_To_ByteString _header + + pushStream remoteOutputStream - B.byteString - + _encrypt _headerBlock + + inputBlockStream <- tokenizeStream _PacketSize + _encrypt inputStream + + remoteInputBlockStream <- detokenizeStream _PacketSize + _decrypt remoteInputStream + + waitBoth + (Stream.connect inputBlockStream remoteOutputStream) + (Stream.connect remoteInputBlockStream outputStream) + + + safeSocketHandler "Local Request Handler" + handleLocal _remoteSocket + + +remoteRequestHandler:: MoeConfig -> (Socket, SockAddr) -> IO () +remoteRequestHandler aConfig (_s, _) = withSocket _s - \aSocket -> do + (remoteInputStream, remoteOutputStream) <- socketToStreams aSocket + + tryParse - do + _iv <- parseFromStream (take _BlockSize) remoteInputStream + + let + _aesKey = aesKey aConfig + _encrypt = encryptCTR _aesKey _iv + _decrypt = decryptCTR _aesKey _iv + + _headerBlock <- _decrypt <$> readExactly (fromIntegral _PacketSize) + remoteInputStream + + _clientRequest <- + case eitherResult - parse requestParser _headerBlock of + Left err -> throwIO - ParseException err + Right r -> pure r + + + let + connectTarget :: ClientRequest -> IO (Maybe Socket) + connectTarget _clientRequest = do + let _socketAddr = addressType_To_SockAddr _clientRequest + + 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 + + + let hints = defaultHints + { + addrSocketType = _socketType + } + + _hostName = sockAddr_To_Host _socketAddr + _port = sockAddr_To_Port _socketAddr + + _addrInfoList <- getAddrInfo + (Just hints) + (Just - _hostName) + (Just - _port) + + let _maybeAddrInfo = preview traverse - + _addrInfoList + + case _maybeAddrInfo of + Nothing -> return Nothing + Just _addrInfo -> do + _targetSocket <- initSocketForType + (addrAddress _addrInfo) + (addrSocketType _addrInfo) + + connect _targetSocket - addrAddress _addrInfo + + pure - Just _targetSocket + + _targetSocket <- connectTarget _clientRequest + + forM_ _targetSocket - flip withSocket - \_targetSocket -> do + _remotePeerAddr <- getPeerName aSocket + {-_remoteSocketAddr <- getSocketName aSocket-} + _targetPeerAddr <- getPeerName _targetSocket + {-_targetSocketAddr <- getSocketName _targetSocket-} + + puts - "R: " <> + ( + concat - L.intersperse " -> " - map show + [ + _remotePeerAddr + {-, _remoteSocketAddr-} + , _targetPeerAddr + {-, _targetSocketAddr-} + ] + ) + let + handleTarget _targetSocket = do + (targetInputStream, targetOutputStream) <- + socketToStreams _targetSocket + + targetInputBlockStream <- tokenizeStream _PacketSize + _encrypt targetInputStream + + remoteInputBlockStream <- detokenizeStream _PacketSize + _decrypt remoteInputStream + + waitBoth + (Stream.connect remoteInputBlockStream targetOutputStream) + (Stream.connect targetInputBlockStream remoteOutputStream) + + safeSocketHandler "Target Connection Handler" + handleTarget _targetSocket + +parseConfig :: Text -> IO (Maybe MoeConfig) +parseConfig aConfigFile = do + _configFile <- TIO.readFile - aConfigFile ^. _Text + + let _v = decodeStrict - review TS.utf8 _configFile :: Maybe Value + let fixConfig :: Value -> Value + fixConfig (Object _obj) = + Object - + _obj & H.toList & over (mapped . _1) (T.cons '_') & H.fromList + fixConfig _ = Null + let + _maybeConfig = (_v >>= decode . encode . fixConfig) + + case _maybeConfig of + Nothing -> do + pute "Failed to parse configuration file" + pute "Example: " + pute - show - encode defaultMoeConfig + + pure Nothing + _config -> do + pure - _config + +moeApp:: MoeOptions -> IO () +moeApp options = do + maybeConfig <- parseConfig - options ^. configFile + + forM_ maybeConfig - \config -> do + let localApp :: SockAddr -> IO (Socket, Socket -> IO ()) + localApp _localAddr = do + putStrLn "Moe local!" + + localSocket <- initSocket _localAddr + setSocketOption localSocket ReuseAddr 1 + bindSocket localSocket _localAddr + + listen localSocket 1 + + let handleLocal _socket = do + r@(_newSocket, _newSocketAddr) <- accept _socket + forkIO - catchAll - onException + (localRequestHandler config r) - do + pute "local onException" + close _newSocket + localLoop = + forever . + safeSocketHandler "Local Connection" handleLocal + + pure (localSocket, localLoop) + + let remoteApp :: SockAddr -> IO (Socket, Socket -> IO ()) + remoteApp _remoteAddr = do + putStrLn "Moe remote!" + + remoteSocket <- initSocket _remoteAddr + setSocketOption remoteSocket ReuseAddr 1 + bindSocket remoteSocket _remoteAddr + listen remoteSocket 1 + + let handleRemote _socket = do + r@(_newSocket, _newSocketAddr) <- accept _socket + forkIO - catchAll - onException + (remoteRequestHandler config r) - do + pute "remote onException" + close _newSocket + + remoteLoop = + forever . + safeSocketHandler "Remote Connection" handleRemote + + pure (remoteSocket, remoteLoop) + + let debugRun :: IO () + debugRun = do + let _c = config + tryAddr (_c ^. local) (_c ^. localPort) - \_localAddr -> do + (localSocket, localLoop) <- localApp _localAddr + + tryAddr (_c ^. remote) (_c ^. remotePort) - \_remoteAddr -> do + (remoteSocket, remoteLoop) <- remoteApp _remoteAddr + catchAll - do + safeSocketHandler "Local Socket" (\_localSocket -> + safeSocketHandler "Remote Socket" (\_remoteSocket -> + waitBoth + (localLoop _localSocket) + (remoteLoop _remoteSocket) + ) remoteSocket) localSocket + + remoteRun :: IO () + remoteRun = do + let _c = config + tryAddr (_c ^. remote) (_c ^. remotePort) - \_remoteAddr -> do + (remoteSocket, remoteLoop) <- remoteApp _remoteAddr + catchAll - + safeSocketHandler "Remote Socket" remoteLoop remoteSocket + + localRun :: IO () + localRun = do + let _c = config + tryAddr (_c ^. local) (_c ^. localPort) - \_localAddr -> do + (localSocket, localLoop) <- localApp _localAddr + catchAll - + safeSocketHandler "Local Socket" localLoop localSocket + + case options ^. runningMode of + DebugMode -> debugRun + RemoteMode -> remoteRun + LocalMode -> localRun + + diff --git a/src/Network/MoeSocks/BuilderAndParser.hs b/src/Network/MoeSocks/BuilderAndParser.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/BuilderAndParser.hs @@ -0,0 +1,78 @@ +module Network.MoeSocks.BuilderAndParser where + +import Control.Lens +import Data.Attoparsec.ByteString +import Data.Monoid +import Data.Word +import Network.MoeSocks.Constant +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import Prelude hiding ((-), take) +import qualified Data.ByteString as S +import qualified Data.ByteString.Builder as B + + +addressTypeBuilder :: AddressType -> B.Builder +addressTypeBuilder aAddressType = + case aAddressType of + IPv4_address _address -> + B.word8 1 + <> foldMap B.word8 _address + Domain_name x -> + B.word8 3 + <> B.word8 (fromIntegral (S.length x)) + <> B.byteString x + + IPv6_address xs -> + B.word8 4 + <> B.byteString (S.pack xs) + + + +connectionType_To_Word8 :: ConnectionType -> Word8 +connectionType_To_Word8 TCP_IP_stream_connection = 1 +connectionType_To_Word8 TCP_IP_port_binding = 2 +connectionType_To_Word8 UDP_port = 3 + +requestBuilder :: ClientRequest -> B.Builder +requestBuilder aClientRequest = + B.word8 (connectionType_To_Word8 - aClientRequest ^. connectionType) + <> B.word8 _ReservedByte + <> addressTypeBuilder (aClientRequest ^. addressType) + <> foldMapOf each B.word8 (aClientRequest ^. portNumber) + +addressTypeParser :: Parser AddressType +addressTypeParser = choice + [ + IPv4_address <$> do + word8 1 + count 4 anyWord8 + + , Domain_name <$> do + word8 3 + let maxDomainNameLength = 32 + _nameLength <- satisfy (<= maxDomainNameLength) + take - fromIntegral _nameLength + + , IPv6_address <$> do + word8 4 + count 16 anyWord8 + ] + +requestParser :: Parser ClientRequest +requestParser = do + __connectionType <- choice + [ + TCP_IP_stream_connection <$ word8 1 + , TCP_IP_port_binding <$ word8 2 + , UDP_port <$ word8 3 + ] + + word8 _ReservedByte + __addressType <- addressTypeParser + __portNumber <- (,) <$> anyWord8 <*> anyWord8 + pure - + ClientRequest + __connectionType + __addressType + __portNumber diff --git a/src/Network/MoeSocks/Config.hs b/src/Network/MoeSocks/Config.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Config.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.MoeSocks.Config where + +import "cipher-aes" Crypto.Cipher.AES +import Control.Lens +import Data.ByteString (ByteString) +import Network.MoeSocks.Constant +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import qualified Data.Text.Strict.Lens as TS + +defaultMoeConfig :: MoeConfig +defaultMoeConfig = MoeConfig + { + _remote= "127.0.0.1" + , _remotePort = 1190 + , _local = "127.0.0.1" + , _localPort = 1090 + , _password = "moesocks" + {-, _method = "none"-} + } + + +aesKey :: MoeConfig -> AES +aesKey _config = + let __password = + _config ^. password & review TS.utf8 :: ByteString + + _key = clamp _KeySize __password + in + initAES _key + + +defaultMoeOptions :: MoeOptions +defaultMoeOptions = MoeOptions + { + _runningMode = DebugMode + , _configFile = "" + } diff --git a/src/Network/MoeSocks/Constant.hs b/src/Network/MoeSocks/Constant.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Constant.hs @@ -0,0 +1,27 @@ +module Network.MoeSocks.Constant where + +import Data.Word +import GHC.Int (Int64) + +_No_authentication :: Word8 +_No_authentication = 0 + +_Request_Granted :: Word8 +_Request_Granted = 0 + +_ReservedByte :: Word8 +_ReservedByte = 0 + +_KeySize :: Int +_KeySize = 32 + +_BlockSize :: Int +_BlockSize = 16 + +_PacketSize :: Int64 +_PacketSize = 256 + +_SpaceCode :: Word8 +_SpaceCode = 32 + + diff --git a/src/Network/MoeSocks/Helper.hs b/src/Network/MoeSocks/Helper.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Helper.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE ExistentialQuantification #-} + +module Network.MoeSocks.Helper where + +import Control.Concurrent +import Control.Exception +import Control.Lens +import Control.Monad.IO.Class +import Data.Binary +import Data.Binary.Put +import Data.ByteString (ByteString) +import Data.Monoid +import Data.Text (Text) +import Data.Text.Lens +import Network.Socket +import Prelude hiding (take, (-)) +import System.IO +import System.IO.Streams (InputStream) +import System.IO.Streams.Attoparsec +import System.IO.Streams.List +import System.IO.Unsafe +import qualified Data.ByteString as S +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Builder.Extra as BE +import qualified Data.ByteString.Lazy as LB +import qualified Prelude as P +import qualified System.IO.Streams as Stream + +-- BEGIN backports + +infixr 0 - +(-) :: (a -> b) -> a -> b +(-) = ($) + +-- END backports + +_Debug :: Bool +_Debug = True + +syncLock :: MVar () +syncLock = unsafePerformIO - newEmptyMVar + +sync :: IO a -> IO a +sync io = do + putMVar syncLock () + io <* takeMVar syncLock + +puts :: String -> IO () +puts + | _Debug = sync . putStrLn + | otherwise = const - pure () + +pute :: String -> IO () +pute = sync . hPutStrLn stderr + +showBytes :: ByteString -> String +showBytes = show . S.unpack + +fromWord8 :: forall t. Binary t => [Word8] -> t +fromWord8 = decode . runPut . mapM_ put + +safeSocketHandler :: String -> (Socket -> IO a) -> Socket -> IO a +safeSocketHandler aID f aSocket = + catch (f aSocket) - \e -> do + pute - "Exception in " <> aID <> ": " <> show (e :: SomeException) + sClose aSocket + throw e + +catchAll :: IO a -> IO () +catchAll io = catch (() <$ io) - \e -> + pute - "CatcheAll: " <> show (e :: SomeException) + +catchIO:: IO a -> IO () +catchIO io = catch (() <$ io) - \e -> + pute - "Catch IO: " <> show (e :: IOException) + + +waitBoth :: IO a -> IO b -> IO () +waitBoth x y = do + (xThreadID, xLock) <- do + _lock <- newEmptyMVar + _threadID <- + forkFinally x - const - putMVar _lock () + + return (_threadID, _lock) + + yThreadID <- + forkFinally y - const - killThread xThreadID + + takeMVar xLock + killThread yThreadID + +pushStream :: (Stream.OutputStream ByteString) -> B.Builder -> IO () +pushStream s b = do + _builderStream <- Stream.builderStream s + Stream.write (Just b) _builderStream + Stream.write (Just BE.flush) _builderStream + +tryAddr :: Text -> Int -> (SockAddr -> IO a) -> IO () +tryAddr aHostName aPort = tryAddr' (Just aHostName) (Just aPort) + (Just - defaultHints { addrSocketType = Stream }) + +tryAddr' :: Maybe Text -> Maybe Int -> Maybe AddrInfo -> + (SockAddr -> IO a) -> IO () +tryAddr' aHostName aPort aHint f = do + addrInfo <- getAddrInfo + aHint + (fmap (view _Text) aHostName) + (fmap show aPort) + + {-puts - "tryAddr':" <> show addrInfo-} + let maybeAddr = addrInfo ^? traverse . to addrAddress + case maybeAddr of + Nothing -> pute - "Can not resolve: " <> show aHostName + Just _addr -> () <$ f _addr + + +tryParse :: IO a -> IO () +tryParse io = flip catch (\e -> puts - show (e :: ParseException)) - () <$ io + +withSocket :: Socket -> (Socket -> IO ()) -> IO () +withSocket aSocket f = do + f aSocket + sClose aSocket + + +sockAddr_To_AddrFamily :: SockAddr -> Family +sockAddr_To_AddrFamily = f where + f (SockAddrInet {}) = AF_INET + f (SockAddrInet6 {}) = AF_INET6 + f (SockAddrUnix {}) = AF_UNIX + f _ = AF_INET + +sockAddr_To_Port :: SockAddr -> String +sockAddr_To_Port = f where + f (SockAddrInet p _) = show p + f (SockAddrInet6 p _ _ _) = show p + f (SockAddrUnix {}) = "" + f _ = "" + +sockAddr_To_Host :: SockAddr -> String +sockAddr_To_Host = f where + f s@(SockAddrInet _ _) = P.takeWhile (/= ':') - show s + f s@(SockAddrInet6 _ _ _ _) = reverse - + P.dropWhile (== ':') - + P.dropWhile (/= ':') - + reverse - show s + f (SockAddrUnix s) = s + f _ = "" + +initSocketForType :: SockAddr -> SocketType -> IO Socket +initSocketForType aSockAddr aSocketType = + socket (sockAddr_To_AddrFamily aSockAddr) aSocketType defaultProtocol + + +initSocket :: SockAddr -> IO Socket +initSocket = flip initSocketForType Stream + +clamp :: (Integral i) => i -> ByteString -> ByteString +clamp i x = S.take (fromIntegral i) - x <> S.replicate (fromIntegral i) 0 + +-- first bit is length +splitTokens :: Int -> ByteString -> [ByteString] +splitTokens l x + | l <= 1 = [x] + | x == mempty = [] + | otherwise = + let + byteLength = l + (-1) + (y, z) = S.splitAt byteLength x + length_y_byte = fromIntegral - S.length y + in + clamp l (S.cons length_y_byte y) : splitTokens l z + +tokenizeStream :: (Integral n) => n -> (ByteString -> ByteString) -> + InputStream ByteString -> IO (InputStream ByteString) +tokenizeStream n f input = + Stream.map (splitTokens - fromIntegral n) input + >>= concatLists >>= Stream.map f + +decodeToken :: ByteString -> ByteString +decodeToken x + | x == mempty = mempty + | otherwise = S.take (fromIntegral - S.head x) - S.tail x + +chunkStream :: (Integral n) => n -> InputStream ByteString -> + IO (InputStream ByteString) +chunkStream n input = Stream.fromGenerator - go + where + l = fromIntegral n + go = liftIO (Stream.read input) >>= maybe (return $! ()) chunk + chunk x + | S.length x >= l = Stream.yield (S.take l x) >> chunk (S.drop l x) + | otherwise = + liftIO (Stream.read input) >>= + maybe (Stream.yield x) (chunk . (x <>)) + +detokenizeStream :: (Integral n) => n -> (ByteString -> ByteString) -> + InputStream ByteString -> + IO (InputStream ByteString) +detokenizeStream n f input = Stream.map (decodeToken . f) =<< + chunkStream n input + +builder_To_ByteString :: B.Builder -> ByteString +builder_To_ByteString = LB.toStrict . B.toLazyByteString diff --git a/src/Network/MoeSocks/OptionParser.hs b/src/Network/MoeSocks/OptionParser.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/OptionParser.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} + +module Network.MoeSocks.OptionParser where + +import Control.Lens +import Data.Text.Lens +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import Options.Applicative hiding (Parser) +import Prelude hiding ((-)) +import qualified Options.Applicative as O + +optionParser :: O.Parser MoeOptions +optionParser = + let _mode = strOption - + short 'm' + <> long "mode" + <> metavar "MODE" + <> help "local | remote" + in + let _config = strOption - + short 'c' + <> long "config" + <> metavar "CONFIG" + <> help "path to the configuration file" + + in + + let parseMode :: String -> RunningMode + parseMode x + | x `elem` ["server", "remote"] = RemoteMode + | x `elem` ["client", "local"] = LocalMode + | x == "debug" = DebugMode + | otherwise = DebugMode + in + + MoeOptions <$> fmap parseMode _mode <*> fmap (view packed) _config + +opts :: ParserInfo MoeOptions +opts = info (helper <*> optionParser) - + fullDesc + <> progDesc "A socks5 proxy using the client / server architecture" + <> header "moesocks - moe for all" + + diff --git a/src/Network/MoeSocks/Type.hs b/src/Network/MoeSocks/Type.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Type.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.MoeSocks.Type where + +import Control.Lens +import Data.Aeson +import Data.ByteString (ByteString) +import Data.Text (Text) +import Data.Word +import GHC.Generics + +data ClientGreeting = ClientGreeting + { + _authenticationMethods :: [Word8] + } + deriving (Show) + +makeLenses ''ClientGreeting + +data ConnectionType = + TCP_IP_stream_connection + | TCP_IP_port_binding + | UDP_port + deriving (Show, Eq) + +data AddressType = + IPv4_address [Word8] + | Domain_name ByteString + | IPv6_address [Word8] + deriving (Show, Eq) + + +data ClientRequest = ClientRequest + { + _connectionType :: ConnectionType + , _addressType :: AddressType + , _portNumber :: (Word8, Word8) + } + deriving (Show) + +makeLenses ''ClientRequest + +data MoeConfig = MoeConfig + { + _remote :: Text + , _remotePort :: Int + , _local :: Text + , _localPort :: Int + , _password :: Text + {-, _method :: Text-} + } + deriving (Show, Eq, Generic) + +instance FromJSON MoeConfig +instance ToJSON MoeConfig + +makeLenses ''MoeConfig + +data RunningMode = RemoteMode | LocalMode | DebugMode + deriving (Show, Eq) + +data MoeOptions = MoeOptions + { + _runningMode :: RunningMode + , _configFile :: Text + } + deriving (Show, Eq) + +makeLenses ''MoeOptions