@@ -28,8 +28,12 @@ import qualified Data.ByteString as S
2828import qualified Data.ByteString.Char8 as B
2929import qualified Data.ByteString.Lazy as L
3030import Network
31− ( listenOn, accept, sClose, PortID(PortNumber), Socket
31+ ( listenOn, sClose, PortID(PortNumber), Socket
3232 , withSocketsDo)
33+import Network.Socket
34+ ( accept
35+ )
36+import qualified Network.Socket.ByteString as Sock
3337import Control.Exception (bracket, finally, Exception)
3438import System.IO (Handle, hClose, hFlush)
3539import System.IO.Error (isEOFError, ioeGetHandle)
@@ -50,7 +54,7 @@ import Blaze.ByteString.Builder.HTTP
5054import Blaze.ByteString.Builder (fromByteString, Builder, toLazyByteString)
5155import Blaze.ByteString.Builder.Char8 (fromChar, fromString)
5256import Data.Monoid (mconcat)
53−import Network.Socket.SendFile (unsafeSendFile)
57+import Network.Socket.SendFile (sendFile)
5458
5559import Control.Monad.IO.Class (liftIO)
5660
@@ -64,35 +68,26 @@ type Port = Int
6468
6569serveConnections :: Port -> Application -> Socket -> IO ()
6670serveConnections port app socket = do
67− (conn, remoteHost', _) <- accept socket -- FIXME use sockets directly instead of Handlers?
68− -- FIXME disable buffering
71+ (conn, _) <- accept socket
72+ let remoteHost' = undefined
6973 _ <- forkIO $ serveConnection port app conn remoteHost'
7074 serveConnections port app socket
7175
72−serveConnection :: Port -> Application -> Handle -> String -> IO ()
76+serveConnection :: Port -> Application -> Socket -> String -> IO ()
7377serveConnection port app conn remoteHost' = do
7478 catch
7579 (finally
7680 (E.run_ $ fromClient $$ serveConnection')
77− (hClose conn))
78− catchEOFError
81+ (sClose conn))
82+ undefined
7983 where
80− fromClient = enumHandle 4096 conn
84+ fromClient = enumSocket 4096 conn
8185 serveConnection' = do
8286 (enumeratee, env) <- parseRequest port remoteHost'
8387 res <- E.joinI $ enumeratee $$ app env
8488 keepAlive <- liftIO $ sendResponse env (httpVersion env) conn res
85− liftIO $ hFlush conn
8689 when keepAlive serveConnection'
8790
88− catchEOFError :: IOError -> IO ()
89− catchEOFError e
90− | isEOFError e =
91− case ioeGetHandle e of
92− Just h -> unless (h == conn) (ioError e)
93− Nothing -> ioError e
94− | otherwise = ioError e
95−
9691parseRequest :: Port -> String -> E.Iteratee S.ByteString IO (E.Enumeratee ByteString ByteString IO a, Request)
9792parseRequest port remoteHost' = do
9893 headers' <- takeUntilBlank 0 id
@@ -222,20 +217,20 @@ isChunked = (==) http11
222217hasBody :: Status -> Request -> Bool
223218hasBody s req = s /= (Status 204 "") && requestMethod req /= "HEAD"
224219
225−sendResponse :: Request -> HttpVersion -> Handle -> Response -> IO Bool
226−sendResponse req hv handle (ResponseFile s hs fp) = do
227− mapM_ (S.hPut handle) $ L.toChunks $ toLazyByteString $ headers hv s hs False
220+sendResponse :: Request -> HttpVersion -> Socket -> Response -> IO Bool
221+sendResponse req hv socket (ResponseFile s hs fp) = do
222+ Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
228223 if hasBody s req
229224 then do
230− unsafeSendFile handle fp
225+ sendFile socket fp
231226 return $ lookup "content-length" hs /= Nothing
232227 else return True
233−sendResponse req hv handle (ResponseEnumerator res) =
228+sendResponse req hv socket (ResponseEnumerator res) =
234229 res go
235230 where
236231 go s hs
237232 | not (hasBody s req) = do
238− liftIO $ mapM_ (S.hPut handle)
233+ liftIO $ Sock.sendMany socket
239234 $ L.toChunks $ toLazyByteString
240235 $ headers hv s hs False
241236 return True
@@ -243,7 +238,7 @@ sendResponse req hv handle (ResponseEnumerator res) =
243238 chunk'
244239 $ E.enumList 1 [headers hv s hs isChunked']
245240 $$ E.joinI $ builderToByteString
246− $$ (iterHandle handle >> return isKeepAlive)
241+ $$ (iterSocket socket >> return isKeepAlive)
247242 where
248243 hasLength = lookup "content-length" hs /= Nothing
249244 isChunked' = isChunked hv && not hasLength
@@ -298,3 +293,16 @@ requestBodyHandle initLen =
298293 if newlen <= 0
299294 then return ()
300295 else drain newlen
296+
297+iterSocket socket =
298+ E.continue go
299+ where
300+ go E.EOF = E.yield () E.EOF
301+ go (E.Chunks cs) = liftIO (Sock.sendMany socket cs) >> E.continue go
302+
303+enumSocket len socket (E.Continue k) = do
304+ bs <- liftIO $ Sock.recv socket len
305+ if S.length bs == 0
306+ then E.continue k
307+ else k (E.Chunks [bs]) >>== enumSocket len socket
308+enumSocket _ _ step = E.returnI step