git.iko.soy/typeable/wai
on master help sign in
fixing bugs of readSendFile on Windows.
f1e0350Kazu Yamamoto
warp/Network/Wai/Handler/Warp/SendFile.hs+15−12
compare with master
unifiedsplit
@@ -3,7 +3,6 @@
3module Network.Wai.Handler.Warp.SendFile where
3module Network.Wai.Handler.Warp.SendFile where
4
4
5import Data.ByteString.Internal
5import Data.ByteString.Internal
6−import Data.Word (Word8)
7import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)
6import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)
8import Network.Sendfile
7import Network.Sendfile
9import Network.Socket (Socket)
8import Network.Socket (Socket)
@@ -11,10 +10,11 @@ import Network.Wai.Handler.Warp.Buffer
11import Network.Wai.Handler.Warp.Types
10import Network.Wai.Handler.Warp.Types
12
11
13#ifdef WINDOWS
12#ifdef WINDOWS
14−import Control.Monad (when, void)
13+import Control.Monad (when)
15import qualified System.IO as IO
14import qualified System.IO as IO
16import Foreign.Ptr (plusPtr)
15import Foreign.Ptr (plusPtr)
17#else
16#else
17+import Data.Word (Word8)
18import Control.Exception
18import Control.Exception
19import Foreign.C.Types
19import Foreign.C.Types
20import Foreign.Ptr (Ptr, castPtr, plusPtr)
20import Foreign.Ptr (Ptr, castPtr, plusPtr)
@@ -63,6 +63,11 @@ packHeader buf siz send hook (PS bsfp off len : bss) n
63 where
63 where
64 room = siz - n
64 room = siz - n
65
65
66+mini :: Int -> Integer -> Int
67+mini i n
68+ | fromIntegral i < n = i
69+ | otherwise = fromIntegral n
70+
66#ifdef WINDOWS
71#ifdef WINDOWS
67readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
72readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
68readSendFile buf siz send fid off0 len0 hook headers = do
73readSendFile buf siz send fid off0 len0 hook headers = do
@@ -72,23 +77,24 @@ readSendFile buf siz send fid off0 len0 hook headers = do
72 buf' = buf `plusPtr` hn
77 buf' = buf `plusPtr` hn
73 IO.withBinaryFile path IO.ReadMode $ \h -> do
78 IO.withBinaryFile path IO.ReadMode $ \h -> do
74 IO.hSeek h IO.AbsoluteSeek off0
79 IO.hSeek h IO.AbsoluteSeek off0
75− n <- IO.hGetBufSome h buf' room
80+ n <- IO.hGetBufSome h buf' (mini room len0)
76 let bs = PS fptr 0 (hn + n)
81 let bs = PS fptr 0 (hn + n)
77− len = len0 - fromIntegral n
82+ n' = fromIntegral n
78 send bs
83 send bs
79 hook
84 hook
80− loop fptr h len
85+ loop h fptr (len0 - n')
81 where
86 where
82 path = fileIdPath fid
87 path = fileIdPath fid
83− loop fptr h len
88+ loop h fptr len
84 | len <= 0 = return ()
89 | len <= 0 = return ()
85 | otherwise = do
90 | otherwise = do
86− n <- IO.hGetBufSome h buf siz
91+ n <- IO.hGetBufSome h buf (mini siz len)
87 when (n /= 0) $ do
92 when (n /= 0) $ do
88 let bs = PS fptr 0 n
93 let bs = PS fptr 0 n
94+ n' = fromIntegral n
89 send bs
95 send bs
90− void $ hook
96+ hook
91− loop fptr h $ len - fromIntegral n
97+ loop h fptr (len - n')
92#else
98#else
93readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
99readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
94readSendFile buf siz send fid off0 len0 hook headers =
100readSendFile buf siz send fid off0 len0 hook headers =
@@ -111,9 +117,6 @@ readSendFile buf siz send fid off0 len0 hook headers =
111 teardown fd = case fileIdFd fid of
117 teardown fd = case fileIdFd fid of
112 Just _ -> return ()
118 Just _ -> return ()
113 Nothing -> closeFd fd
119 Nothing -> closeFd fd
114− mini i n
115− | fromIntegral i < n = i
116− | otherwise = fromIntegral n
117 loop fd fptr len off
120 loop fd fptr len off
118 | len <= 0 = return ()
121 | len <= 0 = return ()
119 | otherwise = do
122 | otherwise = do