[Haskell-beginners] Implementing a toy network proxy

[Patrick LeBoutillier]

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 <michael at snoyman.com> 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-ByteString.html#v:hGetNonBlocking
>
> On Thu, Sep 23, 2010 at 7:13 PM, Patrick LeBoutillier
> <patrick.leboutillier at gmail.com> 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 at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>>
>



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