@@ -30,7 +30,8 @@ import Network
3030 ( listenOn, accept, sClose, PortID(PortNumber), Socket
3131 , withSocketsDo)
3232import Control.Exception (bracket, finally, Exception, throwIO)
33−import System.IO (Handle, hClose)
33+import System.IO (Handle, hClose, hFlush)
34+import System.IO.Error (isEOFError, ioeGetHandle)
3435import Control.Concurrent (forkIO)
3536import Control.Monad (unless)
3637import Data.Maybe (isJust, fromJust, fromMaybe)
@@ -64,15 +65,24 @@ serveConnections port app socket = do
6465 serveConnections port app socket
6566
6667serveConnection :: Port -> Application -> Handle -> String -> IO ()
67−serveConnection port app conn remoteHost' =
68− finally
69− serveConnection'
70− (hClose conn)
71− where
72− serveConnection' = do
73− env <- parseRequest port conn remoteHost'
74− res <- app env
75− sendResponse (httpVersion env) conn res
68+serveConnection port app conn remoteHost' = do
69+ catch
70+ (finally
71+ serveConnection'
72+ (hClose conn))
73+ catchEOFError
74+ where serveConnection' = do
75+ env <- parseRequest port conn remoteHost'
76+ res <- app env
77+ sendResponse (httpVersion env) conn res
78+ hFlush conn
79+ serveConnection'
80+
81+ catchEOFError :: IOError -> IO ()
82+ catchEOFError e | isEOFError e = case ioeGetHandle e of
83+ Just h -> unless (h == conn) (ioError e)
84+ Nothing -> ioError e
85+ | otherwise = ioError e
7686
7787parseRequest :: Port -> Handle -> String -> IO Request
7888parseRequest port conn remoteHost' = do
@@ -110,16 +120,14 @@ parseRequest' :: Port
110120 -> IO Request
111121parseRequest' port lines' handle remoteHost' = do
112122 case lines' of
113− (_:_:_) -> return ()
123+ (_:_) -> return ()
114124 _ -> throwIO $ NotEnoughLines $ map B.unpack lines'
115125 (method, rpath', gets, httpversion) <- parseFirst $ head lines'
116126 let rpath = '/' : case B.unpack rpath' of
117127 ('/':x) -> x
118128 _ -> B.unpack rpath'
119129 let heads = map (first mkCIByteString . parseHeaderNoAttr) $ tail lines'
120− let host' = lookup "Host" heads
121− unless (isJust host') $ throwIO HostNotIncluded
122− let host = fromJust host'
130+ host <- maybe (throwIO HostNotIncluded) return $ lookup "host" heads
123131 let len = fromMaybe 0 $ do
124132 bs <- lookup "Content-Length" heads
125133 let str = B.unpack bs
@@ -177,9 +185,8 @@ headers httpversion status responseHeaders = mconcat
177185sendResponse :: HttpVersion -> Handle -> Response -> IO ()
178186sendResponse hv handle res = do
179187 responseEnumerator res $ \s hs ->
180− enumList 1 [headers hv s hs]
181− $$ E.joinI $ after (enumList 1 [fromByteString "\r\n"])
182− $$ E.joinI $ chunk
188+ E.joinI $ chunk
189+ $$ E.enumList 1 [headers hv s hs]
183190 $$ E.joinI $ builderToByteString
184191 $$ iterHandle handle
185192 where