[Haskell-beginners] Implementing a toy network proxy

[Michael Snoyman]

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
<patrick.leboutillier at gmail.com> 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 <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
>