@@ -3,7 +3,6 @@
33module Network.Wai.Handler.Warp.SendFile where
44
55import Data.ByteString.Internal
6−import Data.Word (Word8)
76import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)
87import Network.Sendfile
98import Network.Socket (Socket)
@@ -11,10 +10,11 @@ import Network.Wai.Handler.Warp.Buffer
1110import Network.Wai.Handler.Warp.Types
1211
1312#ifdef WINDOWS
14−import Control.Monad (when, void)
13+import Control.Monad (when)
1514import qualified System.IO as IO
1615import Foreign.Ptr (plusPtr)
1716#else
17+import Data.Word (Word8)
1818import Control.Exception
1919import Foreign.C.Types
2020import Foreign.Ptr (Ptr, castPtr, plusPtr)
@@ -63,6 +63,11 @@ packHeader buf siz send hook (PS bsfp off len : bss) n
6363 where
6464 room = siz - n
6565
66+mini :: Int -> Integer -> Int
67+mini i n
68+ | fromIntegral i < n = i
69+ | otherwise = fromIntegral n
70+
6671#ifdef WINDOWS
6772readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
6873readSendFile buf siz send fid off0 len0 hook headers = do
@@ -72,23 +77,24 @@ readSendFile buf siz send fid off0 len0 hook headers = do
7277 buf' = buf `plusPtr` hn
7378 IO.withBinaryFile path IO.ReadMode $ \h -> do
7479 IO.hSeek h IO.AbsoluteSeek off0
75− n <- IO.hGetBufSome h buf' room
80+ n <- IO.hGetBufSome h buf' (mini room len0)
7681 let bs = PS fptr 0 (hn + n)
77− len = len0 - fromIntegral n
82+ n' = fromIntegral n
7883 send bs
7984 hook
80− loop fptr h len
85+ loop h fptr (len0 - n')
8186 where
8287 path = fileIdPath fid
83− loop fptr h len
88+ loop h fptr len
8489 | len <= 0 = return ()
8590 | otherwise = do
86− n <- IO.hGetBufSome h buf siz
91+ n <- IO.hGetBufSome h buf (mini siz len)
8792 when (n /= 0) $ do
8893 let bs = PS fptr 0 n
94+ n' = fromIntegral n
8995 send bs
90− void $ hook
91− loop fptr h $ len - fromIntegral n
96+ hook
97+ loop h fptr (len - n')
9298#else
9399readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
94100readSendFile buf siz send fid off0 len0 hook headers =
@@ -111,9 +117,6 @@ readSendFile buf siz send fid off0 len0 hook headers =
111117 teardown fd = case fileIdFd fid of
112118 Just _ -> return ()
113119 Nothing -> closeFd fd
114− mini i n
115− | fromIntegral i < n = i
116− | otherwise = fromIntegral n
117120 loop fd fptr len off
118121 | len <= 0 = return ()
119122 | otherwise = do