[Haskell-cafe] please help me to find errors from my first app

Changying Li lchangying at gmail.com
Fri Aug 8 14:42:01 EDT 2008


Hi. 
I want to write a reverse proxy like perlbal to practive haskell. Now I
just write a very simple script to forward any request to
www.google.com.

but it dosn't work. I run command ' runhaskell Proxy.hs'  and 'wget
http://localhost:8080/'. but wget just wait forever and runhaskkell can
get request. when I break wget, the 'runhaskell' can print response
returned from www.google.com. 
why?

module Main where

import System.Posix.Process
import Network
import Prelude hiding (putStr)
import System.IO hiding (hGetContents, putStr)
                                    
import Control.Concurrent
import System.Posix.Signals
import Data.ByteString.Lazy.Char8 (hGetContents, hPut, putStr,hGet,cons)
listenPort = PortNumber 8080
connectToHost = "208.67.219.230"
connectToPort = PortNumber 80

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  socket <- listenOn listenPort
  let doLoop = do
         (hdl, _, _) <- accept socket
         forkIO $ processRequest hdl
         doLoop
  doLoop

processRequest :: Handle -> IO ()
processRequest hRequest = do
  installHandler sigPIPE Ignore Nothing; 
  hSetBuffering hRequest NoBuffering
  hSetBuffering stdout NoBuffering
  request <- hGetContents hRequest
  putStr $ '>' `cons` (' ' `cons` request)
  hResponse <- connectTo connectToHost connectToPort
  hSetBuffering hResponse NoBuffering
  hPut hResponse request
  response <- hGetContents hResponse
  putStr $ '<' `cons` (' ' `cons` response)
  hPut hRequest response
  hClose hRequest
  hClose hResponse





-- 

Thanks & Regards

Changying Li



More information about the Haskell-Cafe mailing list