ea2f8aa · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

moving sendfile from WarpTLS to Warp.

ea2f8aaKazu Yamamoto11 years ago

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

compare with master

unifiedsplit

@@ -35,12 +35,11 @@ module Network.Wai.Handler.WarpTLS (

35import Control.Applicative ((<$>))

36#endif

37import Control.Exception (Exception, throwIO, bracket, finally, handle, fromException, try, IOException, onException)

38−import Control.Monad (unless, void)

38+import Control.Monad (void)

39import qualified Crypto.Random.AESCtr

40import qualified Data.ByteString as B

41import qualified Data.ByteString as S

42import qualified Data.ByteString.Lazy as L

43−import Data.ByteString.Lazy.Internal (defaultChunkSize)

44import Data.Default.Class (def)

43import Data.Default.Class (def)

45import qualified Data.IORef as I

44import qualified Data.IORef as I

46import Data.Streaming.Network (bindPortTCP, safeRecv)

45import Data.Streaming.Network (bindPortTCP, safeRecv)

@@ -52,7 +51,6 @@ import qualified Network.TLS.Extra as TLSExtra

52import Network.Wai (Application)

51import Network.Wai (Application)

53import Network.Wai.Handler.Warp

52import Network.Wai.Handler.Warp

54import Network.Wai.Handler.Warp.Buffer (allocateBuffer, bufferSize, freeBuffer)

53import Network.Wai.Handler.Warp.Buffer (allocateBuffer, bufferSize, freeBuffer)

55−import qualified System.IO as IO

56import System.IO.Error (isEOFError)

54import System.IO.Error (isEOFError)

58----------------------------------------------------------------

56----------------------------------------------------------------

@@ -285,7 +283,7 @@ httpOverTls TLSSettings{..} s cachedRef params = do

285 }

283 }

286 conn ctx pool writeBuf = Connection {

284 conn ctx pool writeBuf = Connection {

287 connSendMany = TLS.sendData ctx . L.fromChunks

285 connSendMany = TLS.sendData ctx . L.fromChunks

288− , connSendAll = TLS.sendData ctx . L.fromChunks . return

286+ , connSendAll = sendall

289 , connSendFile = sendfile

287 , connSendFile = sendfile

290 , connClose = close

288 , connClose = close

291 , connRecv = recv

289 , connRecv = recv

@@ -294,21 +292,9 @@ httpOverTls TLSSettings{..} s cachedRef params = do

294 , connBufferSize = bufferSize

292 , connBufferSize = bufferSize

295 }

293 }

296 where

294 where

297− sendfile fid offset len tickle' headers = do

298− let fp = fileIdPath fid

299− TLS.sendData ctx $ L.fromChunks headers

295+ sendall = TLS.sendData ctx . L.fromChunks . return

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

296+ sendfile fid offset len hook headers =

301− IO.hSeek h IO.AbsoluteSeek offset

297+ readSendFile writeBuf bufferSize sendall fid offset len hook headers

302− loop h $ fromIntegral len

303− where

304− loop _ remaining | remaining <= 0 = return ()

305− loop h remaining = do

306− bs <- B.hGetSome h defaultChunkSize

307− unless (B.null bs) $ do

308− let x = B.take remaining bs

309− TLS.sendData ctx $ L.fromChunks [x]

310− void $ tickle' -- This tickles the Timer. It MUST be called per chunk.

311− loop h $ remaining - B.length x

312

298

313 close = freeBuffer writeBuf `finally`

299 close = freeBuffer writeBuf `finally`

314 void (tryIO $ TLS.bye ctx) `finally`

300 void (tryIO $ TLS.bye ctx) `finally`

warp/Network/Wai/Handler/Warp.hs+9−7

@@ -96,6 +96,7 @@ module Network.Wai.Handler.Warp (

96 , FileId (..)

97 , socketConnection

98 , newBufferPool

99+ , readSendFile

99 -- * Internal

100 -- * Internal

100 -- ** Version

101 -- ** Version

101 , warpVersion

102 , warpVersion

@@ -115,6 +116,13 @@ module Network.Wai.Handler.Warp (

115 , sendResponse

116 , sendResponse

116 ) where

117 ) where

117

118

119+import Control.Exception (SomeException)

120+import Data.ByteString (ByteString)

121+import Data.Maybe (fromMaybe)

122+import Data.Streaming.Network (HostPreference)

123+import qualified Data.Vault.Lazy as Vault

124+import Network.Socket (SockAddr)

125+import Network.Wai (Request, Response, vault)

118import Network.Wai.Handler.Warp.Buffer

126import Network.Wai.Handler.Warp.Buffer

119import Network.Wai.Handler.Warp.Date

127import Network.Wai.Handler.Warp.Date

120import Network.Wai.Handler.Warp.FdCache

128import Network.Wai.Handler.Warp.FdCache

@@ -122,16 +130,10 @@ import Network.Wai.Handler.Warp.Header

122import Network.Wai.Handler.Warp.Request

130import Network.Wai.Handler.Warp.Request

123import Network.Wai.Handler.Warp.Response

131import Network.Wai.Handler.Warp.Response

124import Network.Wai.Handler.Warp.Run

132import Network.Wai.Handler.Warp.Run

133+import Network.Wai.Handler.Warp.SendFile

125import Network.Wai.Handler.Warp.Settings

134import Network.Wai.Handler.Warp.Settings

126import Network.Wai.Handler.Warp.Timeout

135import Network.Wai.Handler.Warp.Timeout

127import Network.Wai.Handler.Warp.Types

136import Network.Wai.Handler.Warp.Types

128−import Control.Exception (SomeException)

129−import Network.Wai (Request, Response, vault)

130−import Network.Socket (SockAddr)

131−import Data.Streaming.Network (HostPreference)

132−import Data.ByteString (ByteString)

133−import qualified Data.Vault.Lazy as Vault

134−import Data.Maybe (fromMaybe)

135

137

136-- | Port to listen on. Default value: 3000

138-- | Port to listen on. Default value: 3000

137--

139--

warp/Network/Wai/Handler/Warp/SendFile.hs+23

@@ -2,9 +2,14 @@

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

5+import Control.Monad (when, void)

6+import Data.ByteString.Internal

7+import Foreign.ForeignPtr (newForeignPtr_)

5import Network.Sendfile

8import Network.Sendfile

6import Network.Socket (Socket)

9import Network.Socket (Socket)

10+import Network.Wai.Handler.Warp.Buffer

7import Network.Wai.Handler.Warp.Types

11import Network.Wai.Handler.Warp.Types

12+import qualified System.IO as IO

9defaultSendFile :: Socket -> SendFile

14defaultSendFile :: Socket -> SendFile

10#ifdef SENDFILEFD

15#ifdef SENDFILEFD

@@ -20,3 +25,21 @@ defaultSendFile s fid off len act hdr =

20 where

25 where

21 path = fileIdPath fid

26 path = fileIdPath fid

22#endif

27#endif

28+

29+readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile

30+readSendFile buf siz send fid offset len hook headers = do

31+ mapM_ send headers

32+ fptr <- newForeignPtr_ buf

33+ IO.withBinaryFile path IO.ReadMode $ \h -> do

34+ IO.hSeek h IO.AbsoluteSeek offset

35+ loop fptr h $ fromIntegral len

36+ where

37+ path = fileIdPath fid

38+ loop _ _ remaining | remaining <= 0 = return ()

39+ loop fptr h remaining = do

40+ n <- IO.hGetBufSome h buf siz

41+ when (n /= 0) $ do

42+ let bs = PS fptr 0 n

43+ send bs

44+ void $ hook

45+ loop fptr h $ remaining - n