simple-sendfile (empty) → 0.0.0
raw patch · 9 files changed
+349/−0 lines, 9 filesdep +basedep +bytestringdep +enumeratorsetup-changed
Dependencies added: base, bytestring, enumerator, network, unix
Files
- LICENSE +29/−0
- Network/Sendfile.hs +23/−0
- Network/Sendfile/BSD.hsc +68/−0
- Network/Sendfile/Fallback.hs +37/−0
- Network/Sendfile/Linux.hsc +64/−0
- Network/Sendfile/MacOS.hsc +72/−0
- Network/Sendfile/Types.hs +10/−0
- Setup.hs +2/−0
- simple-sendfile.cabal +44/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in+ the documentation and/or other materials provided with the+ distribution.+ * Neither the name of the copyright holders nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Network/Sendfile.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}++{-|+ Cross platform library for the sendfile system call.+ This library tries to call minimum system calls which+ are the bottleneck of web servers.+-}++module Network.Sendfile (sendfile, FileRange(..)) where++import Network.Sendfile.Types++#ifdef OS_BSD+import Network.Sendfile.BSD+#elif OS_MacOS+import Network.Sendfile.MacOS+#elif OS_Linux+import Network.Sendfile.Linux+#elif OS_Windows+import Network.Sendfile.Windows+#else+import Network.Sendfile.Fallback+#endif
+ Network/Sendfile/BSD.hsc view
@@ -0,0 +1,68 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Network.Sendfile.BSD (sendfile) where++import Control.Concurrent+import Control.Exception+import Control.Monad+import Foreign.C.Error (eAGAIN, eINTR, getErrno, throwErrno)+import Foreign.C.Types (CInt, CSize)+import Foreign.Marshal (alloca)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable (peek)+import Network.Sendfile.Types+import Network.Socket+import System.Posix.IO+import System.Posix.Types (Fd(..), COff)++{-|+ Simple binding for sendfile() of MacOS.++ - Used system calls: open(), sendfile(), and close().+-}+sendfile :: Socket -> FilePath -> FileRange -> IO ()+sendfile sock path range = bracket+ (openFd path ReadOnly Nothing defaultFileFlags)+ closeFd+ sendfile'+ where+ dst = Fd $ fdSocket sock+ sendfile' fd = alloca $ \lenp -> do+ case range of+ EntireFile -> sendEntire dst fd 0 lenp+ PartOfFile off len -> do+ let off' = fromInteger off+ len' = fromInteger len+ sendPart dst fd off' len' lenp++sendEntire :: Fd -> Fd -> COff -> Ptr COff -> IO ()+sendEntire dst src off lenp = do+ do rc <- c_sendfile src dst off 0 lenp+ when (rc /= 0) $ do+ errno <- getErrno+ if errno == eAGAIN || errno == eINTR+ then do+ sent <- peek lenp+ threadWaitWrite dst+ sendEntire dst src (off + sent) lenp+ else throwErrno "Network.SendFile.BSD.sendEntire"++sendPart :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO ()+sendPart dst src off len lenp = do+ do rc <- c_sendfile src dst off len lenp+ when (rc /= 0) $ do+ errno <- getErrno+ if errno == eAGAIN || errno == eINTR+ then do+ sent <- peek lenp+ threadWaitWrite dst+ let off' = off + sent+ len' = len - fromIntegral sent+ sendPart dst src off' len' lenp+ else throwErrno "Network.SendFile.BSD.sendPart"++c_sendfile :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO CInt+c_sendfile fd s offset len lenp = c_sendfile' fd s offset len nullPtr lenp 0++foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile'+ :: Fd -> Fd -> COff -> CSize -> Ptr () -> Ptr COff -> CInt -> IO CInt
+ Network/Sendfile/Fallback.hs view
@@ -0,0 +1,37 @@+module Network.Sendfile.Fallback (sendfile) where++import Control.Monad+import Control.Monad.IO.Class+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Enumerator+import Data.Enumerator.Binary as EB+import Data.Enumerator.List as EL+import Network.Sendfile.Types+import Network.Socket+import qualified Network.Socket.ByteString as SB++{-|+ Sendfile emulation using enumerator.++ - Used system calls: open(), stat(), read(), send() and close().+-}+sendfile :: Socket -> FilePath -> FileRange -> IO ()+sendfile s fp EntireFile =+ run_ $ enumFile fp $$ sendIter s+sendfile s fp (PartOfFile off len) =+ run_ $ EB.enumFileRange fp (Just off) (Just len) $$ sendIter s++sendIter :: Socket -> Iteratee ByteString IO ()+sendIter s = do+ mb <- EL.head+ case mb of+ Nothing -> return ()+ Just bs -> do+ liftIO $ sendLoop s bs (BS.length bs)+ sendIter s++sendLoop :: Socket -> ByteString -> Int -> IO ()+sendLoop s bs len = do+ bytes <- SB.send s bs+ when (bytes /= len) $ sendLoop s (BS.drop bytes bs) (len - bytes)
+ Network/Sendfile/Linux.hsc view
@@ -0,0 +1,64 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Network.Sendfile.Linux (sendfile) where++import Control.Applicative+import Control.Concurrent+import Control.Exception+import Control.Monad+import Data.Int (Int64)+import Data.Word+import Foreign.C.Error (throwErrno)+import Foreign.Marshal (alloca)+import Foreign.Ptr (Ptr)+import Foreign.Storable (poke)+import Network.Sendfile.Types+import Network.Socket+import System.Posix.Files+import System.Posix.IO+import System.Posix.Types (Fd(..))++{-|+ Simple binding for sendfile() of MacOS.+ Used system calls:++ - EntireFile -- open(), stat(), sendfile(), and close()+ - PartOfFile -- open(), sendfile(), and close()++ If the size of the file is unknown when sending the entire file,+ specifying PartOfFile is much faster.+-}+sendfile :: Socket -> FilePath -> FileRange -> IO ()+sendfile sock path range = bracket+ (openFd path ReadOnly Nothing defaultFileFlags)+ closeFd+ sendfile'+ where+ dst = Fd $ fdSocket sock+ sendfile' fd = alloca $ \offp -> do+ case range of+ EntireFile -> do+ poke offp 0+ -- System call is very slow. Use PartOfFile instead.+ len <- fileSize <$> getFdStatus fd+ let len' = fromIntegral len+ sendPart dst fd offp len'+ PartOfFile off len -> do+ poke offp (fromIntegral off)+ let len' = fromIntegral len+ sendPart dst fd offp len'++sendPart :: Fd -> Fd -> Ptr (#type off_t) -> (#type size_t) -> IO ()+sendPart dst src offp len = do+ do bytes <- c_sendfile dst src offp len+ if bytes == -1+ then throwErrno "Network.SendFile.Linux.sendPart"+ else do+ let left = len - fromIntegral bytes+ when (left /= 0) $ do+ threadWaitWrite dst+ sendPart dst src offp left++-- Dst Src in order. take care+foreign import ccall unsafe "sendfile64" c_sendfile+ :: Fd -> Fd -> Ptr (#type off_t) -> (#type size_t) -> IO (#type ssize_t)
+ Network/Sendfile/MacOS.hsc view
@@ -0,0 +1,72 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Network.Sendfile.MacOS (sendfile) where++import Control.Concurrent+import Control.Exception+import Control.Monad+import Data.Int (Int64)+import Foreign.C.Error (eAGAIN, eINTR, getErrno, throwErrno)+import Foreign.C.Types (CInt)+import Foreign.Marshal (alloca)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable (peek, poke)+import Network.Sendfile.Types+import Network.Socket+import System.Posix.IO+import System.Posix.Types (Fd(..))++{-|+ Simple binding for sendfile() of MacOS.++ - Used system calls: open(), sendfile(), and close().+-}+sendfile :: Socket -> FilePath -> FileRange -> IO ()+sendfile sock path range = bracket+ (openFd path ReadOnly Nothing defaultFileFlags)+ closeFd+ sendfile'+ where+ dst = Fd $ fdSocket sock+ sendfile' fd = alloca $ \lenp -> do+ case range of+ EntireFile -> do+ poke lenp 0+ sendEntire dst fd 0 lenp+ PartOfFile off len -> do+ let off' = fromInteger off+ poke lenp (fromInteger len)+ sendPart dst fd off' lenp++sendEntire :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO ()+sendEntire dst src off lenp = do+ do rc <- c_sendfile src dst off lenp+ when (rc /= 0) $ do+ errno <- getErrno+ if errno == eAGAIN || errno == eINTR+ then do+ sent <- peek lenp+ poke lenp 0+ threadWaitWrite dst+ sendEntire dst src (off + sent) lenp+ else throwErrno "Network.SendFile.MacOS.sendEntire"++sendPart :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO ()+sendPart dst src off lenp = do+ do len <- peek lenp+ rc <- c_sendfile src dst off lenp+ when (rc /= 0) $ do+ errno <- getErrno+ if errno == eAGAIN || errno == eINTR+ then do+ sent <- peek lenp+ poke lenp (len - sent)+ threadWaitWrite dst+ sendPart dst src (off + sent) lenp+ else throwErrno "Network.SendFile.MacOS.sendPart"++c_sendfile :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO CInt+c_sendfile fd s offset lenp = c_sendfile' fd s offset lenp nullPtr 0++foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile'+ :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> Ptr () -> CInt -> IO CInt
+ Network/Sendfile/Types.hs view
@@ -0,0 +1,10 @@+module Network.Sendfile.Types where++{-|+ File range for 'sendfile'.+-}+data FileRange = EntireFile+ | PartOfFile {+ rangeOffset :: Integer+ , rangeLength :: Integer+ }
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ simple-sendfile.cabal view
@@ -0,0 +1,44 @@+Name: simple-sendfile+Version: 0.0.0+Author: Kazu Yamamoto <kazu@iij.ad.jp>+Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+License: BSD3+License-File: LICENSE+Synopsis: Cross platform library for the sendfile system call+Description: Cross platform library for the sendfile system call.+ This library tries to call minimum system calls which+ are the bottleneck of web servers.+Category: Network+Cabal-Version: >= 1.6+Build-Type: Simple++Library+ if impl(ghc >= 6.12)+ GHC-Options: -Wall -fno-warn-unused-do-bind+ else+ GHC-Options: -Wall+ Exposed-Modules: Network.Sendfile+ Other-Modules: Network.Sendfile.Types+ Build-Depends: base >= 4 && < 5, network+ -- FIXME tested on FreeBSD only+ if os(freebsd) || os(netbsd) || os(openbsd)+ CPP-Options: -DOS_BSD+ Other-Modules: Network.Sendfile.BSD+ Build-Depends: unix+ else+ if os(darwin)+ CPP-Options: -DOS_MacOS+ Other-Modules: Network.Sendfile.MacOS+ Build-Depends: unix+ else+ if os(linux)+ CPP-Options: -DOS_Linux+ Other-Modules: Network.Sendfile.Linux+ Build-Depends: unix+ else+ Other-Modules: Network.Sendfile.Fallback+ Build-Depends: bytestring, enumerator++Source-Repository head+ Type: git+ Location: git://github.com/kazu-yamamoto/simple-sendfile