Re: [Haskell-beginners] Implementing a toy network proxy

I just tried the code on my system; worked great for an SSH session. Maybe you want to try with the multithreaded runtime, ie: ghc --make -threaded filename.hs On Fri, Sep 24, 2010 at 1:18 AM, Patrick LeBoutillier wrote:

Ok, finally I wound up with this:

import Network import System.IO import Control.Concurrent import IO (hWaitForInput) import System.IO.Error (try) import qualified Data.ByteString as B

copy :: Handle -> Handle -> IO () copy a b = do  r <- try $ hWaitForInput a (-1)  buf <- case r of           Right _ -> B.hGetNonBlocking a 4096           Left err -> return B.empty  if B.null buf    then hClose a >> hClose b    else B.hPut b buf >> copy a b

main = do  let lport = 8000  let rhost = "idefix"  let rport = 80

 listenOn (PortNumber lport) >>= acceptLoop rhost rport

 where    acceptLoop rhost rport server = do      (local, _, _) <- accept server      hSetBuffering local NoBuffering      forkIO $ do        remote <- connectTo rhost (PortNumber rport)        hSetBuffering remote NoBuffering        redir local remote      acceptLoop rhost rport server

   redir h1 h2 = forkIO (copy h1 h2) >> forkIO (copy h2 h1)

That seems to do the job, but it feels a bit clunky when I do a manual telnet through it. Do I have to compile/run it in a special way to make the forkIOs really parallelize?

It also feels like the hCloses are not happening immediately. Is there anything I can do about that?

Thanks a lot,

Patrick

On Thu, Sep 23, 2010 at 1:26 PM, Michael Snoyman wrote:

...

It might be easier to use bytestrings instead of Ptr (). I think the relevant function is hGetNonBlocking[1].

Cheers, Michael

[1] http://hackage.haskell.org/packages/archive/bytestring/0.9.1.7/doc/html/Data...

On Thu, Sep 23, 2010 at 7:13 PM, Patrick LeBoutillier wrote:

...

Hi ,

I'm trying to write a toy generic network proxy that will accept connections on a port, and for each connection connect to a remote server and forward the traffic.

Here's what I have do far:

import Network import System.IO import Control.Exception import Control.Concurrent

copy :: Handle -> Handle -> IO () copy a b = undefined

redir :: Handle -> Handle -> IO () redir h1 h2 = forkIO (copy h1 h2) >> forkIO (copy h2 h1) >> return ()

acceptLoop :: Socket -> HostName -> PortID -> IO () acceptLoop sock rhost rport = loop  where loop = do         (local, host, port) <- accept sock         remote <- connectTo rhost rport         redir local remote         loop >> return ()

main = do  let local_port = 8000  let remote_host = "whatever"  let remote_port = 80  server <- listenOn (PortNumber local_port)  acceptLoop server remote_host (PortNumber remote_port)

Basically I'm stuck at how to implement the copy function. I want it to block until some data is available on a, read it and then write it to b.

I think I need to use hGetBufNonBlocking, but I don't know how to get a "Ptr a".

I am on the right track with this?

Patrick -- ===================== Patrick LeBoutillier Rosemère, Québec, Canada _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

-- ===================== Patrick LeBoutillier Rosemère, Québec, Canada