diff --git a/warp/Network/Wai/Handler/Warp/RequestHeader.hs b/warp/Network/Wai/Handler/Warp/RequestHeader.hs index fe357a2f..e002ef76 100644 --- a/warp/Network/Wai/Handler/Warp/RequestHeader.hs +++ b/warp/Network/Wai/Handler/Warp/RequestHeader.hs @@ -137,23 +137,21 @@ parseByteRanges bs1 = do (r, bs3) <- range bs2 ranges (r:) bs3 where - range bs2 = - case stripPrefix "-" bs2 of - Just bs3 -> do - (i, bs4) <- B.readInteger bs3 - Just (HH.ByteRangeSuffix i, bs4) - Nothing -> do - (i, bs3) <- B.readInteger bs2 + range bs2 = do + (i, bs3) <- B.readInteger bs2 + if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-") + then Just (HH.ByteRangeSuffix (negate i), bs3) + else do bs4 <- stripPrefix "-" bs3 case B.readInteger bs4 of - Nothing -> Just (HH.ByteRangeFrom i, bs4) - Just (j, bs5) -> Just (HH.ByteRangeFromTo i j, bs5) - ranges front bs3 = - case stripPrefix "," bs3 of - Nothing -> Just (front []) - Just bs4 -> do - (r, bs5) <- range bs4 - ranges (front . (r:)) bs5 + Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5) + _ -> Just (HH.ByteRangeFrom i, bs4) + ranges front bs3 + | S.null bs3 = Just (front []) + | otherwise = do + bs4 <- stripPrefix "," bs3 + (r, bs5) <- range bs4 + ranges (front . (r:)) bs5 stripPrefix x y | x `S.isPrefixOf` y = Just (S.drop (S.length x) y) diff --git a/warp/Network/Wai/Handler/Warp/Response.hs b/warp/Network/Wai/Handler/Warp/Response.hs index 39a44ab3..1fe2ccad 100644 --- a/warp/Network/Wai/Handler/Warp/Response.hs +++ b/warp/Network/Wai/Handler/Warp/Response.hs @@ -30,9 +30,9 @@ import Data.Function (on) import Data.List (deleteBy) import Data.Maybe (isJust, listToMaybe) #if MIN_VERSION_base(4,5,0) -import Data.Monoid ((<>)) +import Data.Monoid ((<>), mempty) #else -import Data.Monoid (mappend) +import Data.Monoid (mappend, mempty) #endif import Data.Version (showVersion) import qualified Network.HTTP.Types as H @@ -109,8 +109,8 @@ checkPartRange fileSize = checkPart isEntire = beg == 0 && len == fileSize checkRange (H.ByteRangeFrom beg) = fromRange beg (fileSize - 1) - checkRange (H.ByteRangeFromTo beg end) = fromRange beg end - checkRange (H.ByteRangeSuffix count) = fromRange (fileSize - count) (fileSize - 1) + checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (fileSize - 1) end) + checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (fileSize - count)) (fileSize - 1) fromRange beg end = (beg, end, len, isEntire) where @@ -225,9 +225,11 @@ sendRsp conn ver s0 hs0 (RspFile path mPart mRange hook) = do print _ex >> #endif sendRsp conn ver s2 hs2 (RspBuilder body True) - Right (s, hs1, beg, len) -> do + Right (s, hs1, beg, len) | len > 0 -> do lheader <- composeHeader ver s hs1 connSendFile conn path beg len hook [lheader] + | otherwise -> do + sendRsp conn ver H.status416 hs1 (RspBuilder mempty True) where hs = addAcceptRanges hs0 s2 = H.status404 @@ -373,11 +375,12 @@ addContentRange beg end total hdrs = (hContentRange, range) : hdrs range = B.pack -- building with ShowS $ 'b' : 'y': 't' : 'e' : 's' : ' ' - : showInt beg - ( '-' - : showInt end + : (if beg > end then ('*':) else + (showInt beg) + . ('-' :) + . (showInt end)) ( '/' - : showInt total "")) + : showInt total "") addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders addDate dc rspidxhdr hdrs = case rspidxhdr ! idxDate of diff --git a/warp/test/ResponseSpec.hs b/warp/test/ResponseSpec.hs index 771e052c..a5a6bb07 100644 --- a/warp/test/ResponseSpec.hs +++ b/warp/test/ResponseSpec.hs @@ -19,7 +19,7 @@ main = hspec spec testRange :: S.ByteString -- ^ range value -> String -- ^ expected output - -> String -- ^ expected content-range value + -> Maybe String -- ^ expected content-range value -> Spec testRange range out crange = it title $ withApp defaultSettings app $ \port -> do handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port @@ -31,9 +31,9 @@ testRange range out crange = it title $ withApp defaultSettings app $ \port -> d threadDelay 10000 bss <- fmap (lines . filter (/= '\r') . S8.unpack) $ S.hGetSome handle 1024 hClose handle - out `shouldBe` last bss + last bss `shouldBe` out let hs = mapMaybe toHeader bss - lookup "Content-Range" hs `shouldBe` Just ("bytes " ++ crange) + lookup "Content-Range" hs `shouldBe` fmap ("bytes " ++) crange lookup "Content-Length" hs `shouldBe` Just (show $ length $ last bss) where app _ = ($ responseFile status200 [] "attic/hex" Nothing) @@ -83,10 +83,12 @@ testFileRange desc s rsphdr file mPart mRange ans = it desc $ do spec :: Spec spec = do describe "range requests" $ do - testRange "2-3" "23" "2-3/16" - testRange "5-" "56789abcdef" "5-15/16" - testRange "5-8" "5678" "5-8/16" - testRange "-3" "def" "13-15/16" + testRange "2-3" "23" $ Just "2-3/16" + testRange "5-" "56789abcdef" $ Just "5-15/16" + testRange "5-8" "5678" $ Just "5-8/16" + testRange "-3" "def" $ Just "13-15/16" + testRange "16-" "" $ Just "*/16" + testRange "-17" "0123456789abcdef" Nothing describe "partial files" $ do testPartial 16 2 2 "23" @@ -114,6 +116,10 @@ spec = do "gets a file size from file system and handles Range and returns Partical Content" status200 [] "attic/hex" Nothing (Just "bytes=2-14") $ Right (status206,[("Content-Range","bytes 2-14/16"),("Content-Length","13")],2,13) + testFileRange + "truncates end point of range to file size" + status200 [] "attic/hex" Nothing (Just "bytes=10-20") + $ Right (status206,[("Content-Range","bytes 10-15/16"),("Content-Length","6")],10,6) testFileRange "gets a file size from file system and handles Range and returns OK if Range means the entire" status200 [] "attic/hex" Nothing (Just "bytes=0-15")