@@ -12,6 +12,7 @@ import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTe
1212import Control.Applicative
1313import Control.Exception
1414import Control.Monad.IO.Class (liftIO)
15+import Data.Array ((!))
1516import Data.ByteString (ByteString)
1617import qualified Data.ByteString.Char8 as B (pack)
1718import qualified Data.CaseInsensitive as CI
@@ -20,17 +21,18 @@ import Data.Conduit.Blaze (builderToByteString)
2021import qualified Data.Conduit.List as CL
2122import Data.Maybe (isJust, listToMaybe)
2223import Data.Monoid (mappend)
24+import Network.HTTP.Attoparsec (parseByteRanges)
2325import qualified Network.HTTP.Types as H
2426import Network.Wai
25−import Network.Wai.Internal
27+import Network.Wai.Handler.Warp.Header
2628import Network.Wai.Handler.Warp.ReadInt
27−import Network.Wai.Handler.Warp.Settings
2829import qualified Network.Wai.Handler.Warp.ResponseHeader as RH
30+import Network.Wai.Handler.Warp.Settings
2931import qualified Network.Wai.Handler.Warp.Timeout as T
3032import Network.Wai.Handler.Warp.Types
31−import qualified System.PosixCompat.Files as P
32−import Network.HTTP.Attoparsec (parseByteRanges)
33+import Network.Wai.Internal
3334import Numeric (showInt)
35+import qualified System.PosixCompat.Files as P
3436
3537----------------------------------------------------------------
3638----------------------------------------------------------------
@@ -38,12 +40,13 @@ import Numeric (showInt)
3840sendResponse :: Settings
3941 -> InternalInfo -> Request -> Connection
4042 -> (forall a. IO a -> IO a) -- ^ restore masking state
43+ -> IndexedHeader
4144 -> Response
4245 -> IO Bool
4346
4447----------------------------------------------------------------
4548
46−sendResponse settings ii req conn restore (ResponseFile s0 hs0 path mpart0) =
49+sendResponse settings ii req conn restore reqidxhdr (ResponseFile s0 hs0 path mpart0) =
4750 restore $ headerAndLength >>= sendResponse'
4851 where
4952 hs = addAccept hs0
@@ -60,14 +63,13 @@ sendResponse settings ii req conn restore (ResponseFile s0 hs0 path mpart0) =
6063 let (s, addRange, beg, end) =
6164 case mpart0 of
6265 Just part -> (s0, id, filePartOffset part, filePartByteCount part)
63− Nothing ->
64− case lookup H.hRange (requestHeaders req) >>= parseByteRanges >>= listToMaybe of
65− Just range | s0 == H.status200 ->
66− case range of
67− H.ByteRangeFrom from -> rangeRes cl from (cl - 1)
68− H.ByteRangeFromTo from to -> rangeRes cl from to
69− H.ByteRangeSuffix count -> rangeRes cl (cl - count) (cl - 1)
70− _ -> (s0, id, 0, cl)
66+ Nothing -> case reqidxhdr ! idxRange >>= parseByteRanges >>= listToMaybe of
67+ Just range | s0 == H.status200 ->
68+ case range of
69+ H.ByteRangeFrom from -> rangeRes cl from (cl - 1)
70+ H.ByteRangeFromTo from to -> rangeRes cl from to
71+ H.ByteRangeSuffix count -> rangeRes cl (cl - count) (cl - 1)
72+ _ -> (s0, id, 0, cl)
7173 hs'
7274 | hadLength = hs
7375 | otherwise = addLength end hs
@@ -95,16 +97,16 @@ sendResponse settings ii req conn restore (ResponseFile s0 hs0 path mpart0) =
9597 return isPersist -- FIXME isKeepAlive?
9698 where
9799 version = httpVersion req
98− (isPersist,_) = infoFromRequest req
100+ (isPersist,_) = infoFromRequest req reqidxhdr
99101
100102 sendResponse' (Left (_ :: SomeException)) =
101− sendResponse settings ii req conn restore notFound
103+ sendResponse settings ii req conn restore reqidxhdr notFound
102104 where
103105 notFound = responseLBS H.status404 [(H.hContentType, "text/plain")] "File not found"
104106
105107----------------------------------------------------------------
106108
107−sendResponse settings ii req conn restore (ResponseBuilder s hs b)
109+sendResponse settings ii req conn restore reqidxhdr (ResponseBuilder s hs b)
108110 | hasBody s req = restore $ do
109111 header <- composeHeaderBuilder settings version s hs needsChunked
110112 let body
@@ -122,12 +124,12 @@ sendResponse settings ii req conn restore (ResponseBuilder s hs b)
122124 where
123125 th = threadHandle ii
124126 version = httpVersion req
125− reqinfo@(isPersist,_) = infoFromRequest req
127+ reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
126128 (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
127129
128130----------------------------------------------------------------
129131
130−sendResponse settings ii req conn restore (ResponseSource s hs withBodyFlush)
132+sendResponse settings ii req conn restore reqidxhdr (ResponseSource s hs withBodyFlush)
131133 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
132134 header <- liftIO $ composeHeaderBuilder settings version s hs needsChunked
133135 let src = CL.sourceList [header] `mappend` cbody bodyFlush
@@ -152,7 +154,7 @@ sendResponse settings ii req conn restore (ResponseSource s hs withBodyFlush)
152154 chunk :: Conduit Builder IO Builder
153155 chunk = await >>= maybe (yield chunkedTransferTerminator) (\x -> yield (chunkedTransferEncoding x) >> chunk)
154156 version = httpVersion req
155− reqinfo@(isPersist,_) = infoFromRequest req
157+ reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr
156158 (isKeepAlive, needsChunked) = infoFromResponse hs reqinfo
157159
158160----------------------------------------------------------------
@@ -177,16 +179,16 @@ connSink Connection { connSendAll = send } th =
177179
178180----------------------------------------------------------------
179181
180−infoFromRequest :: Request -> (Bool,Bool)
181−infoFromRequest req = (checkPersist req, checkChunk req)
182+infoFromRequest :: Request -> IndexedHeader -> (Bool,Bool)
183+infoFromRequest req reqidxhdr = (checkPersist req reqidxhdr, checkChunk req)
182184
183−checkPersist :: Request -> Bool
184−checkPersist req
185+checkPersist :: Request -> IndexedHeader -> Bool
186+checkPersist req reqidxhdr
185187 | ver == H.http11 = checkPersist11 conn
186188 | otherwise = checkPersist10 conn
187189 where
188190 ver = httpVersion req
189− conn = lookup H.hConnection $ requestHeaders req
191+ conn = reqidxhdr ! idxConnection
190192 checkPersist11 (Just x)
191193 | CI.foldCase x == "close" = False
192194 checkPersist11 _ = True