c8482b4 · typeable/wai

git.iko.soy/typeable/wai

introduing FileId to abstract sendfile.

commitc8482b41e1c7ea35187a122be5bc5868d054b9ec authorKazu Yamamoto <kazu@iij.ad.jp> dateThu 11 Jun 2015, 11:41 (11 years ago) parentc754e6c

6 files changed+65−52

compare with master

unifiedsplit

warp-tls/Network/Wai/Handler/WarpTLS.hs+2−2 warp/Network/Wai/Handler/Warp.hs+3−2 warp/Network/Wai/Handler/Warp/Response.hs+25−11 warp/Network/Wai/Handler/Warp/Run.hs+1−3 warp/Network/Wai/Handler/Warp/SendFile.hs+12−19 warp/Network/Wai/Handler/Warp/Types.hs+22−15

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

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

289289 , connSendFile = sendfile

290290 , connClose = close

291291 , connRecv = recv

292− , connSendFileOverride = NotOverride

293292 , connBufferPool = pool

294293 , connWriteBuffer = writeBuf

295294 , connBufferSize = bufferSize

296295 }

297296 where

298− sendfile fp offset len tickle' headers = do

297+ sendfile fid offset len tickle' headers = do

298+ let fp = fileIdPath fid

299299 TLS.sendData ctx $ L.fromChunks headers

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

301301 IO.hSeek h IO.AbsoluteSeek offset

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

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

8888 , HostPreference (..)

8989 , Port

9090 , InvalidRequest (..)

91− , ConnSendFileOverride (..)

9291 -- * Per-request utilities

9392 , pauseTimeout

9493 -- * Connection

9594 , Connection (..)

95+ , SendFile

96+ , FileId (..)

9697 , socketConnection

9798 , newBufferPool

98− -- * Internal

99+ -- * Internal

99100 -- ** Version

100101 , warpVersion

101102 -- ** Data types

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

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

4242import Data.Version (showVersion)

4343import qualified Network.HTTP.Types as H

4444import Network.Wai

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

4645import 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

4748import Network.Wai.Handler.Warp.Header

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

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

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

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

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

5253import Network.Wai.Handler.Warp.Types

5354import Network.Wai.Internal

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

181182 hs <- addServerAndDate hs0

182183 if hasBody s then do

183184 -- 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

185186 T.tickle th

186187 return ret

187188 else do

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

195196 rspidxhdr = indexResponseHeader hs0

196197 th = threadHandle ii

197198 dc = dateCacher ii

199+ mfdc = fdCacher ii

198200 addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr

199201 mRange = reqidxhdr ! idxRange

200202 (isPersist,isChunked0) = infoFromRequest req reqidxhdr

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

222224----------------------------------------------------------------

223225

224226sendRsp :: Connection

227+ -> Maybe F.MutableFdCache

225228 -> H.HttpVersion

226229 -> H.Status

227230 -> H.ResponseHeaders

228231 -> Rsp

229232 -> 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

231234 ex <- fileRange s0 hs path mPart mRange

232235 case ex of

233236 Left _ex ->

234237#ifdef WARP_DEBUG

235238 print _ex >>

236239#endif

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

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

238241 Right (s, hs1, beg, len)

239242 | len >= 0 ->

240243 if isHead then

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

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

242245 else do

243246 lheader <- composeHeader ver s hs1

244− connSendFile conn path beg len hook [lheader]

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

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

245259 | otherwise -> do

246− sendRsp conn ver H.status416

260+ sendRsp conn mfdc ver H.status416

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

248262 (RspBuilder mempty True)

249263 where

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

254268

255269----------------------------------------------------------------

256270

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

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

258272 header <- composeHeaderBuilder ver s hs needsChunked

259273 let hdrBdy

260274 | needsChunked = header <> chunkedTransferEncoding body

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

266280

267281----------------------------------------------------------------

268282

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

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

270284 header <- composeHeaderBuilder ver s hs needsChunked

271285 (recv, finish) <- newBlazeRecv $ reuseBufferStrategy

272286 $ toBlazeBuffer (connWriteBuffer conn) (connBufferSize conn)

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

289303

290304----------------------------------------------------------------

291305

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

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

293307 withApp recv send

294308 where

295309 recv = do

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

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

5959 , connBufferPool = bufferPool

6060 , connWriteBuffer = writeBuf

6161 , connBufferSize = bufferSize

62− , connSendFileOverride = Override s

6362 }

6463

6564#if __GLASGOW_HASKELL__ < 702

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

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

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

270269 -- fact that async exceptions are still masked.

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

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

272271

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

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

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

276275

277276 let ii = InternalInfo th fc dc

278− conn = setSendFile conn0 fc

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

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

281279 -- again allow async exceptions.

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

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

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

5−import Data.ByteString (ByteString)

65import Network.Sendfile

76import Network.Socket (Socket)

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

97import Network.Wai.Handler.Warp.Types

108

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

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

13−

14−

15−#if SENDFILEFD

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

17−setSendFile conn Nothing = conn

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

19− NotOverride -> conn

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

21−

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

9+defaultSendFile :: Socket -> SendFile

10+#ifdef SENDFILEFD

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

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

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

14+ where

15+ path = fileIdPath fid

16+ mfid = fileIdFd fid

2617#else

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

28−setSendFile conn _ = conn

18+defaultSendFile s fid off len act hdr =

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

20+ where

21+ path = fileIdPath fid

2922#endif

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

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

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

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

1919

20+#ifdef SENDFILEFD

21+import System.Posix.Types (Fd)

22+#endif

23+

2024----------------------------------------------------------------

2125

2226-- | TCP port number.

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

6468

6569----------------------------------------------------------------

6670

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

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

69−-- 'Connection' clean.

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

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

71+#ifndef SENDFILEFD

72+type Fd = ()

73+#endif

7274

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 ()

7482

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

7684data Connection = Connection

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

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

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

80− , connClose :: IO ()

81− , connRecv :: IO ByteString

82− , connBufferPool :: BufferPool

83− , connWriteBuffer :: Buffer

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

85− , connSendFileOverride :: ConnSendFileOverride

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

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

87+ , connSendFile :: SendFile

88+ , connClose :: IO ()

89+ , connRecv :: IO ByteString

90+ , connBufferPool :: BufferPool

91+ , connWriteBuffer :: Buffer

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

8693 }

8794

8895----------------------------------------------------------------