Как написать прокси с минимальными накладными расходами для localhost: 3389 в Haskell? - PullRequest
Новая
       41

Как написать прокси с минимальными накладными расходами для localhost: 3389 в Haskell?

1 голос
/ 27 февраля 2012

Обновление: вопрос теперь содержит окончательно отредактированный ответ!

Теперь я использую следующее (окончательный ответ): 

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, я делаю см. Экран входа на локальный компьютер!:)

* Если я найду способ улучшить (>-), я обновлю этот ответ!

Ответы [ 2 ]

2 голосов
/ 02 марта 2012

Похоже, вы пришли к этому прокси-серверу tcp при поиске информации.В это время это сломано и немного грязно.В таком случае, пожалуйста, не стесняйтесь пинговать автора (в данном случае меня), чтобы он мог исправить суть для будущих ссылок:)

Я исправлю это как можно скорее и ссылку на этот вопрос,Фиксированная версия будет включать sendAll, а также все приятные предложения, вытекающие из этого SO вопроса, поэтому, пожалуйста, поделитесь своими лучшими мыслями.В качестве примечания, эта ветвь газа уже имела исправление sendAll, в случае интереса.

EDIT: суть теперь исправлена ​​

2 голосов
/ 27 февраля 2012

Найдена эта суть несколько месяцев назад, когда я только начинал с Haskell.

Это действительно просто и легко понять.

РЕДАКТИРОВАТЬ : Исходя из вышеизложенного, вот протестированный RDP-прокси.Разница заключается в замене send на sendAll, чтобы обеспечить доставку всех данных.Обнаружил эту проблему при тестировании через rdp-сервер linux (большая нагрузка отключается). 

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