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 

このように実行することができます：2000年、私は：私はローカルホストに接続する場合、mRemoteを使用して

proxy 2000 localhost 3389 

ローカルマシンのログイン画面が表示されます。 :)

* (>-)を改善する方法が見つかった場合は、この回答を更新します。

Answer 1

情報を探すときにthis tcp proxy gistに来たようです。この時点で、isは壊れていて、少し乱雑です。そのような場合は、著者（この場合は私）にpingをして、将来の参考のために要点を修正できるようにしてください:)

私はすぐに修正し、このSOの質問にリンクします。固定版にはsendAllだけでなく、このSOの質問から来るすべての素晴らしい提案が含まれますので、あなたの最高の考えを共有してください。参考のために、this branch of throttleにはすでにsendAllの修正がありました。

編集：要点は今や修正されました

Answer 2

見つけた数ヶ月前、私がハスケルを使い始めたときに見つけたthis gist。

本当にシンプルで理解しやすいです。

EDIT：上記の要点に基づいて、ここにテスト済みのRDPプロキシがあります。差異はsendをsendAllに置き換えて、すべてのデータが配信されていることを確認します。 linuxのrdpサーバー（大きなペイロードの切断）でテストするときにこの問題が見つかりました。

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()