Add support for forwarding data from stdio #13

Former-commit-id: 14e64f7856faa8b9dba9863b9c19cb4c946ec59a
Former-commit-id: 7da75567618986cabb6988c21e121875c1ad3c1a [formerly a2e77352c857e68e01d12391baf08d3479fd12fe] [formerly f1faa58016cca590bfc52e1ef3f791fc6d0eeccc [formerly fcc6b7ecbd00c933d564805d4adf2e9114bfc6d5 [formerly 30e36d272030b305c561984fe353a1ba2b0db62e] [formerly fcc6b7ecbd00c933d564805d4adf2e9114bfc6d5 [formerly 30e36d272030b305c561984fe353a1ba2b0db62e] [formerly 30e36d272030b305c561984fe353a1ba2b0db62e [formerly adb6021118db2efa77278f15d3523b9ee75a84b3]]]]]
Former-commit-id: fe2e93e58fbbf425c02ccf85bb56ec7119ea365e [formerly ab0492da6e9e63a2f7357eef20e5b43dbc0df810]
Former-commit-id: d9a120c7e6cfb38b3dcb73c5fdb27492f587fbb8
Former-commit-id: e7e62bedc379e337d945fba8e0fc8abe86f7f000
Former-commit-id: 12e2067cf1471e6a5469eb5bdde21a711d6f79e9
Former-commit-id: bd45b8e3895b005582eb0f636206b3265e0cfd78 [formerly 4f169fede9f7d60e38960e640c741c2958fd4830]
Former-commit-id: 0ddce8e35b6f8ada2166916cd66166bc36af75d4

app/Main.hs

@@ -74,6 +74,7 @@ cmdLine = WsTunnel
 
 
 toPort :: String -> Int
+toPort "stdio" = 0
 toPort str = case readMay str of
                   Just por -> por
                   Nothing  -> error $ "Invalid port number `" ++ str ++ "`"
@@ -148,7 +149,7 @@ main = do
                                       , destHost = rHost
                                       , destPort = fromIntegral rPort
                                       , Types.useTls = Main.useTls serverInfo
-                                      , protocol = if udpMode cfg then UDP else TCP
+                                      , protocol = if lPort == 0 then STDIO else if udpMode cfg then UDP else TCP
                                       , proxySetting = parseProxyInfo (proxy cfg)
                                       , useSocks = False
                                       , upgradePrefix = pathPrefix cfg

src/Protocols.hs

@@ -7,6 +7,7 @@ import           ClassyPrelude
 import           Control.Concurrent        (forkIO)
 import qualified Data.HashMap.Strict       as H
 import           System.Timeout            (timeout)
+import           System.IO
 
 import qualified Data.ByteString.Char8     as BC
 
@@ -24,6 +25,20 @@ import qualified Socks5
 import           Types
 
 
+runSTDIOServer :: (StdioAppData -> IO ()) -> IO ()
+runSTDIOServer app = do
+  stdin_old_buffering <- hGetBuffering stdin
+  stdout_old_buffering <- hGetBuffering stdout
+
+  hSetBuffering stdin (BlockBuffering (Just 512))
+  hSetBuffering stdout NoBuffering
+
+  void $ forever $ app StdioAppData
+
+  hSetBuffering stdin stdin_old_buffering
+  hSetBuffering stdout stdout_old_buffering
+  info $ "CLOSE stdio server"
+
 runTCPServer :: (HostName, PortNumber) -> (N.AppData -> IO ()) -> IO ()
 runTCPServer endPoint@(host, port) app = do
   info $ "WAIT for tcp connection on " <> toStr endPoint

src/Tunnel.hs

@@ -160,7 +160,6 @@ runClient cfg@TunnelSettings{..} = do
 
   let app cfg' localH = do
         ret <- withTunnel cfg' $ \remoteH -> do
-          info $ "CREATE tunnel :: " <> show cfg'
           ret <- remoteH <==> toConnection localH
           info $ "CLOSE tunnel :: " <> show cfg'
           return ret
@@ -170,12 +169,12 @@ runClient cfg@TunnelSettings{..} = do
   case protocol of
         UDP -> runUDPServer (localBind, localPort) (app cfg)
         TCP -> runTCPServer (localBind, localPort) (app cfg)
+        STDIO -> runSTDIOServer (app cfg)
         SOCKS5 -> runSocks5Server (Socks5.ServerSettings localPort localBind) cfg app
 
 
 
 
-
 --
 --  Server
 --
@@ -237,7 +236,9 @@ runServer useTLS = if useTLS then runTlsTunnelingServer else runTunnelingServer
 --  Commons
 --
 toPath :: TunnelSettings -> String
-toPath TunnelSettings{..} = "/" <> upgradePrefix <> "/" <> toLower (show $ if protocol == SOCKS5 then TCP else protocol) <> "/" <> destHost <> "/" <> show destPort
+toPath TunnelSettings{..} = "/" <> upgradePrefix <> "/"
+                            <> toLower (show $ if protocol == UDP then UDP else TCP)
+                            <> "/" <> destHost <> "/" <> show destPort
 
 fromPath :: ByteString -> Maybe (Protocol, ByteString, Int)
 fromPath path = let rets = BC.split '/' . BC.drop 1 $ path

src/Types.hs

@@ -7,6 +7,8 @@ module Types where
 
 import           ClassyPrelude
 import           Data.Maybe
+import           System.IO (stdin, stdout)
+import           Data.ByteString (hGetSome, hPutStr)
 
 import qualified Data.Streaming.Network        as N
 import qualified Network.Connection            as NC
@@ -23,7 +25,9 @@ deriving instance Generic N.SockAddr
 deriving instance Hashable N.SockAddr
 
 
-data Protocol = UDP | TCP | SOCKS5 deriving (Show, Read, Eq)
+data Protocol = UDP | TCP | STDIO | SOCKS5 deriving (Show, Read, Eq)
+
+data StdioAppData = StdioAppData
 
 data UdpAppData = UdpAppData
   { appAddr  :: N.SockAddr
@@ -77,6 +81,13 @@ data Connection = Connection
 class ToConnection a where
   toConnection :: a -> Connection
 
+instance ToConnection StdioAppData where
+  toConnection conn = Connection { read = Just <$> hGetSome stdin 512
+                                 , write = hPutStr stdout
+                                 , close = return ()
+                                 , rawConnection = Nothing
+                                 }
+
 instance ToConnection WS.Connection where
   toConnection conn = Connection { read = Just <$> WS.receiveData conn
                                  , write = WS.sendBinaryData conn