c8482b4 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

introduing FileId to abstract sendfile.

c8482b4Kazu Yamamoto11 years ago

warp-tls/Network/Wai/Handler/WarpTLS.hs+2−2

compare with master

unifiedsplit

@@ -289,13 +289,13 @@ httpOverTls TLSSettings{..} s cachedRef params = do

289 , connSendFile = sendfile

290 , connClose = close

291 , connRecv = recv

292− , connSendFileOverride = NotOverride

293 , connBufferPool = pool

292 , connBufferPool = pool

294 , connWriteBuffer = writeBuf

293 , connWriteBuffer = writeBuf

295 , connBufferSize = bufferSize

294 , connBufferSize = bufferSize

296 }

295 }

297 where

296 where

298− sendfile fp offset len tickle' headers = do

297+ sendfile fid offset len tickle' headers = do

298+ let fp = fileIdPath fid

299 TLS.sendData ctx $ L.fromChunks headers

300 IO.withBinaryFile fp IO.ReadMode $ \h -> do

301 IO.hSeek h IO.AbsoluteSeek offset

warp/Network/Wai/Handler/Warp.hs+3−2

@@ -88,14 +88,15 @@ module Network.Wai.Handler.Warp (

88 , HostPreference (..)

89 , Port

90 , InvalidRequest (..)

91− , ConnSendFileOverride (..)

92 -- * Per-request utilities

91 -- * Per-request utilities

93 , pauseTimeout

92 , pauseTimeout

94 -- * Connection

93 -- * Connection

95 , Connection (..)

94 , Connection (..)

95+ , SendFile

96+ , FileId (..)

96 , socketConnection

97 , socketConnection

97 , newBufferPool

98 , newBufferPool

98− -- * Internal

99+ -- * Internal

99 -- ** Version

100 -- ** Version

100 , warpVersion

101 , warpVersion

101 -- ** Data types

102 -- ** Data types

warp/Network/Wai/Handler/Warp/Response.hs+25−11

@@ -42,12 +42,13 @@ import Data.Monoid (mappend, mempty)

42import Data.Version (showVersion)

43import qualified Network.HTTP.Types as H

44import Network.Wai

45−import qualified Network.Wai.Handler.Warp.Date as D

46import Network.Wai.Handler.Warp.Buffer (toBlazeBuffer)

45import Network.Wai.Handler.Warp.Buffer (toBlazeBuffer)

46+import qualified Network.Wai.Handler.Warp.Date as D

47+import qualified Network.Wai.Handler.Warp.FdCache as F

47import Network.Wai.Handler.Warp.Header

48import Network.Wai.Handler.Warp.Header

48import Network.Wai.Handler.Warp.IO (toBufIOWith)

49import Network.Wai.Handler.Warp.IO (toBufIOWith)

49−import Network.Wai.Handler.Warp.ResponseHeader

50import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges)

51+import Network.Wai.Handler.Warp.ResponseHeader

51import qualified Network.Wai.Handler.Warp.Timeout as T

52import qualified Network.Wai.Handler.Warp.Timeout as T

52import Network.Wai.Handler.Warp.Types

53import Network.Wai.Handler.Warp.Types

53import Network.Wai.Internal

54import Network.Wai.Internal

@@ -181,7 +182,7 @@ sendResponse defServer conn ii req reqidxhdr src response = do

181 hs <- addServerAndDate hs0

182 hs <- addServerAndDate hs0

182 if hasBody s then do

183 if hasBody s then do

183 -- HEAD comes here even if it does not have body.

184 -- HEAD comes here even if it does not have body.

184− sendRsp conn ver s hs rsp

185+ sendRsp conn mfdc ver s hs rsp

185 T.tickle th

186 T.tickle th

186 return ret

187 return ret

187 else do

188 else do

@@ -195,6 +196,7 @@ sendResponse defServer conn ii req reqidxhdr src response = do

195 rspidxhdr = indexResponseHeader hs0

196 rspidxhdr = indexResponseHeader hs0

196 th = threadHandle ii

197 th = threadHandle ii

197 dc = dateCacher ii

198 dc = dateCacher ii

199+ mfdc = fdCacher ii

198 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr

200 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr

199 mRange = reqidxhdr ! idxRange

201 mRange = reqidxhdr ! idxRange

200 (isPersist,isChunked0) = infoFromRequest req reqidxhdr

202 (isPersist,isChunked0) = infoFromRequest req reqidxhdr

@@ -222,28 +224,40 @@ data Rsp = RspFile FilePath (Maybe FilePart) (Maybe HeaderValue) Bool (IO ())

222----------------------------------------------------------------

224----------------------------------------------------------------

223

225

224sendRsp :: Connection

226sendRsp :: Connection

227+ -> Maybe F.MutableFdCache

225 -> H.HttpVersion

228 -> H.HttpVersion

226 -> H.Status

229 -> H.Status

227 -> H.ResponseHeaders

230 -> H.ResponseHeaders

228 -> Rsp

231 -> Rsp

229 -> IO ()

232 -> IO ()

230−sendRsp conn ver s0 hs0 (RspFile path mPart mRange isHead hook) = do

233+sendRsp conn mfdc ver s0 hs0 (RspFile path mPart mRange isHead hook) = do

231 ex <- fileRange s0 hs path mPart mRange

234 ex <- fileRange s0 hs path mPart mRange

232 case ex of

235 case ex of

233 Left _ex ->

236 Left _ex ->

234#ifdef WARP_DEBUG

237#ifdef WARP_DEBUG

235 print _ex >>

238 print _ex >>

236#endif

239#endif

237− sendRsp conn ver s2 hs2 (RspBuilder body True)

240+ sendRsp conn mfdc ver s2 hs2 (RspBuilder body True)

238 Right (s, hs1, beg, len)

241 Right (s, hs1, beg, len)

239 | len >= 0 ->

242 | len >= 0 ->

240 if isHead then

243 if isHead then

241− sendRsp conn ver s hs1 (RspBuilder mempty False)

244+ sendRsp conn mfdc ver s hs1 (RspBuilder mempty False)

242 else do

245 else do

243 lheader <- composeHeader ver s hs1

246 lheader <- composeHeader ver s hs1

247+#ifdef SENDFILEFD

248+ (mfd, hook') <- case mfdc of

249+ Nothing -> return (Nothing, hook)

250+ Just fdc -> do

251+ (fd, fresher) <- F.getFd fdc path

252+ return (Just fd, hook >> fresher)

253+ let fid = FileId path mfd

254+#else

255+ let fid = FileId path Nothing

256+ hook' = hook

257+#endif

244− connSendFile conn path beg len hook [lheader]

258+ connSendFile conn fid beg len hook' [lheader]

245 | otherwise -> do

259 | otherwise -> do

246− sendRsp conn ver H.status416

260+ sendRsp conn mfdc ver H.status416

247 (filter (\(k, _) -> k /= "content-length") hs1)

261 (filter (\(k, _) -> k /= "content-length") hs1)

248 (RspBuilder mempty True)

262 (RspBuilder mempty True)

249 where

263 where

@@ -254,7 +268,7 @@ sendRsp conn ver s0 hs0 (RspFile path mPart mRange isHead hook) = do

254

268

255----------------------------------------------------------------

269----------------------------------------------------------------

256

270

257−sendRsp conn ver s hs (RspBuilder body needsChunked) = do

271+sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do

258 header <- composeHeaderBuilder ver s hs needsChunked

272 header <- composeHeaderBuilder ver s hs needsChunked

259 let hdrBdy

273 let hdrBdy

260 | needsChunked = header <> chunkedTransferEncoding body

274 | needsChunked = header <> chunkedTransferEncoding body

@@ -266,7 +280,7 @@ sendRsp conn ver s hs (RspBuilder body needsChunked) = do

266

280

267----------------------------------------------------------------

281----------------------------------------------------------------

268

282

269−sendRsp conn ver s hs (RspStream streamingBody needsChunked th) = do

283+sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do

270 header <- composeHeaderBuilder ver s hs needsChunked

284 header <- composeHeaderBuilder ver s hs needsChunked

271 (recv, finish) <- newBlazeRecv $ reuseBufferStrategy

285 (recv, finish) <- newBlazeRecv $ reuseBufferStrategy

272 $ toBlazeBuffer (connWriteBuffer conn) (connBufferSize conn)

286 $ toBlazeBuffer (connWriteBuffer conn) (connBufferSize conn)

@@ -289,7 +303,7 @@ sendRsp conn ver s hs (RspStream streamingBody needsChunked th) = do

289

303

290----------------------------------------------------------------

304----------------------------------------------------------------

291

305

292−sendRsp conn _ _ _ (RspRaw withApp src tickle) =

306+sendRsp conn _ _ _ _ (RspRaw withApp src tickle) =

293 withApp recv send

307 withApp recv send

294 where

308 where

295 recv = do

309 recv = do

warp/Network/Wai/Handler/Warp/Run.hs+1−3

@@ -59,7 +59,6 @@ socketConnection s = do

59 , connBufferPool = bufferPool

60 , connWriteBuffer = writeBuf

61 , connBufferSize = bufferSize

62− , connSendFileOverride = Override s

63 }

62 }

65#if __GLASGOW_HASKELL__ < 702

64#if __GLASGOW_HASKELL__ < 702

@@ -268,14 +267,13 @@ fork set mkConn addr app dc fc tm counter = settingsFork set $ \ unmask ->

268 -- We grab the connection before registering timeouts since the

267 -- We grab the connection before registering timeouts since the

269 -- timeouts will be useless during connection creation, due to the

268 -- timeouts will be useless during connection creation, due to the

270 -- fact that async exceptions are still masked.

269 -- fact that async exceptions are still masked.

271− bracket mkConn closeConn $ \(conn0, transport) ->

270+ bracket mkConn closeConn $ \(conn, transport) ->

272

271

273 -- We need to register a timeout handler for this thread, and

272 -- We need to register a timeout handler for this thread, and

274 -- cancel that handler as soon as we exit.

273 -- cancel that handler as soon as we exit.

275 bracket (T.registerKillThread tm) T.cancel $ \th ->

274 bracket (T.registerKillThread tm) T.cancel $ \th ->

276

275

277 let ii = InternalInfo th fc dc

276 let ii = InternalInfo th fc dc

278− conn = setSendFile conn0 fc

279 -- We now have fully registered a connection close handler

277 -- We now have fully registered a connection close handler

280 -- in the case of all exceptions, so it is safe to one

278 -- in the case of all exceptions, so it is safe to one

281 -- again allow async exceptions.

279 -- again allow async exceptions.

warp/Network/Wai/Handler/Warp/SendFile.hs+12−19

@@ -2,28 +2,21 @@

3module Network.Wai.Handler.Warp.SendFile where

5−import Data.ByteString (ByteString)

6import Network.Sendfile

5import Network.Sendfile

7import Network.Socket (Socket)

6import Network.Socket (Socket)

8−import qualified Network.Wai.Handler.Warp.FdCache as F

9import Network.Wai.Handler.Warp.Types

7import Network.Wai.Handler.Warp.Types

11−defaultSendFile :: Socket -> FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO ()

9+defaultSendFile :: Socket -> SendFile

12−defaultSendFile s path off len act hdr = sendfileWithHeader s path (PartOfFile off len) act hdr

13−

14−

15−#if SENDFILEFD

10+#ifdef SENDFILEFD

16−setSendFile :: Connection -> Maybe F.MutableFdCache -> Connection

11+defaultSendFile s fid off len act hdr = case mfid of

17−setSendFile conn Nothing = conn

12+ Nothing -> sendfileWithHeader s path (PartOfFile off len) act hdr

18−setSendFile conn (Just fdcs) = case connSendFileOverride conn of

13+ Just fd -> sendfileFdWithHeader s fd (PartOfFile off len) act hdr

19− NotOverride -> conn

14+ where

20− Override s -> conn { connSendFile = sendFile fdcs s }

15+ path = fileIdPath fid

21−

16+ mfid = fileIdFd fid

22−sendFile :: F.MutableFdCache -> Socket -> FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO ()

23−sendFile fdcs s path off len act hdr = do

24− (fd, fresher) <- F.getFd fdcs path

25− sendfileFdWithHeader s fd (PartOfFile off len) (act>>fresher) hdr

26#else

17#else

27−setSendFile :: Connection -> Maybe F.MutableFdCache -> Connection

18+defaultSendFile s fid off len act hdr =

28−setSendFile conn _ = conn

19+ sendfileWithHeader s path (PartOfFile off len) act hdr

20+ where

21+ path = fileIdPath fid

29#endif

22#endif

warp/Network/Wai/Handler/Warp/Types.hs+22−15

@@ -17,6 +17,10 @@ import qualified Network.Wai.Handler.Warp.Date as D

17import qualified Network.Wai.Handler.Warp.FdCache as F

18import qualified Network.Wai.Handler.Warp.Timeout as T

20+#ifdef SENDFILEFD

21+import System.Posix.Types (Fd)

22+#endif

23+

20----------------------------------------------------------------

24----------------------------------------------------------------

22-- | TCP port number.

26-- | TCP port number.

@@ -64,25 +68,28 @@ instance Exception InvalidRequest

65----------------------------------------------------------------

69----------------------------------------------------------------

67−-- | Whether or not 'ConnSendFileOverride' in 'Connection' can be

71+#ifndef SENDFILEFD

68−-- overridden. This is a kind of hack to keep the signature of

72+type Fd = ()

69−-- 'Connection' clean.

73+#endif

70−data ConnSendFileOverride = NotOverride -- ^ Don't override

71− | Override Socket -- ^ Override with this 'Socket'

73−----------------------------------------------------------------

75+data FileId = FileId {

76+ fileIdPath :: FilePath

77+ , fileIdFd :: Maybe Fd

78+ }

79+

80+-- | fileid, offset, length, hook action, HTTP headers

81+type SendFile = FileId -> Integer -> Integer -> IO () -> [ByteString] -> IO ()

75-- | Data type to manipulate IO actions for connections.

83-- | Data type to manipulate IO actions for connections.

76data Connection = Connection

84data Connection = Connection

77− { connSendMany :: [ByteString] -> IO ()

85+ { connSendMany :: [ByteString] -> IO ()

78− , connSendAll :: ByteString -> IO ()

86+ , connSendAll :: ByteString -> IO ()

79− , connSendFile :: FilePath -> Integer -> Integer -> IO () -> [ByteString] -> IO () -- ^ filepath, offset, length, hook action, HTTP headers

87+ , connSendFile :: SendFile

80− , connClose :: IO ()

88+ , connClose :: IO ()

81− , connRecv :: IO ByteString

89+ , connRecv :: IO ByteString

82− , connBufferPool :: BufferPool

90+ , connBufferPool :: BufferPool

83− , connWriteBuffer :: Buffer

91+ , connWriteBuffer :: Buffer

84− , connBufferSize :: BufSize -- ^ The size of 'connWriteBuffer'

92+ , connBufferSize :: BufSize -- ^ The size of 'connWriteBuffer'

85− , connSendFileOverride :: ConnSendFileOverride

86 }

93 }

88----------------------------------------------------------------

95----------------------------------------------------------------