@@ -64,7 +64,7 @@ import Control.Exception
6464 ( bracket, finally, Exception, SomeException, catch
6565 , fromException
6666 )
67−import Control.Concurrent (forkIO)
67+import Control.Concurrent (forkIO, threadWaitWrite)
6868import Data.Maybe (fromMaybe)
6969
7070import Data.Typeable (Typeable)
@@ -80,7 +80,7 @@ import Blaze.ByteString.Builder
8080 (copyByteString, Builder, toLazyByteString, toByteStringIO)
8181import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
8282import Data.Monoid (mappend, mconcat)
83−import Network.Socket.SendFile (sendFile)
83+import Network.Socket.SendFile (sendFileIterWith, Iter (..))
8484
8585import Control.Monad.IO.Class (liftIO)
8686import qualified Timeout as T
@@ -186,6 +186,9 @@ maxHeaders = 30
186186maxHeaderLength = 1024
187187bytesPerRead = 4096
188188
189+sendFileCount :: Integer
190+sendFileCount = 65536
191+
189192data InvalidRequest =
190193 NotEnoughLines [String]
191194 | BadFirstLine String
@@ -296,13 +299,23 @@ hasBody s req = s /= (Status 204 "") && requestMethod req /= "HEAD"
296299
297300sendResponse :: T.Handle
298301 -> Request -> HttpVersion -> Socket -> Response -> IO Bool
299−sendResponse _FIXMEth req hv socket (ResponseFile s hs fp) = do
302+sendResponse th req hv socket (ResponseFile s hs fp) = do
300303 Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
301304 if hasBody s req
302305 then do
303− sendFile socket fp -- FIXME tickle the timeout here
306+ sendFileIterWith tickler socket fp sendFileCount
304307 return $ lookup "content-length" hs /= Nothing
305308 else return True
309+ where
310+ tickler iter = do
311+ r <- iter
312+ case r of
313+ Done _ -> return ()
314+ Sent _ cont -> T.tickle th >> tickler cont
315+ WouldBlock _ fd cont -> do
316+ -- FIXME do we want to tickle here?
317+ threadWaitWrite fd
318+ tickler cont
306319sendResponse _FIXMEth req hv socket (ResponseBuilder s hs b)
307320 | hasBody s req = do
308321 toByteStringIO (Sock.sendAll socket) b'