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

23 Sep 2010

      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