sendfile 0.5 → 0.6.1
raw patch · 5 files changed
+201/−56 lines, 5 filesdep ~basenew-uploader
Dependency ranges changed: base
Files
- sendfile.cabal +12/−8
- src/Network/Socket/SendFile.hs +7/−10
- src/Network/Socket/SendFile/Darwin.hsc +66/−0
- src/Network/Socket/SendFile/FreeBSD.hs +35/−8
- src/Network/Socket/SendFile/Internal.hs +81/−30
sendfile.cabal view
@@ -1,16 +1,16 @@ name: sendfile-version: 0.5+version: 0.6.1 stability: provisional synopsis: A portable sendfile library description: A library which exposes zero-copy sendfile functionality in a portable way. If a platform does not support sendfile, a fallback implementation in haskell is provided. .- Currently supported platforms: Windows 2000+ (Native), Linux 2.6+ (Native), FreeBSD (Untested!), Everything else (Haskell).+ Currently supported platforms: Windows 2000+ (Native), Linux 2.6+ (Native), FreeBSD (Native), OS-X 10.5+ (Native), Everything else (Portable Haskell code). license: BSD3 license-file: LICENSE author: Matthew Elder <matt@mattelder.org> maintainer: Matthew Elder <matt@mattelder.org>-homepage: http://patch-tag.com/r/sendfile+homepage: http://patch-tag.com/r/mae/sendfile category: Network build-type: Simple cabal-version: >= 1.6@@ -26,7 +26,7 @@ other-modules: Network.Socket.SendFile.Internal - build-depends: base >= 4 && < 5,+ build-depends: base >= 3 && < 5, network >= 2 && < 3 ghc-options: -Wall@@ -45,10 +45,14 @@ cpp-options: -DFREEBSD_SENDFILE other-modules: Network.Socket.SendFile.FreeBSD else- cpp-options: -DPORTABLE_SENDFILE- build-depends: bytestring >= 0.9.1.4 && < 0.10,- network-bytestring >= 0.1.1.3 && < 0.2+ if os(darwin) && !flag(portable)+ cpp-options: -DDARWIN_SENDFILE+ other-modules: Network.Socket.SendFile.Darwin+ else+ cpp-options: -DPORTABLE_SENDFILE+ build-depends: bytestring >= 0.9.1.4 && < 0.10,+ network-bytestring >= 0.1.1.3 && < 0.2 source-repository head type: darcs- location: http://patch-tag.com/r/sendfile/pullrepo+ location: http://patch-tag.com/r/mae/sendfile/pullrepo
src/Network/Socket/SendFile.hs view
@@ -11,17 +11,12 @@ -- * Safe functions (recommended) sendFile, sendFile',- -- * Unsafe functions (not recommended)- -- | With unsafeSendFile and unsafeSendFile' the output should only be a `Handle` derived from a network socket (by using socketToHandle). These functions are unsafe because you cannot know whether or not a Handle is actually a `Socket` at compile-time. If you try to use a `Handle` for the output which is not in fact a socket, you will get a runtime error.- --- -- These functions are provided for convenience given that the current high-level interface in the Network package gives you a `Handle` when you use accept. They may be deprecated in the future.- unsafeSendFile, unsafeSendFile', -- * Utility functions sendFileMode ) where-import qualified Network.Socket.SendFile.Internal (sendFile, sendFile', sendFileMode, unsafeSendFile, unsafeSendFile')+import qualified Network.Socket.SendFile.Internal (sendFile, sendFile', unsafeSendFile, unsafeSendFile', sendFileMode) import Network.Socket (Socket) import System.IO (Handle) @@ -38,10 +33,10 @@ -> IO () sendFile = Network.Socket.SendFile.Internal.sendFile --- | A more powerful interface than sendFile, sendFile' accepts a `Handle` for the input file instead of a `FilePath`, a starting offset, and the bytecount to send; the offset and the count must be a positive integer. The initial position of the input file handle matters not since the offset is absolute, and the final position may be different depending on the platform -- no assumptions can be made.+-- | A more powerful interface than sendFile which accepts a starting offset, and the bytecount to send; the offset and the count must be a positive integer. The initial position of the input file handle matters not since the offset is absolute, and the final position may be different depending on the platform -- no assumptions can be made. sendFile' :: Socket -- ^ The output socket- -> Handle -- ^ The input file handle+ -> FilePath -- ^ The input file handle -> Offset -- ^ The offset to start at -> ByteCount -- ^ The number of bytes to send -> IO ()@@ -57,13 +52,15 @@ -- | The unsafe version of sendFile' which accepts a `Handle` instead of a `Socket` for the output. It will flush the output handle before sending any file data. unsafeSendFile' :: Handle -- ^ The output handle- -> Handle -- ^ The input file handle+ -> FilePath -- ^ The input filepath -> Offset -- ^ The offset to start at -> ByteCount -- ^ The number of bytes to send -> IO () unsafeSendFile' = Network.Socket.SendFile.Internal.unsafeSendFile' --- | Returns the mode that sendfile was compiled with. Mainly for debugging use. Possible values are 'WIN32_SENDFILE', 'LINUX_SENDFILE', 'FREEBSD_SENDFILE', and 'PORTABLE_SENDFILE'.+-- | Returns the mode that sendfile was compiled with. Mainly for debugging use.+-- | Possible values are 'WIN32_SENDFILE', 'LINUX_SENDFILE', 'FREEBSD_SENDFILE',+-- | 'DARWIN_SENDFILE', and 'PORTABLE_SENDFILE'. sendFileMode :: String -- ^ The mode that sendfile was compiled with sendFileMode = Network.Socket.SendFile.Internal.sendFileMode
+ src/Network/Socket/SendFile/Darwin.hsc view
@@ -0,0 +1,66 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- | Darwin system-dependent code for 'sendfile'.+module Network.Socket.SendFile.Darwin (_sendFile) where+import Data.Int (Int64)+import Foreign.C.Error (eAGAIN, getErrno, throwErrno)+import Foreign.C.Types (CInt)+import Foreign.Marshal (alloca)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable (peek, poke)+import System.Posix.Types (Fd)+import Control.Concurrent (threadWaitWrite)++{-+ This is based on Linux.hsc (from version 0.5), although the+ calling convention for Darwin's sendfile() is closer to that+ of FreeBSD.+-}++_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()+_sendFile out_fd in_fd off count = do+ alloca $ \pbytes -> do+ rsendfile out_fd in_fd pbytes off count++rsendfile :: Fd -> Fd -> Ptr Int64 -> Int64 -> Int64 -> IO ()+rsendfile _ _ _ _ 0 = return ()+rsendfile out_fd in_fd pbytes off remaining = do+ let bytes = min remaining maxBytes+ sbytes <- sendfile out_fd in_fd pbytes off bytes 0+ rsendfile out_fd in_fd pbytes off (remaining - sbytes)++{-+ Unlike the Linux implementation we track any re-sends due+ to getting eAGAIN. If this wasn't done then the call would+ appear to hang. The alternative would be to just + return bytes+ but I am unclear whether there are occasions this may+ be wrong.+-}++sendfile :: Fd -> Fd -> Ptr Int64 -> Int64 -> Int64 -> Int64 -> IO Int64+sendfile out_fd in_fd pbytes off bytes ctr = do+ poke pbytes bytes+ -- Copying Linux implementation for thread synchronization,+ -- is this sensible?+ threadWaitWrite out_fd+ status <- c_sendfile out_fd in_fd off pbytes+ nsent <- peek pbytes+ if status == 0+ then return $ (fromIntegral nsent) + ctr+ else do errno <- getErrno+ if errno == eAGAIN+ -- is it correct to reduce bytes by nsent here?+ then let nremaining = max 0 (bytes - (fromIntegral nsent))+ in sendfile out_fd in_fd pbytes off nremaining (ctr + (fromIntegral nsent))+ else throwErrno "Network.Socket.SendFile.Darwin"++-- max num of bytes in one send+maxBytes :: Int64+maxBytes = fromIntegral (maxBound :: (#type off_t))++-- in Darwin sendfile gives LFS support (no sendfile64 routine)+foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile_darwin+ :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> Ptr () -> CInt -> IO CInt++c_sendfile :: Fd -> Fd -> (#type off_t) -> Ptr (#type off_t) -> IO CInt+c_sendfile out_fd in_fd off pbytes = c_sendfile_darwin in_fd out_fd off pbytes nullPtr 0
src/Network/Socket/SendFile/FreeBSD.hs view
@@ -1,20 +1,47 @@ {-# LANGUAGE ForeignFunctionInterface #-} -- | FreeBSD system-dependent code for 'sendfile'. module Network.Socket.SendFile.FreeBSD (_sendFile) where-import Foreign.C.Error (throwErrnoIfMinus1_)+import Control.Concurrent (threadWaitWrite)+import Foreign.C.Error (eAGAIN, eINTR, getErrno, throwErrno) import Foreign.C.Types (CInt, CSize) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (peek) import System.Posix.Types (COff, Fd) -_sendFile :: Fd -> Fd -> Integer -> IO Integer-_sendFile out_fd in_fd count = alloca $ \sbytes -> do- throwErrnoIfMinus1_- "Network.Socket.SendFile.FreeBSD.sendFile'"- (c_sendfile_freebsd in_fd out_fd 0 (fromIntegral count) nullPtr sbytes 0)- fmap fromIntegral (peek sbytes)+_sendFile :: Fd -> Fd -> Integer -> Integer -> IO ()+_sendFile out_fd in_fd off count = + alloca $ \sbytes -> do+ rsendfile out_fd in_fd (fromIntegral off) (fromIntegral count) sbytes +rsendfile :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO ()+rsendfile _ _ _ 0 _ = return ()+rsendfile out_fd in_fd off remaining sbytes =+ do let bytes = min remaining maxBytes+ sent <- sendfile out_fd in_fd off bytes sbytes 0+ rsendfile out_fd in_fd (off + sent) (remaining `safeMinus` (fromIntegral sent)) sbytes++sendfile :: Fd -> Fd -> COff -> CSize -> Ptr COff -> COff -> IO COff+sendfile out_fd in_fd off count sbytes totalSent =+ do threadWaitWrite out_fd+ res <- c_sendfile_freebsd in_fd out_fd off count nullPtr sbytes 0+ if (res == 0)+ then do nbytes <- peek sbytes+ return (totalSent + nbytes)+ else do errno <- getErrno+ if (errno == eAGAIN) || (errno == eINTR) + then do nbytes <- peek sbytes+ sendfile out_fd in_fd (off + nbytes) (count `safeMinus` (fromIntegral nbytes)) sbytes (totalSent + nbytes)+ else throwErrno "Network.Socket.SendFile.FreeBSD.sendfile"++safeMinus :: (Ord a, Num a) => a -> a -> a+safeMinus x y+ | y >= x = 0+ | otherwise = x - y++-- max num of bytes in one send+maxBytes :: CSize+maxBytes = maxBound :: CSize+ foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile_freebsd :: Fd -> Fd -> COff -> CSize -> Ptr () -> Ptr COff -> CInt -> IO CInt-
src/Network/Socket/SendFile/Internal.hs view
@@ -1,24 +1,38 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, RecordWildCards #-} module Network.Socket.SendFile.Internal ( sendFile, sendFile',- sendFileMode, unsafeSendFile, unsafeSendFile',+ sendFileMode, ) where #if defined(PORTABLE_SENDFILE) import Data.ByteString.Char8 (hGet, hPutStr, length, ByteString) import Network.Socket.ByteString (sendAll) import Network.Socket (Socket(..)) import Prelude hiding (length)-import System.IO (Handle, IOMode(..), SeekMode(..), hFileSize, hFlush, hSeek, withBinaryFile)+import System.IO (Handle, IOMode(..), SeekMode(..), hFileSize, hSeek, withBinaryFile) #else-import GHC.Handle (withHandle_)-import GHC.IOBase (haFD) import Network.Socket (Socket(..), fdSocket)-import System.IO (Handle, IOMode(..), hFileSize, hFlush, withBinaryFile)+import System.IO (Handle, IOMode(..), hFileSize, withBinaryFile) import System.Posix.Types (Fd(..)) #endif+#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+import GHC.IO.Handle.Internals (withHandle, flushWriteBuffer)+import GHC.IO.Handle.Types (Handle__(..), HandleType(..))+import qualified GHC.IO.FD as FD+-- import qualified GHC.IO.Handle.FD as FD+import GHC.IO.Exception+import Data.Typeable (cast)+import System.IO (hFlush)+import System.IO.Error+#else+import GHC.IOBase+import GHC.Handle hiding (fdToHandle)+import qualified GHC.Handle+#endif+#endif #if defined(WIN32_SENDFILE) import Network.Socket.SendFile.Win32 (_sendFile)@@ -41,17 +55,24 @@ sendFileMode = "FREEBSD_SENDFILE" #endif +#if defined(DARWIN_SENDFILE)+import Network.Socket.SendFile.Darwin (_sendFile)++sendFileMode :: String+sendFileMode = "DARWIN_SENDFILE"+#endif+ #if defined(PORTABLE_SENDFILE) sendFileMode :: String sendFileMode = "PORTABLE_SENDFILE" -sendFile' :: Socket -> Handle -> Integer -> Integer -> IO ()-sendFile' = wrapSendFile' $ \outs inp off count -> do+sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO ()+sendFile'' = wrapSendFile' $ \outs inp off count -> do hSeek inp AbsoluteSeek off rsend (sendAll outs) inp count -unsafeSendFile' :: Handle -> Handle -> Integer -> Integer -> IO ()-unsafeSendFile' = wrapSendFile' $ \outp inp off count -> do+unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO ()+unsafeSendFile'' = wrapSendFile' $ \outp inp off count -> do hSeek inp AbsoluteSeek off rsend (hPutStr outp) inp count hFlush outp -- match the behavior that all data is "flushed to the os" of native implementations@@ -66,40 +87,70 @@ buf <- hGet inp (fromIntegral bytes) write buf loop $ reqBytes - (fromIntegral $ length buf)- #else-sendFile' :: Socket -> Handle -> Integer -> Integer -> IO ()-sendFile' outs inp off count =- withHandle_ "Network.Socket.SendFile.sendFile'" inp $ \inp' -> do- let out_fd = Fd (fdSocket outs)- let in_fd = Fd (haFD inp')- wrapSendFile' _sendFile out_fd in_fd off count+sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO ()+sendFile'' outs inp off count =+ do let out_fd = Fd (fdSocket outs)+ in_fd <- handleToFd inp+ wrapSendFile' _sendFile out_fd in_fd off count -unsafeSendFile' :: Handle -> Handle -> Integer -> Integer -> IO ()-unsafeSendFile' outp inp off count = do- hFlush outp -- flush outp before sending- withHandle_ "Network.Socket.SendFile.unsafeSendFile'" outp $ \outp' -> do- withHandle_ "Network.Socket.SendFile.unsafeSendFile'" inp $ \inp' -> do- let out_fd = Fd (haFD outp')- let in_fd = Fd (haFD inp')- wrapSendFile' _sendFile out_fd in_fd off count+unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO ()+unsafeSendFile'' outp inp off count =+ do hFlush outp+ out_fd <- handleToFd outp+ in_fd <- handleToFd inp+ wrapSendFile' _sendFile out_fd in_fd off count+ #endif sendFile :: Socket -> FilePath -> IO () sendFile outs infp = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp- sendFile' outs inp 0 count+ sendFile'' outs inp 0 count +sendFile' :: Socket -> FilePath -> Integer -> Integer -> IO ()+sendFile' outs infp offset count =+ withBinaryFile infp ReadMode $ \inp ->+ sendFile'' outs inp offset count+ unsafeSendFile :: Handle -> FilePath -> IO ()-unsafeSendFile outp infp = withBinaryFile infp ReadMode $ \inp -> do- count <- hFileSize inp- unsafeSendFile' outp inp 0 count+unsafeSendFile outp infp = + withBinaryFile infp ReadMode $ \inp -> do+ count <- hFileSize inp+ unsafeSendFile'' outp inp 0 count +unsafeSendFile'+ :: Handle -- ^ The output handle+ -> FilePath -- ^ The input filepath+ -> Integer -- ^ The offset to start at+ -> Integer -- ^ The number of bytes to send+ -> IO ()+unsafeSendFile' outp infp offset count =+ withBinaryFile infp ReadMode $ \inp -> do+ unsafeSendFile'' outp inp offset count+ -- | wraps sendFile' to check arguments wrapSendFile' :: Integral i => (a -> b -> i -> i -> IO ()) -> a -> b -> Integer -> Integer -> IO () wrapSendFile' fun outp inp off count | off < 0 = error "SendFile - offset must be a positive integer" | count < 0 = error "SendFile - count must be a positive integer"- | count == 0 = return () -- Send nothing -- why do the work? Also, Windows treats '0' as 'send the whole file'.+ | count == 0 = return () -- Send nothing -- why do the work? Also, Windows and FreeBSD treat '0' as 'send the whole file'. | otherwise = fun outp inp (fromIntegral off) (fromIntegral count) +#if !defined(PORTABLE_SENDFILE)+handleToFd :: Handle -> IO Fd+#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+handleToFd h = withHandle "handleToFd" h $ \ Handle__{..} -> do+ case cast haDevice of+ Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation+ "handleToFd" (Just h) Nothing) + "handle is not a file descriptor")+ Just fd -> do+ return (Handle__{..} , Fd (fromIntegral (FD.fdFD fd)))+#else+handleToFd h = withHandle "handleToFd" h $ \ h_ -> do+ return (h_, Fd (fromIntegral (haFD h_)))+#endif+#endif+#endif