shadowsocks-1.20180408: app/local.hs

{-# LANGUAGE OverloadedStrings #-}

import           Conduit                  (ConduitT, await, connect, leftover,
                                           liftIO, yield, ($$+), ($$++), ($$+-),
                                           (.|))
import           Control.Concurrent.Async (race_)
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as S
import qualified Data.ByteString.Char8    as C
import           Data.Conduit.Network     (appSink, appSource, clientSettings,
                                           runTCPClient, runTCPServer,
                                           serverSettings)
import           Data.Monoid              ((<>))
import           GHC.IO.Handle            (BufferMode (NoBuffering),
                                           hSetBuffering)
import           GHC.IO.Handle.FD         (stdout)

import           Shadowsocks.Encrypt      (getEncDec)
import           Shadowsocks.Util

initLocal :: ConduitT ByteString ByteString IO ()
initLocal = do
    await
    yield "\x05\x00"
    await >>= maybe (return ()) (\request -> do
        let (addrType, destAddr, destPort, _) =
                either (error . show . UnknownAddrType)
                       id
                       (unpackRequest $ S.drop 3 request)
            packed = packRequest addrType destAddr destPort
        yield "\x05\x00\x00\x01\x00\x00\x00\x00\x10\x10"
        liftIO $ C.putStrLn $ "connecting " <> destAddr
                                            <> ":" <> C.pack (show destPort)
        leftover packed)

initRemote :: (ByteString -> IO ByteString)
           -> ConduitT ByteString ByteString IO ()
initRemote encrypt = do
    mAddrToSend <- await
    case mAddrToSend of
        Just addrToSend -> do
            enc <- liftIO $ encrypt addrToSend
            yield enc
        Nothing -> return ()

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering
    config <- parseConfigOptions
    let localSettings = serverSettings (localPort config) "*"
        remoteSettings = clientSettings (serverPort config)
                                        (C.pack $ server config)
    C.putStrLn $ "starting local at " <> C.pack (show $ localPort config)
    runTCPServer localSettings $ \client -> do
        (encrypt, decrypt) <- getEncDec (method config) (password config)
        (clientSource, ()) <- appSource client $$+ initLocal .| appSink client
        runTCPClient remoteSettings $ \appServer -> do
            (clientSource', ()) <-
                clientSource $$++ initRemote encrypt .| appSink appServer
            race_
                (clientSource' $$+- cryptConduit encrypt .| appSink appServer)
                (appSource appServer `Conduit.connect`
                    (cryptConduit decrypt .| appSink client))