@@ -19,11 +19,7 @@
1919--
2020---------------------------------------------------------
2121
22−-- | A fast, light-weight HTTP server handler for WAI. Some random notes (a FAQ, if you will):
23−--
24−-- * When a 'ResponseFile' indicates a file which does not exist, an exception
25−-- is thrown. This will close the connection to the client as well. You should
26−-- handle file existance checks at the application level.
22+-- | A fast, light-weight HTTP server handler for WAI.
2723module Network.Wai.Handler.Warp
2824 ( -- * Run a Warp server
2925 run
@@ -85,6 +81,7 @@ import Control.Exception
8581 , fromException, AsyncException (ThreadKilled)
8682 , bracketOnError
8783 , IOException
84+ , try
8885 )
8986import Control.Concurrent (forkIO)
9087import Data.Maybe (fromMaybe, isJust)
@@ -513,27 +510,33 @@ sendResponse th req conn r = sendResponse' r
513510 sendHeader = connSendMany conn . L.toChunks . toLazyByteString
514511
515512 sendResponse' :: Response -> ResourceT IO Bool
516− sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do
517− (lengthyHeaders, cl) <-
513+ sendResponse' (ResponseFile s hs fp mpart) = do
514+ eres <-
518515 case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of
519− (Just cl, _) -> return (hs, cl)
520− (Nothing, Nothing) -> do
516+ (Just cl, _) -> return $ Right (hs, cl)
517+ (Nothing, Nothing) -> liftIO $ try $ do
521518 cl <- P.fileSize `fmap` P.getFileStatus fp
522519 return $ addClToHeaders cl
523520 (Nothing, Just part) -> do
524521 let cl = filePartByteCount part
525− return $ addClToHeaders cl
526− let headers' = headers version s lengthyHeaders
527− sendHeader $ headers' False
528− T.tickle th
529− if hasBody s req then do
530− case mpart of
531− Nothing -> connSendFile conn fp 0 cl (T.tickle th)
532− Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)
533− T.tickle th
534− return isPersist
535− else
536− return isPersist
522+ return $ Right $ addClToHeaders cl
523+ case eres of
524+ Left (e :: SomeException) -> sendResponse' $ responseLBS
525+ H.status404
526+ [("Content-Type", "text/plain")]
527+ "File not found"
528+ Right (lengthyHeaders, cl) -> liftIO $ do
529+ let headers' = headers version s lengthyHeaders
530+ sendHeader $ headers' False
531+ T.tickle th
532+ if hasBody s req then do
533+ case mpart of
534+ Nothing -> connSendFile conn fp 0 cl (T.tickle th)
535+ Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)
536+ T.tickle th
537+ return isPersist
538+ else
539+ return isPersist
537540 where
538541 addClToHeaders cl = (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
539542