on master help sign in
defaultSendFile uses readSendFile.
commit8dab1e50d49e8b4f986e5568827dfc7955c3ae77 authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 12 Jun 2015, 11:34 (11 years ago) parent02c4ffe
1 file changed+17−9
warp/Network/Wai/Handler/Warp/SendFile.hs+17−9
warp/Network/Wai/Handler/Warp/SendFile.hs+17−9
@@ -14,8 +14,10 @@ import Network.Wai.Handler.Warp.Types
1414import Control.Monad (when, void)
1515import qualified System.IO as IO
1616#else
17+import Control.Exception
1718import Foreign.C.Types
1819import Foreign.Ptr (Ptr, castPtr, plusPtr)
20+import System.Posix.IO (openFd, OpenFileFlags(..), defaultFileFlags, OpenMode(ReadOnly), closeFd)
1921import System.Posix.Types
2022#endif
2123
@@ -23,12 +25,11 @@ import System.Posix.Types
2325
2426defaultSendFile :: Socket -> Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
2527#ifdef SENDFILEFD
26−defaultSendFile s _ _ _ fid off len act hdr = case mfid of
27− Just fd -> sendfileFdWithHeader s fd (PartOfFile off len) act hdr
28+defaultSendFile s buf siz sendall fid off len act hdr = case mfid of
2829 -- settingsFdCacheDuration is 0
29− Nothing -> sendfileWithHeader s path (PartOfFile off len) act hdr
30+ Nothing -> readSendFile buf siz sendall fid off len act hdr
31+ Just fd -> sendfileFdWithHeader s fd (PartOfFile off len) act hdr
3032 where
31− path = fileIdPath fid
3233 mfid = fileIdFd fid
3334#else
3435defaultSendFile _ = readSendFile
@@ -88,7 +89,8 @@ readSendFile buf siz send fid off0 len0 hook headers = do
8889 loop fptr h $ len - fromIntegral n
8990#else
9091readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile
91−readSendFile buf siz send fid off0 len0 hook headers = do
92+readSendFile buf siz send fid off0 len0 hook headers =
93+ bracket setup teardown $ \fd -> do
9294 fptr <- newForeignPtr_ buf
9395 hn <- packHeader buf siz send hook headers 0
9496 let room = siz - hn
@@ -98,13 +100,19 @@ readSendFile buf siz send fid off0 len0 hook headers = do
98100 n' = fromIntegral n
99101 send bs
100102 hook
101− loop fptr (len0 - n') (off0 + n')
103+ loop fd fptr (len0 - n') (off0 + n')
102104 where
103− Just fd = fileIdFd fid -- fixme
105+ path = fileIdPath fid
106+ setup = case fileIdFd fid of
107+ Just fd -> return fd
108+ Nothing -> openFd path ReadOnly Nothing defaultFileFlags{nonBlock=True}
109+ teardown fd = case fileIdFd fid of
110+ Just _ -> return ()
111+ Nothing -> closeFd fd
104112 mini i n
105113 | fromIntegral i < n = i
106114 | otherwise = fromIntegral n
107− loop fptr len off
115+ loop fd fptr len off
108116 | len <= 0 = return ()
109117 | otherwise = do
110118 n <- positionRead fd buf (mini siz len) off
@@ -112,7 +120,7 @@ readSendFile buf siz send fid off0 len0 hook headers = do
112120 n' = fromIntegral n
113121 send bs
114122 hook
115− loop fptr (len - n') (off + n')
123+ loop fd fptr (len - n') (off + n')
116124
117125positionRead :: Fd -> Ptr Word8 -> Int -> Integer -> IO Int
118126positionRead (Fd fd) buf siz off =