如何在 Haskell 中为 localhost:3389 编写一个最小开销的代理？

Question

更新：问题现在包含最终编辑的答案！

我现在使用以下（最终答案）：

module Main where

import Control.Concurrent        (forkIO)
import Control.Monad             (when,forever,void)
import Network                   (PortID(PortNumber),listenOn)
import Network.Socket hiding     (listen,recv,send)
import Network.Socket.ByteString (recv,sendAll)
import qualified Data.ByteString as B
import System

type Host = String
type Port = PortNumber

main :: IO ()
main = do
  [lp,h,p] <- getArgs  
  start (port lp) h (port p)
  where
    port = fromInteger . read

start :: Port -> Host -> Port -> IO ()
start lp rh rp = withSocketsDo $ do
  proxy <- listenOn $ PortNumber lp
  forever $ do
    (client,_) <- accept proxy
    void . forkIO $ (client >-<) =<< rh .@. rp

(.@.) :: Host -> Port -> IO Socket
host .@. port = do
  addr:_ <- getAddrInfo Nothing (Just host) (Just $ show port)
  server <- socket (addrFamily  addr) Stream defaultProtocol
  connect server   (addrAddress addr)
  return  server

(>-<) :: Socket -> Socket -> IO ()
x >-< y = do x >- y; y >- x

(>-) :: Socket -> Socket -> IO ()
s >- r = void . forkIO . handle $ forever stream
  where
    stream = recv s (64 * 1024) >>= ifNot0 >>= sendAll r
    ifNot0  = \c -> do when (B.null c) $ handle (error "0"); return c
    handle = flip catch $ \e -> print e >> sClose s >> sClose r

可以这样运行：

proxy 2000 localhost 3389

使用mRemote，如果我连接到localhost:2000，我会看到本地机器的登录屏幕！ :)

*如果我找到进一步改进(>-) 的方法，我会更新这个答案！

Answer 1

你好像是在找资料的时候来this tcp proxy gist的。这时候，是破碎的，有点凌乱。在这种情况下，请不要犹豫，联系作者（在这种情况下是我），以便他可以修复要点以供将来参考:)

我会尽快修复它并链接到这个 SO 问题。固定版本将包括 sendAll 以及来自此 SO 问题的所有不错的建议，所以请分享您的最佳想法。附带说明一下，this branch of throttle 已经修复了 sendAll，以备不时之需。

编辑：现在已经修复了要点

Answer 2

几个月前我开始使用 Haskell 时发现 this gist。

真的简单易懂。

编辑：根据上面的要点，这是一个经过测试的 RDP 代理。不同之处在于将 send 替换为 sendAll 以确保所有数据都已交付。通过linux rdp服务器测试时发现这个问题（大payload断开）。

module Main where

import Control.Concurrent      (forkIO)
import Control.Monad           (forever,unless)
import Network                 (PortID(PortNumber),listenOn)
import qualified Data.ByteString as S
import Network.Socket hiding (listen,recv,send)
import Network.Socket.ByteString (recv,sendAll)
import System.Posix            (Handler(Ignore),installHandler,sigPIPE)


localPort :: PortNumber
localPort = 3390

remoteHost :: String
remoteHost = "localhost"

remotePort :: Integer
remotePort = 3389

main :: IO ()
main = do
  ignore $ installHandler sigPIPE Ignore Nothing
  start

start :: IO ()
start = withSocketsDo $ do
  listener <- listenOn $ PortNumber localPort
  forever $ do
    (client,_) <- accept listener
    ignore $ forkIO $ do
      server <- connectToServer
      client `proxyTo` server
      server `proxyTo` client
    return ()
  where
    connectToServer = do
      addrinfos <- getAddrInfo Nothing (Just remoteHost) (Just $ show remotePort)
      let serveraddr = head addrinfos
      server <- socket (addrFamily serveraddr) Stream defaultProtocol
      connect server (addrAddress serveraddr)
      return server
    proxyTo from to = do
      ignore $ forkIO $ flip catch (close from to) $ forever $ do
        content <- recv from 1024
        unless (S.null content) $ sendAll to content
      return ()
    close a b _ = do
      sClose a
      sClose b

-- | Run an action and ignore the result.
ignore :: Monad m => m a -> m ()
ignore m = m >> return ()