moesocks (empty) → 0.1.0.0
raw patch · 12 files changed
+1132/−0 lines, 12 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, binary, bytestring, cipher-aes, io-streams, lens, network, optparse-applicative, random, text, transformers, unix, unordered-containers
Files
- LICENSE +202/−0
- Setup.hs +2/−0
- config.json +8/−0
- moesocks.cabal +53/−0
- src/Main.hs +13/−0
- src/Network/MoeSocks/App.hs +383/−0
- src/Network/MoeSocks/BuilderAndParser.hs +78/−0
- src/Network/MoeSocks/Config.hs +42/−0
- src/Network/MoeSocks/Constant.hs +27/−0
- src/Network/MoeSocks/Helper.hs +205/−0
- src/Network/MoeSocks/OptionParser.hs +47/−0
- src/Network/MoeSocks/Type.hs +72/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ config.json view
@@ -0,0 +1,8 @@+{+ "remote":"127.0.0.1",+ "remotePort":1190,+ "local":"127.0.0.1",+ "localPort":1090,+ "password":"birthday!"+}+
+ moesocks.cabal view
@@ -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 <nfjinjing@gmail.com>+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
+ src/Main.hs view
@@ -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+
+ src/Network/MoeSocks/App.hs view
@@ -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++
+ src/Network/MoeSocks/BuilderAndParser.hs view
@@ -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
+ src/Network/MoeSocks/Config.hs view
@@ -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 = ""+ }
+ src/Network/MoeSocks/Constant.hs view
@@ -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++
+ src/Network/MoeSocks/Helper.hs view
@@ -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
+ src/Network/MoeSocks/OptionParser.hs view
@@ -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"++
+ src/Network/MoeSocks/Type.hs view
@@ -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