@@ -160,7 +160,12 @@ sendResponse :: ByteString -- ^ default server value
160160 -> IO Bool -- ^ Returing True if the connection is persistent.
161161sendResponse defServer conn ii req reqidxhdr src response = do
162162 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.
168+ --
164169 -- See definition of rsp below for proper body stripping.
165170 sendRsp conn ii ver s hs rsp
166171 T.tickle th
@@ -178,12 +183,18 @@ sendResponse defServer conn ii req reqidxhdr src response = do
178183 dc = dateCacher ii
179184 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr
180185 mRange = reqidxhdr ! idxRange
181− (isPersist,isChunked) = infoFromRequest req reqidxhdr
186+ (isPersist,isChunked0) = infoFromRequest req reqidxhdr
187+ isChunked = not isHead && isChunked0
182188 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist,isChunked)
189+ isHead = requestMethod req == H.methodHead
183190 rsp = case response of
184− ResponseFile _ _ path mPart -> RspFile path mPart mRange (T.tickle th)
185− ResponseBuilder _ _ b -> RspBuilder b needsChunked
186− ResponseStream _ _ fb -> RspStream fb needsChunked th
191+ ResponseFile _ _ path mPart -> RspFile path mPart mRange isHead (T.tickle th)
192+ ResponseBuilder _ _ b
193+ | isHead -> RspBuilder mempty False
194+ | otherwise -> RspBuilder b needsChunked
195+ ResponseStream _ _ fb
196+ | isHead -> RspBuilder mempty False
197+ | otherwise -> RspStream fb needsChunked th
187198 ResponseRaw raw _ -> RspRaw raw src (T.tickle th)
188199 ret = case response of
189200 ResponseFile {} -> isPersist
@@ -218,7 +229,7 @@ sanitizeHeaderValue v = case S8.lines $ S.filter (/= _cr) v of
218229
219230----------------------------------------------------------------
220231
221−data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) (IO ())
232+data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) Bool (IO ())
222233 | RspBuilder Builder Bool
223234 | RspStream StreamingBody Bool T.Handle
224235 | RspRaw (IO ByteString -> (ByteString -> IO ()) -> IO ()) (IO ByteString) (IO ())
@@ -232,7 +243,7 @@ sendRsp :: Connection
232243 -> H.ResponseHeaders
233244 -> Rsp
234245 -> IO ()
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
236247 ex <- fileRange s0 hs0 path mPart mRange get
237248 case ex of
238249 Left _ex ->
@@ -241,21 +252,24 @@ sendRsp conn ii ver s0 hs0 (RspFile path mPart mRange hook) = do
241252#endif
242253 sendRsp conn ii ver s2 hs2 (RspBuilder body True)
243254 Right (s, hs, beg, len)
244− | len >= 0 -> do
245− lheader <- composeHeader ver s hs
255+ | len >= 0 ->
256+ if isHead then
257+ sendRsp conn ii ver s hs (RspBuilder mempty False)
258+ else do
259+ lheader <- composeHeader ver s hs
246260#ifdef WINDOWS
247− let fid = FileId path Nothing
248− hook' = hook
261+ let fid = FileId path Nothing
262+ hook' = hook
249263#else
250− (mfd, hook') <- case mfdc of
251− -- settingsFdCacheDuration is 0
252− Nothing -> return (Nothing, hook)
253− Just fdc -> do
254− (fd, fresher) <- F.getFd fdc path
255− return (Just fd, hook >> fresher)
256− let fid = FileId path mfd
264+ (mfd, hook') <- case mfdc of
265+ -- settingsFdCacheDuration is 0
266+ Nothing -> return (Nothing, hook)
267+ Just fdc -> do
268+ (fd, fresher) <- F.getFd fdc path
269+ return (Just fd, hook >> fresher)
270+ let fid = FileId path mfd
257271#endif
258− connSendFile conn fid beg len hook' [lheader]
272+ connSendFile conn fid beg len hook' [lheader]
259273 | otherwise ->
260274 sendRsp conn ii ver H.status416
261275 (filter (\(k, _) -> k /= "content-length") hs)
@@ -377,14 +391,12 @@ infoFromResponse rspidxhdr (isPersist,isChunked) = (isKeepAlive, needsChunked)
377391
378392----------------------------------------------------------------
379393
380−hasBody :: Request -> H.Status -> Bool
381−hasBody req s = not isHead
382− && sc /= 204
383− && sc /= 304
384− && sc >= 200
394+hasBody :: H.Status -> Bool
395+hasBody s = sc /= 204
396+ && sc /= 304
397+ && sc >= 200
385398 where
386399 sc = H.statusCode s
387− isHead = requestMethod req == H.methodHead
388400
389401----------------------------------------------------------------
390402