@@ -18,20 +18,34 @@ import Foreign.Ptr
1818import qualified Network.HTTP.Types as H
1919import Network.HTTP2
2020import Network.HTTP2.Priority
21+import Network.Wai (FilePart(..))
2122import Network.Wai.HTTP2 (Trailers, promiseHeaders)
2223import Network.Wai.Handler.Warp.Buffer
24+import Network.Wai.Handler.Warp.FdCache (getFd)
25+import Network.Wai.Handler.Warp.SendFile (positionRead)
2326import Network.Wai.Handler.Warp.HTTP2.EncodeFrame
2427import Network.Wai.Handler.Warp.HTTP2.HPACK
2528import Network.Wai.Handler.Warp.HTTP2.Types
2629import Network.Wai.Handler.Warp.IORef
2730import qualified Network.Wai.Handler.Warp.Settings as S
31+import qualified Network.Wai.Handler.Warp.Timeout as T
2832import Network.Wai.Handler.Warp.Types
33+import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
34+import System.Posix.Types (Fd)
35+import qualified System.PosixCompat.Files as P
2936
3037----------------------------------------------------------------
3138
3239data Leftover = LZero
3340 | LOne B.BufferWriter
3441 | LTwo BS.ByteString B.BufferWriter
42+ | LFile OpenFile Integer Integer (IO ())
43+
44+#ifdef WINDOWS
45+type OpenFile = IO.Handle
46+#else
47+type OpenFile = Fd
48+#endif
3549
3650----------------------------------------------------------------
3751
@@ -138,7 +152,7 @@ frameSender ctx@Context{outputQ,connectionWindow}
138152 (off, needSend) <- sendHeadersIfNecessary total
139153 let payloadOff = off + frameHeaderLength
140154 Next datPayloadLen mnext <-
141− fillStreamBodyGetNext conn payloadOff lim sq tvar strm
155+ fillStreamBodyGetNext ii conn payloadOff lim sq tvar strm
142156 -- If no data was immediately available, avoid sending an
143157 -- empty data frame.
144158 if datPayloadLen > 0 then
@@ -240,19 +254,20 @@ frameSender ctx@Context{outputQ,connectionWindow}
240254
241255----------------------------------------------------------------
242256
243−fillStreamBodyGetNext :: Connection -> Int -> WindowSize -> TBQueue Sequence -> TVar Sync -> Stream -> IO Next
244−fillStreamBodyGetNext Connection{connWriteBuffer,connBufferSize}
257+fillStreamBodyGetNext :: InternalInfo -> Connection -> Int -> WindowSize
258+ -> TBQueue Sequence -> TVar Sync -> Stream -> IO Next
259+fillStreamBodyGetNext ii Connection{connWriteBuffer,connBufferSize}
245260 off lim sq tvar strm = do
246261 let datBuf = connWriteBuffer `plusPtr` off
247262 room = min (connBufferSize - off) lim
248− (leftover, cont, len) <- runStreamBuilder datBuf room sq
249− nextForStream connWriteBuffer connBufferSize sq tvar strm leftover cont len
263+ (leftover, cont, len) <- runStreamBuilder ii datBuf room sq
264+ nextForStream ii connWriteBuffer connBufferSize sq tvar strm leftover cont len
250265
251266----------------------------------------------------------------
252267
253−runStreamBuilder :: Buffer -> BufSize -> TBQueue Sequence
268+runStreamBuilder :: InternalInfo -> Buffer -> BufSize -> TBQueue Sequence
254269 -> IO (Leftover, Maybe Trailers, BytesFilled)
255−runStreamBuilder buf0 room0 sq = loop buf0 room0 0
270+runStreamBuilder ii buf0 room0 sq = loop buf0 room0 0
256271 where
257272 loop !buf !room !total = do
258273 mbuilder <- atomically $ tryReadTBQueue sq
@@ -265,16 +280,85 @@ runStreamBuilder buf0 room0 sq = loop buf0 room0 0
265280 B.Done -> loop (buf `plusPtr` len) (room - len) total'
266281 B.More _ writer -> return (LOne writer, Nothing, total')
267282 B.Chunk bs writer -> return (LTwo bs writer, Nothing, total')
283+ Just (SFile path mpart) -> do
284+ (leftover, len) <- runStreamFile ii buf room path mpart
285+ let !total' = total + len
286+ return (leftover, Nothing, total')
287+ -- TODO if file part is done, go back to loop
268288 Just SFlush -> return (LZero, Nothing, total)
269289 Just (SFinish trailers) -> return (LZero, Just trailers, total)
270290
271−fillBufStream :: Buffer -> BufSize -> Leftover -> TBQueue Sequence -> TVar Sync -> Stream -> DynaNext
272−fillBufStream buf0 siz0 leftover0 sq tvar strm lim0 = do
291+-- | Open the file, determine the range we should send, and start reading into
292+-- the send buffer.
293+runStreamFile :: InternalInfo -> Buffer -> BufSize -> FilePath -> Maybe FilePart
294+ -> IO (Leftover, BytesFilled)
295+
296+-- | Read the given (OS-specific) file representation into the buffer. On
297+-- non-Windows systems this uses pread; on Windows this ignores the position
298+-- because we use the Handle's internal read position instead (because it's not
299+-- potentially shared with other readers).
300+readOpenFile :: OpenFile -> Buffer -> BufSize -> Integer -> IO Int
301+
302+#ifdef WINDOWS
303+runStreamFile ii buf room path mpart = do
304+ (start, bytes) <- fileStartEnd path mpart
305+ -- fixme: how to close Handle? GC does it at this moment.
306+ h <- IO.openBinaryFile path IO.ReadMode
307+ IO.hSeek h IO.AbsoluteSeek start
308+ fillBufFile buf room h start bytes (return ())
309+
310+readOpenFile h buf room _ = IO.hGetBufSome h buf room
311+#else
312+runStreamFile ii buf room path mpart = do
313+ (start, bytes) <- fileStartEnd path mpart
314+ (fd, refresh) <- case fdCacher ii of
315+ Just fdcache -> getFd fdcache path
316+ Nothing -> do
317+ fd' <- openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}
318+ th <- T.register (timeoutManager ii) (closeFd fd')
319+ return (fd', T.tickle th)
320+ fillBufFile buf room fd start bytes refresh
321+
322+readOpenFile = positionRead
323+#endif
324+
325+-- | Read as much of the file as is currently available into the buffer, then
326+-- return a 'Leftover' to indicate whether this file chunk has more data to
327+-- send. If this read hit the end of the file range, return 'LZero'; otherwise
328+-- return 'LFile' so this stream will continue reading from the file the next
329+-- time it's pulled from the queue.
330+fillBufFile :: Buffer -> BufSize -> OpenFile -> Integer -> Integer -> (IO ())
331+ -> IO (Leftover, BytesFilled)
332+fillBufFile buf room f start bytes refresh = do
333+ len <- readOpenFile f buf (mini room bytes) start
334+ refresh
335+ let len' = fromIntegral len
336+ leftover = if bytes > len' then
337+ LFile f (start + len') (bytes - len') refresh
338+ else
339+ LZero
340+ return (leftover, len)
341+
342+fileStartEnd :: FilePath -> Maybe FilePart -> IO (Integer, Integer)
343+fileStartEnd path Nothing = do
344+ end <- fromIntegral . P.fileSize <$> P.getFileStatus path
345+ return (0, end)
346+fileStartEnd _ (Just part) =
347+ return (filePartOffset part, filePartByteCount part)
348+
349+mini :: Int -> Integer -> Int
350+mini i n
351+ | fromIntegral i < n = i
352+ | otherwise = fromIntegral n
353+
354+fillBufStream :: InternalInfo -> Buffer -> BufSize -> Leftover
355+ -> TBQueue Sequence -> TVar Sync -> Stream -> DynaNext
356+fillBufStream ii buf0 siz0 leftover0 sq tvar strm lim0 = do
273357 let payloadBuf = buf0 `plusPtr` frameHeaderLength
274358 room0 = min (siz0 - frameHeaderLength) lim0
275359 case leftover0 of
276360 LZero -> do
277− (leftover, end, len) <- runStreamBuilder payloadBuf room0 sq
361+ (leftover, end, len) <- runStreamBuilder ii payloadBuf room0 sq
278362 getNext leftover end len
279363 LOne writer -> write writer payloadBuf room0 0
280364 LTwo bs writer
@@ -286,13 +370,16 @@ fillBufStream buf0 siz0 leftover0 sq tvar strm lim0 = do
286370 let (bs1,bs2) = BS.splitAt room0 bs
287371 void $ copy payloadBuf bs1
288372 getNext (LTwo bs2 writer) Nothing room0
373+ LFile fd start bytes refresh -> do
374+ (leftover, len) <- fillBufFile payloadBuf room0 fd start bytes refresh
375+ getNext leftover Nothing len
289376 where
290− getNext = nextForStream buf0 siz0 sq tvar strm
377+ getNext = nextForStream ii buf0 siz0 sq tvar strm
291378 write writer1 buf room sofar = do
292379 (len, signal) <- writer1 buf room
293380 case signal of
294381 B.Done -> do
295− (leftover, end, extra) <- runStreamBuilder (buf `plusPtr` len) (room - len) sq
382+ (leftover, end, extra) <- runStreamBuilder ii (buf `plusPtr` len) (room - len) sq
296383 let !total = sofar + len + extra
297384 getNext leftover end total
298385 B.More _ writer -> do
@@ -302,15 +389,15 @@ fillBufStream buf0 siz0 leftover0 sq tvar strm lim0 = do
302389 let !total = sofar + len
303390 getNext (LTwo bs writer) Nothing total
304391
305−nextForStream :: Buffer -> BufSize -> TBQueue Sequence -> TVar Sync -> Stream
306− -> Leftover -> Maybe Trailers -> BytesFilled
307− -> IO Next
308−nextForStream _ _ _ tvar _ _ (Just trailers) len = do
392+nextForStream :: InternalInfo -> Buffer -> BufSize -> TBQueue Sequence
393+ -> TVar Sync -> Stream -> Leftover -> Maybe Trailers
394+ -> BytesFilled -> IO Next
395+nextForStream _ _ _ _ tvar _ _ (Just trailers) len = do
309396 atomically $ writeTVar tvar $ SyncFinish trailers
310397 return $ Next len CNone
311−nextForStream buf siz sq tvar strm LZero Nothing len = do
312− let out = ONext strm (fillBufStream buf siz LZero sq tvar strm)
398+nextForStream ii buf siz sq tvar strm LZero Nothing len = do
399+ let out = ONext strm (fillBufStream ii buf siz LZero sq tvar strm)
313400 atomically $ writeTVar tvar $ SyncNext out
314401 return $ Next len CNone
315−nextForStream buf siz sq tvar strm leftover Nothing len =
316− return $ Next len (CNext (fillBufStream buf siz leftover sq tvar strm))
402+nextForStream ii buf siz sq tvar strm leftover Nothing len =
403+ return $ Next len (CNext (fillBufStream ii buf siz leftover sq tvar strm))