on master help sign in
Get file length when not provided
commita7e4a7d73dc584523d7ad43391bdf5e835d63807 authorMichael Snoyman <michael@snoyman.com> dateWed 22 Jun 2011, 10:52 (15 years ago) parent6221c23
4 files changed+34−4
Network/Wai/Handler/Warp.hs+25−3 file-nolen.hs+6 file.hs+2−1 warp.cabal+1
Network/Wai/Handler/Warp.hs+25−3
@@ -81,6 +81,8 @@ import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
8181import Data.Monoid (mappend, mconcat)
8282import Network.Sendfile
8383
84+import qualified System.PosixCompat.Files as P
85+
8486import Control.Monad.IO.Class (liftIO)
8587import qualified Timeout as T
8688import Data.Word (Word8)
@@ -296,18 +298,38 @@ hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"
296298sendResponse :: T.Handle
297299 -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool
298300sendResponse th req hv socket (ResponseFile s hs fp mpart) = do
299− Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
301+ (hs', cl) <-
302+ case (mcl, mpart) of
303+ (Just cl, _) -> return (hs, cl)
304+ (Nothing, Nothing) -> do
305+ cl <- P.fileSize `fmap` P.getFileStatus fp
306+ return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
307+ (Nothing, Just part) -> do
308+ let cl = filePartByteCount part
309+ return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
310+ Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs' False
300311 if hasBody s req
301312 then do
302313 case mpart of
303− Nothing -> sendfile socket fp EntireFile (T.tickle th)
314+ Nothing -> sendfile socket fp PartOfFile {
315+ rangeOffset = 0
316+ , rangeLength = cl
317+ } (T.tickle th)
304318 Just part -> sendfile socket fp PartOfFile {
305319 rangeOffset = filePartOffset part
306320 , rangeLength = filePartByteCount part
307321 } (T.tickle th)
308322 T.tickle th
309− return $ lookup "content-length" hs /= Nothing
323+ return True
310324 else return True
325+ where
326+ clS = lookup "content-length" hs
327+ mcl = clS >>= readInt
328+ -- FIXME make this more efficient
329+ readInt bs =
330+ case reads $ B.unpack bs of
331+ (i, _):_ -> Just i
332+ [] -> Nothing
311333sendResponse th req hv socket (ResponseBuilder s hs b)
312334 | hasBody s req = do
313335 toByteStringIO (\bs -> do
file-nolen.hsnew file+6
@@ -0,0 +1,6 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Network.Wai
3+import Network.Wai.Handler.Warp
4+import Network.HTTP.Types
5+
6+main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain")] "test.txt" Nothing
file.hs+2−1
@@ -1,5 +1,6 @@
11{-# LANGUAGE OverloadedStrings #-}
22import Network.Wai
33import Network.Wai.Handler.Warp
4+import Network.HTTP.Types
45
5−main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain"), ("Content-Length", "16")] "test.txt"
6+main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain"), ("Content-Length", "16")] "test.txt" Nothing
warp.cabal+1
@@ -25,6 +25,7 @@ Library
2525 , simple-sendfile >= 0.1 && < 0.2
2626 , http-types >= 0.6 && < 0.7
2727 , case-insensitive >= 0.2 && < 0.3
28+ , unix-compat >= 0.2 && < 0.3
2829 if flag(network-bytestring)
2930 build-depends: network >= 2.2.1 && < 2.2.3
3031 , network-bytestring >= 0.1.3 && < 0.1.4