warp 0.4.0.1 → 0.4.1

raw patch · 2 files changed

+33/−24 lines, 2 filesdep +simple-sendfiledep +unix-compatdep −sendfile

Dependencies added: simple-sendfile, unix-compat

Dependencies removed: sendfile

Files

• Network/Wai/Handler/Warp.hs +30/−22
• warp.cabal +3/−2

@@ -39,6 +39,7 @@     , InvalidRequest (..) #if TEST     , takeHeaders+    , readInt #endif     ) where @@ -62,7 +63,7 @@     ( bracket, finally, Exception, SomeException, catch     , fromException     )-import Control.Concurrent (forkIO, threadWaitWrite)+import Control.Concurrent (forkIO) import qualified Data.Char as C import Data.Maybe (fromMaybe) @@ -79,8 +80,10 @@     (copyByteString, Builder, toLazyByteString, toByteStringIO) import Blaze.ByteString.Builder.Char8 (fromChar, fromShow) import Data.Monoid (mappend, mconcat)-import Network.Socket.SendFile (sendFileIterWith,sendFileIterWith', Iter (..))+import Network.Sendfile +import qualified System.PosixCompat.Files as P+ import Control.Monad.IO.Class (liftIO) import qualified Timeout as T import Data.Word (Word8)@@ -183,9 +186,6 @@ bytesPerRead = 4096 maxTotalHeaderLength = 50 * 1024 -sendFileCount :: Integer-sendFileCount = 65536- data InvalidRequest =     NotEnoughLines [String]     | BadFirstLine String@@ -299,27 +299,30 @@ sendResponse :: T.Handle              -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool sendResponse th req hv socket (ResponseFile s hs fp mpart) = do-    Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False+    (hs', cl) <-+        case (readInt `fmap` lookup "content-length" hs, mpart) of+            (Just cl, _) -> return (hs, cl)+            (Nothing, Nothing) -> do+                cl <- P.fileSize `fmap` P.getFileStatus fp+                return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)+            (Nothing, Just part) -> do+                let cl = filePartByteCount part+                return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)+    Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs' False     if hasBody s req         then do             case mpart of-                Nothing -> sendFileIterWith tickler socket fp sendFileCount-                Just part ->-                    sendFileIterWith' tickler socket fp sendFileCount-                        (filePartOffset part)-                        (filePartByteCount part)-            return $ lookup "content-length" hs /= Nothing+                Nothing   -> sendfile socket fp PartOfFile {+                    rangeOffset = 0+                  , rangeLength = cl+                  } (T.tickle th)+                Just part -> sendfile socket fp PartOfFile {+                    rangeOffset = filePartOffset part+                  , rangeLength = filePartByteCount part+                  } (T.tickle th)+            T.tickle th+            return True         else return True-  where-    tickler iter = do-        r <- iter-        case r of-            Done _ -> return ()-            Sent _ cont -> T.tickle th >> tickler cont-            WouldBlock _ fd cont -> do-                -- FIXME do we want to tickle here?-                threadWaitWrite fd-                tickler cont sendResponse th req hv socket (ResponseBuilder s hs b)     | hasBody s req = do           toByteStringIO (\bs -> do@@ -509,3 +512,8 @@         then p         else pos {-# INLINE checkCR #-}++-- Note: This function produces garbage on invalid input. But serving an+-- invalid content-length is a bad idea, mkay?+readInt :: S.ByteString -> Integer+readInt = S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0

@@ -1,5 +1,5 @@ Name:                warp-Version:             0.4.0.1+Version:             0.4.1 Synopsis:            A fast, light-weight web server for WAI applications. License:             BSD3 License-file:        LICENSE@@ -22,9 +22,10 @@                    , transformers                  >= 0.2      && < 0.3                    , enumerator                    >= 0.4.5    && < 0.5                    , blaze-builder                 >= 0.2.1.4  && < 0.4-                   , sendfile                      >= 0.7.2    && < 0.8+                   , simple-sendfile               >= 0.1      && < 0.2                    , http-types                    >= 0.6      && < 0.7                    , case-insensitive              >= 0.2      && < 0.3+                   , unix-compat                   >= 0.2      && < 0.3   if flag(network-bytestring)       build-depends: network               >= 2.2.1   && < 2.2.3                    , network-bytestring    >= 0.1.3   && < 0.1.4