@@ -160,7 +160,12 @@ sendResponse :: ByteString -- ^ default server value
160 -> IO Bool -- ^ Returing True if the connection is persistent.
160 -> IO Bool -- ^ Returing True if the connection is persistent.
161sendResponse defServer conn ii req reqidxhdr src response = do
161sendResponse defServer conn ii req reqidxhdr src response = do
162 hs <- addServerAndDate hs0
162 hs <- addServerAndDate hs0
163− if hasBody req s then do
163+ if hasBody s then do
164+ -- The response to HEAD does not have body.
165+ -- But to handle the conditional requests defined RFC 7232 and
166+ -- to generate appropriate content-length, content-range,
167+ -- and status, the response to HEAD is processed here.
164 -- See definition of rsp below for proper body stripping.
169 -- See definition of rsp below for proper body stripping.
165 sendRsp conn ii ver s hs rsp
170 sendRsp conn ii ver s hs rsp
166 T.tickle th
171 T.tickle th
@@ -178,12 +183,18 @@ sendResponse defServer conn ii req reqidxhdr src response = do
178 dc = dateCacher ii
183 dc = dateCacher ii
179 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
184 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
180 mRange = reqidxhdr ! idxRange
185 mRange = reqidxhdr ! idxRange
181− (isPersist,isChunked) = infoFromRequest req reqidxhdr
186+ (isPersist,isChunked0) = infoFromRequest req reqidxhdr
187+ isChunked = not isHead && isChunked0
182 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist,isChunked)
188 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist,isChunked)
189+ isHead = requestMethod req == H.methodHead
183 rsp = case response of
190 rsp = case response of
184− ResponseFile _ _ path mPart -> RspFile path mPart mRange (T.tickle th)
191+ ResponseFile _ _ path mPart -> RspFile path mPart mRange isHead (T.tickle th)
192+ ResponseBuilder _ _ b
193+ | isHead -> RspBuilder mempty False
185− ResponseBuilder _ _ b -> RspBuilder b needsChunked
194+ | otherwise -> RspBuilder b needsChunked
195+ ResponseStream _ _ fb
196+ | isHead -> RspBuilder mempty False
186− ResponseStream _ _ fb -> RspStream fb needsChunked th
197+ | otherwise -> RspStream fb needsChunked th
187 ResponseRaw raw _ -> RspRaw raw src (T.tickle th)
198 ResponseRaw raw _ -> RspRaw raw src (T.tickle th)
188 ret = case response of
199 ret = case response of
189 ResponseFile {} -> isPersist
200 ResponseFile {} -> isPersist
@@ -218,7 +229,7 @@ sanitizeHeaderValue v = case S8.lines $ S.filter (/= _cr) v of
219----------------------------------------------------------------
230----------------------------------------------------------------
221−data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) (IO ())
232+data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) Bool (IO ())
222 | RspBuilder Builder Bool
233 | RspBuilder Builder Bool
223 | RspStream StreamingBody Bool T.Handle
234 | RspStream StreamingBody Bool T.Handle
224 | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
235 | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
@@ -232,7 +243,7 @@ sendRsp :: Connection
232 -> H.ResponseHeaders
243 -> H.ResponseHeaders
235−sendRsp conn ii ver s0 hs0 (RspFile path mPart mRange hook) = do
246+sendRsp conn ii ver s0 hs0 (RspFile path mPart mRange isHead hook) = do
236 ex <- fileRange s0 hs0 path mPart mRange get
247 ex <- fileRange s0 hs0 path mPart mRange get
237 case ex of
248 case ex of
238 Left _ex ->
249 Left _ex ->
@@ -241,21 +252,24 @@ sendRsp conn ii ver s0 hs0 (RspFile path mPart mRange hook) = do
242 sendRsp conn ii ver s2 hs2 (RspBuilder body True)
253 sendRsp conn ii ver s2 hs2 (RspBuilder body True)
243 Right (s, hs, beg, len)
254 Right (s, hs, beg, len)
244− | len >= 0 -> do
255+ | len >= 0 ->
257+ sendRsp conn ii ver s hs (RspBuilder mempty False)
245− lheader <- composeHeader ver s hs
259+ lheader <- composeHeader ver s hs
246#ifdef WINDOWS
260#ifdef WINDOWS
247− let fid = FileId path Nothing
261+ let fid = FileId path Nothing
248− hook' = hook
262+ hook' = hook
250− (mfd, hook') <- case mfdc of
264+ (mfd, hook') <- case mfdc of
251− -- settingsFdCacheDuration is 0
265+ -- settingsFdCacheDuration is 0
252− Nothing -> return (Nothing, hook)
266+ Nothing -> return (Nothing, hook)
253− Just fdc -> do
267+ Just fdc -> do
254− (fd, fresher) <- F.getFd fdc path
268+ (fd, fresher) <- F.getFd fdc path
255− return (Just fd, hook >> fresher)
269+ return (Just fd, hook >> fresher)
256− let fid = FileId path mfd
270+ let fid = FileId path mfd
258− connSendFile conn fid beg len hook' [lheader]
272+ connSendFile conn fid beg len hook' [lheader]
259 | otherwise ->
273 | otherwise ->
260 sendRsp conn ii ver H.status416
274 sendRsp conn ii ver H.status416
261 (filter (\(k, _) -> k /= "content-length") hs)
275 (filter (\(k, _) -> k /= "content-length") hs)
@@ -377,14 +391,12 @@ infoFromResponse rspidxhdr (isPersist,isChunked) = (isKeepAlive, needsChunked)
378----------------------------------------------------------------
392----------------------------------------------------------------
380−hasBody :: Request -> H.Status -> Bool
394+hasBody :: H.Status -> Bool
381−hasBody req s = not isHead
382− && sc /= 204
395+hasBody s = sc /= 204
383− && sc /= 304
396+ && sc /= 304
384− && sc >= 200
397+ && sc >= 200
386 sc = H.statusCode s
399 sc = H.statusCode s
387− isHead = requestMethod req == H.methodHead
389----------------------------------------------------------------
401----------------------------------------------------------------