sendfile-0.7.9/0000755000000000000000000000000012111753554011512 5ustar0000000000000000sendfile-0.7.9/LICENSE0000644000000000000000000000267712111753554012533 0ustar0000000000000000Copyright (c) 2009, Matthew Elder 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. * The names of the contributors may not 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 HOLDER 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. sendfile-0.7.9/sendfile.cabal0000644000000000000000000000426612111753554014277 0ustar0000000000000000name: sendfile version: 0.7.9 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 (Native), OS-X 10.5+ (Native), Everything else (Portable Haskell code). license: BSD3 license-file: LICENSE author: Matthew Elder maintainer: Jeremy Shaw homepage: http://hub.darcs.net/stepcut/sendfile category: Network build-type: Simple cabal-version: >= 1.6 flag portable description: Explicitly enable portable sendfile support (implemented in Haskell) default: False library hs-source-dirs: src exposed-modules: Network.Socket.SendFile Network.Socket.SendFile.Iter Network.Socket.SendFile.Handle Network.Socket.SendFile.Portable other-modules: Network.Socket.SendFile.Internal Network.Socket.SendFile.Util build-depends: base >= 3 && < 5, bytestring >= 0.9.1.4 && < 0.11, network >= 2 && < 3 ghc-options: -Wall if os(windows) && !flag(portable) cpp-options: -DWIN32_SENDFILE build-depends: Win32 >= 2.2.0.0 && < 2.3 extra-libraries: mswsock other-modules: Network.Socket.SendFile.Win32 else if os(linux) && !flag(portable) cpp-options: -DLINUX_SENDFILE -D_LARGEFILE_SOURCE -D_LARGEFILE64_SOURCE. other-modules: Network.Socket.SendFile.Linux else if os(freebsd) && !flag(portable) cpp-options: -DFREEBSD_SENDFILE other-modules: Network.Socket.SendFile.FreeBSD else if os(darwin) && !flag(portable) cpp-options: -DDARWIN_SENDFILE other-modules: Network.Socket.SendFile.Darwin else cpp-options: -DPORTABLE_SENDFILE source-repository head type: darcs location: http://patch-tag.com/r/mae/sendfile/pullrepo sendfile-0.7.9/Setup.hs0000644000000000000000000000013012111753554013140 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain sendfile-0.7.9/src/0000755000000000000000000000000012111753554012301 5ustar0000000000000000sendfile-0.7.9/src/Network/0000755000000000000000000000000012111753554013732 5ustar0000000000000000sendfile-0.7.9/src/Network/Socket/0000755000000000000000000000000012111753554015162 5ustar0000000000000000sendfile-0.7.9/src/Network/Socket/SendFile.hs0000644000000000000000000001441712111753554017216 0ustar0000000000000000-- | A cross-platform wrapper for sendfile -- this implements an available operating-system call if supported, otherwise it falls back to a portable haskell implementation. -- -- Two interfaces are provided for both the unsafe and safe sets of functions. The first interface accepts an output socket\/handle and the path of the file you want to send; sendFile and unsafeSendFile comprise this interface. The second interface accepts an output socket\/handle, a handle to the file you want to send, an offset, and the number of bytes you want to send; sendFile' and unsafeSendFile' comprise this interface. -- -- For consistent read/write behavior with either sendFile' or unsafeSendFile', the input handle should be opened in Binary mode rather than Text mode. -- module Network.Socket.SendFile ( ByteCount, Offset, Iter(..), runIter, -- * Safe functions (recommended) sendFile, sendFileIterWith, sendFile', sendFileIterWith', -- * Unsafe functions -- | These functions are unsafe simply because there is no guarantee that the 'Handle' used for output is actually bound to a 'Socket'. If it is not, it will result in a runtime error. unsafeSendFile, unsafeSendFileIterWith, unsafeSendFile', unsafeSendFileIterWith', -- * Utility functions sendFileMode ) where import qualified Network.Socket.SendFile.Internal (sendFile, sendFileIterWith, sendFile', sendFileIterWith', unsafeSendFile, unsafeSendFileIterWith, unsafeSendFile', unsafeSendFileIterWith', sendFileMode) import Network.Socket.SendFile.Iter (Iter(..), runIter) import Network.Socket (Socket) import System.IO (Handle) -- | The file offset (in bytes) to start from type Offset = Integer -- | The length (in bytes) which should be sent type ByteCount = Integer -- | The simplest interface. Simply give it an output `Socket` and the `FilePath` to the input file. sendFile :: Socket -- ^ The output socket -> FilePath -- ^ The path where the input file resides -> IO () sendFile = Network.Socket.SendFile.Internal.sendFile -- | The simplest interface. Simply give it an output `Socket` and the `FilePath` to the input file. -- -- This variant takes a function to drive the iteration loop. See 'Iter' for more information. sendFileIterWith :: (IO Iter -> IO a) -> Socket -- ^ The output socket -> FilePath -- ^ The path where the input file resides -> ByteCount -- ^ Maximum bytes to send per block (may send less) -> IO a sendFileIterWith = Network.Socket.SendFile.Internal.sendFileIterWith -- | 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 -> FilePath -- ^ The input file path -> Offset -- ^ The offset to start at -> ByteCount -- ^ The number of bytes to send -> IO () sendFile' = Network.Socket.SendFile.Internal.sendFile' -- | 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. -- -- This variant takes a function to drive the iteration loop. See 'Iter' for more information. sendFileIterWith' :: (IO Iter -> IO a) -> Socket -- ^ The output socket -> FilePath -- ^ The input file path -> ByteCount -- ^ Maximum bytes to send per block (may send less) -> Offset -- ^ The offset to start at -> ByteCount -- ^ The number of bytes to send -> IO a sendFileIterWith' = Network.Socket.SendFile.Internal.sendFileIterWith' -- | 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 -> FilePath -- ^ The path where the input file resides -> IO () unsafeSendFile = Network.Socket.SendFile.Internal.unsafeSendFile -- | 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. -- -- This variant takes a function to drive the iteration loop. See 'Iter' for more information. unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -- ^ The output handle -> FilePath -- ^ The path where the input file resides -> ByteCount -- ^ Maximum bytes to send per block (may send less) -> IO a unsafeSendFileIterWith = Network.Socket.SendFile.Internal.unsafeSendFileIterWith -- | 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 -> FilePath -- ^ The input filepath -> Offset -- ^ The offset to start at -> ByteCount -- ^ The number of bytes to send -> IO () unsafeSendFile' = Network.Socket.SendFile.Internal.unsafeSendFile' -- | 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. -- -- This variant takes a function to drive the iteration loop. See 'Iter' for more information. unsafeSendFileIterWith' :: (IO Iter -> IO a) -> Handle -- ^ The output handle -> FilePath -- ^ The input filepath -> ByteCount -- ^ The number of bytes to send -> Offset -- ^ The offset to start at -> ByteCount -- ^ The number of bytes to send -> IO a unsafeSendFileIterWith' = Network.Socket.SendFile.Internal.unsafeSendFileIterWith' -- | 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 sendfile-0.7.9/src/Network/Socket/SendFile/0000755000000000000000000000000012111753554016653 5ustar0000000000000000sendfile-0.7.9/src/Network/Socket/SendFile/Internal.hs0000644000000000000000000001377112111753554020774 0ustar0000000000000000{-# LANGUAGE CPP, RecordWildCards #-} module Network.Socket.SendFile.Internal ( sendFile, sendFileIterWith, sendFile', sendFileIterWith', sendFile'', sendFileIterWith'', unsafeSendFile, unsafeSendFileIterWith, unsafeSendFile', unsafeSendFileIterWith', sendFileMode, ) where #if defined(PORTABLE_SENDFILE) import Network.Socket.SendFile.Portable (sendFileMode, sendFile'', sendFileIterWith'', unsafeSendFile'', unsafeSendFileIterWith'') #else import Network.Socket (fdSocket) import Network.Socket.SendFile.Util import System.Posix.Types (Fd(..)) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Handle.Internals (withHandle_) import GHC.IO.Handle.Types (Handle__(..)) import qualified GHC.IO.FD as FD -- import qualified GHC.IO.Handle.FD as FD import GHC.IO.Exception import Data.Typeable (cast) #else import GHC.IOBase import GHC.Handle hiding (fdToHandle) import qualified GHC.Handle #endif #endif #endif import Network.Socket (Socket) import Network.Socket.SendFile.Iter (Iter(..)) import System.IO (Handle, IOMode(..), hFileSize, hFlush, withBinaryFile) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 611 import System.IO.Error #endif #endif #if defined(WIN32_SENDFILE) import Network.Socket.SendFile.Win32 (_sendFile, sendFileIter) sendFileMode :: String sendFileMode = "WIN32_SENDFILE" #endif #if defined(LINUX_SENDFILE) import Network.Socket.SendFile.Linux (_sendFile, sendFileIter) sendFileMode :: String sendFileMode = "LINUX_SENDFILE" #endif #if defined(FREEBSD_SENDFILE) import Network.Socket.SendFile.FreeBSD (_sendFile, sendFileIter) sendFileMode :: String sendFileMode = "FREEBSD_SENDFILE" #endif #if defined(DARWIN_SENDFILE) import Network.Socket.SendFile.Darwin (_sendFile, sendFileIter) sendFileMode :: String sendFileMode = "DARWIN_SENDFILE" #endif #if defined(PORTABLE_SENDFILE) #else sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO () sendFile'' outs inh off count = do let out_fd = Fd (fdSocket outs) withFd inh $ \in_fd -> wrapSendFile' (\out_fd_ in_fd_ _blockSize_ off_ count_ -> _sendFile out_fd_ in_fd_ off_ count_) out_fd in_fd count off count sendFileIterWith'' :: (IO Iter -> IO a) -> Socket -> Handle -> Integer -> Integer -> Integer -> IO a sendFileIterWith'' stepper outs inp blockSize off count = do let out_fd = Fd (fdSocket outs) withFd inp $ \in_fd -> stepper $ wrapSendFile' sendFileIter out_fd in_fd blockSize off count unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO () unsafeSendFile'' outp inp off count = do hFlush outp withFd outp $ \out_fd -> withFd inp $ \in_fd -> wrapSendFile' (\out_fd_ in_fd_ _blockSize_ off_ count_ -> _sendFile out_fd_ in_fd_ off_ count_) out_fd in_fd count off count -- wrapSendFile' _sendFile out_fd in_fd off count unsafeSendFileIterWith'' :: (IO Iter -> IO a) -> Handle -> Handle -> Integer -> Integer -> Integer -> IO a unsafeSendFileIterWith'' stepper outp inp blockSize off count = do hFlush outp withFd outp $ \out_fd -> withFd inp $ \in_fd -> stepper $ wrapSendFile' sendFileIter out_fd in_fd blockSize off count -- The Fd should not be used after the action returns because the -- Handler may be garbage collected and than will cause the finalizer -- to close the fd. withFd :: Handle -> (Fd -> IO a) -> IO a #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 611 withFd h f = withHandle_ "withFd" h $ \ Handle__{..} -> do case cast haDevice of Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation "withFd" (Just h) Nothing) "handle is not a file descriptor") Just fd -> f (Fd (fromIntegral (FD.fdFD fd))) #else withFd h f = withHandle_ "withFd" h $ \ h_ -> f (Fd (fromIntegral (haFD h_))) #endif #endif #endif sendFile :: Socket -> FilePath -> IO () sendFile outs infp = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp sendFile'' outs inp 0 count sendFileIterWith :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> IO a sendFileIterWith stepper outs infp blockSize = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp sendFileIterWith'' stepper outs inp blockSize 0 count sendFile' :: Socket -> FilePath -> Integer -> Integer -> IO () sendFile' outs infp offset count = withBinaryFile infp ReadMode $ \inp -> sendFile'' outs inp offset count sendFileIterWith' :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> Integer -> Integer -> IO a sendFileIterWith' stepper outs infp blockSize offset count = withBinaryFile infp ReadMode $ \inp -> sendFileIterWith'' stepper outs inp blockSize offset count unsafeSendFile :: Handle -> FilePath -> IO () unsafeSendFile outp infp = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp unsafeSendFile'' outp inp 0 count unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> FilePath -> Integer -> IO a unsafeSendFileIterWith stepper outp infp blockSize = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp unsafeSendFileIterWith'' stepper outp inp blockSize 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 unsafeSendFileIterWith' :: (IO Iter -> IO a) -> Handle -- ^ The output handle -> FilePath -- ^ The input filepath -> Integer -- ^ maximum block size -> Integer -- ^ The offset to start at -> Integer -- ^ The number of bytes to send -> IO a unsafeSendFileIterWith' stepper outp infp blockSize offset count = withBinaryFile infp ReadMode $ \inp -> do unsafeSendFileIterWith'' stepper outp inp blockSize offset count sendfile-0.7.9/src/Network/Socket/SendFile/Iter.hs0000644000000000000000000001006112111753554020110 0ustar0000000000000000module Network.Socket.SendFile.Iter where import Control.Concurrent (threadWaitWrite) import Data.Int (Int64) import System.Posix.Types (Fd) -- | An iteratee for sendfile -- -- In general, a whole file is not sent by a single call to -- sendfile(), but a series of calls which send successive pieces. -- -- The high-level API in this sendfile library has calls which will -- send the entire file (or an entire requested offset+length), before -- returning. -- -- However, there are instances where you want to be a bit more -- involved in the sending loop. For example, if you want to tickle a -- timeout after each chunk is sent or update a progress bar. -- -- The 'Iter' type gives you that power with out requiring you to -- manage all the low-level details of the sendfile loop. The -- interface is simple and consistant across all platforms. -- -- A call to sendfile() can result in three different states: -- -- (1) the requested number of bytes for that iteration was sent -- successfully, there are more bytes left to send. -- -- (2) some (possibly 0) bytes were sent, but the file descriptor -- would now block if more bytes were written. There are more bytes -- left to send. -- -- (2) All the bytes were sent, and there is nothing left to send. -- -- We handle these three cases by using a type with three -- constructors: -- -- @ -- data Iter -- = Sent Int64 (IO Iter) -- | WouldBlock Int64 Fd (IO Iter) -- | Done Int64 -- @ -- -- All three constructors provide an 'Int64' which represents the -- number of bytes sent for that particular iteration. (Not the total -- byte count). -- -- The 'Sent' and 'WouldBlock' constructors provide 'IO' 'Iter' as their -- final argument. Running this IO action will send the next block of -- data. -- -- The 'WouldBlock' constructor also provides the 'Fd' for the output -- socket. You should not send anymore data until the 'Fd' would not -- block. The easiest way to do that is to use 'threadWaitWrite' to -- suspend the thread until the 'Fd' is available. -- -- A very simple function to drive the Iter might look like: -- -- @ -- runIter :: IO Iter -> IO () -- runIter iter = -- do r <- iter -- case r of -- (Done _n) -> return () -- (Sent _n cont) -> runIter cont -- (WouldBlock _n fd cont) -> -- do threadWaitWrite fd -- runIter cont -- @ -- -- You would use it as the first argument to a *IterWith function, e.g. -- -- @ -- sendFileIterWith runIter outputSocket \"\/path\/to\/file\" 2^16 -- @ -- -- The 'runIter' function provided by this module is similar, but also returns the total number of bytes sent. -- -- NOTE: You must not use the 'Fd' or the 'IO' 'Iter' after the call -- to *IterWith has returned. When the *IterWith functions return, -- the file descriptors may be closed due to finalizers running. data Iter = Sent Int64 (IO Iter) -- ^ number of bytes sent this pass and a continuation to send more | WouldBlock Int64 Fd (IO Iter) -- ^ number of bytes sent, Fd that blocked, continuation to send more. NOTE: The Fd should not be used outside the running of the Iter as it may be freed when the Iter is done | Done Int64 -- ^ number of bytes sent, no more to send -- | A simple function to drive the *IterWith functions. -- It returns the total number of bytes sent. runIter :: IO Iter -> IO Int64 runIter = runIter' 0 where runIter' :: Int64 -> IO Iter -> IO Int64 runIter' acc iter = do r <- iter case r of (Sent n cont) -> do let acc' = (acc + n) -- putStrLn $ "Sent " ++ show acc' acc' `seq` runIter' acc' cont (Done n) -> do -- putStrLn $ "Done " ++ show (acc + n) return (acc + n) (WouldBlock n fd cont) -> do threadWaitWrite fd let acc' = (acc + n) -- putStrLn $ "WouldBlock " ++ (show acc') acc' `seq` runIter' acc' cont sendfile-0.7.9/src/Network/Socket/SendFile/Win32.hsc0000644000000000000000000001210512111753554020253 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | Win32 system-dependent code for 'TransmitFile'. module Network.Socket.SendFile.Win32 (_sendFile, sendFileIter) where import Data.Bits ((.|.)) import Data.Int import Foreign.C.Error (throwErrnoIf) import Foreign.C.Types (CInt(..)) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (IntPtr, Ptr, intPtrToPtr, nullPtr) import Foreign.Storable (peek) import Network.Socket.SendFile.Iter (Iter(..),runIter) import System.Posix.Types (Fd(..)) import System.Win32.Types (DWORD, HANDLE, failIfZero) #include #include type SOCKET = Fd _sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO () _sendFile out_fd in_fd off count = do _ <- runIter (sendFileIter out_fd in_fd (fromIntegral count) (fromIntegral off) (fromIntegral count)) -- set blockSize == count. ie. send it all if we can. return () sendFileIter :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -> IO Iter sendFileIter out_fd in_fd blockSize off count = do in_hdl <- get_osfhandle in_fd sendFileIterI out_fd in_hdl (min (fromIntegral blockSize) maxBytes) (fromIntegral off) (fromIntegral count) sendFileIterI :: SOCKET -- ^ file descriptor corresponding to network socket -> HANDLE -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -> IO Iter sendFileIterI _out_fd _in_fd _blockSize _off 0 = return (Done 0) sendFileIterI out_fd in_fd blockSize off remaining = do let bytes = min remaining blockSize (wouldBlock, nsent) <- sendfileI out_fd in_fd off bytes let cont = sendFileIterI out_fd in_fd blockSize (off + nsent) (remaining `safeMinus` (fromIntegral nsent)) case wouldBlock of True -> return (WouldBlock (fromIntegral nsent) out_fd cont) False -> return (Sent (fromIntegral nsent) cont) get_osfhandle :: Fd -- ^ User file descriptor. -> IO HANDLE -- ^ The operating-system file handle. get_osfhandle fd = do res <- throwErrnoIf (== (#const INVALID_HANDLE_VALUE)) "Network.Socket.SendFile.Win32.get_osfhandle" (c_get_osfhandle fd) return (intPtrToPtr res) setFilePointerEx :: HANDLE -- ^ the handle to set the pointer on -> Int64 -- ^ the offset to set the pointer to -> DWORD -- ^ the move method -> IO Int64 -- ^ the new absolute offset setFilePointerEx hdl off meth = alloca $ \res -> do _ <- failIfZero "Network.Socket.SendFile.Win32.setFilePointerEx" (c_SetFilePointerEx hdl off res meth) peek res sendfileI :: SOCKET -> HANDLE -> Int64 -> Int64 -> IO (Bool, Int64) sendfileI out_fd in_hdl off count = do _ <- setFilePointerEx in_hdl off (#const FILE_BEGIN) transmitFile out_fd in_hdl (fromIntegral count) return (False, count) transmitFile :: SOCKET -- ^ A handle to a connected socket. -> HANDLE -- ^ A handle to the open file that the TransmitFile function transmits. -> DWORD -- ^ The number of bytes in the file to transmit. -> IO () transmitFile out_fd in_hdl count = do _ <- failIfZero "Network.Socket.SendFile.Win32.transmitFile" (c_TransmitFile out_fd in_hdl count 0 nullPtr nullPtr (#{const TF_USE_KERNEL_APC} .|. #{const TF_WRITE_BEHIND})) return () -- according to msdn: -- If the TransmitFile function is called with the lpOverlapped parameter -- set to NULL, the operation is executed as synchronous I/O. The function -- will not complete until the file has been sent. safeMinus :: (Ord a, Num a) => a -> a -> a safeMinus x y | y >= x = 0 | otherwise = x - y -- max num of bytes in one send -- Windows will complain of an "invalid argument" if you use the maxBound of a DWORD, despite the fact that the count parameter is a DWORD; so the upper bound of a 32-bit integer seems to be the real limit, similar to Linux. maxBytes :: Int64 maxBytes = fromIntegral (maxBound :: Int32) -- maxBytes = 32 * 1024 -- http://support.microsoft.com/kb/99173 - MAY BE IMPORTANT -- http://msdn.microsoft.com/en-us/library/ks2530z6.aspx foreign import ccall unsafe "io.h _get_osfhandle" c_get_osfhandle :: Fd -> IO IntPtr -- http://msdn.microsoft.com/en-us/library/aa365541(VS.85).aspx foreign import stdcall unsafe "windows.h SetFilePointerEx" c_SetFilePointerEx :: HANDLE -> Int64 -> Ptr Int64 -> DWORD -> IO CInt -- http://msdn.microsoft.com/en-us/library/ms740565(VS.85).aspx foreign import stdcall safe "mswsock.h TransmitFile" c_TransmitFile :: SOCKET -> HANDLE -> DWORD -> DWORD -> Ptr () -> Ptr () -> DWORD -> IO CInt sendfile-0.7.9/src/Network/Socket/SendFile/Handle.hs0000644000000000000000000000410512111753554020402 0ustar0000000000000000-- | Handle-based versions of some of the functions exported by -- Network.Socket.SendFile. module Network.Socket.SendFile.Handle ( ByteCount, Offset, Iter(..), runIter, -- * Handle-based sendFiles sendFile, sendFileIterWith, sendFile', sendFileIterWith' ) where import System.IO (Handle, hFileSize) import qualified Network.Socket.SendFile.Internal as Internal import Network.Socket.SendFile.Iter (Iter(..), runIter) import Network.Socket.SendFile (ByteCount, Offset) import Network.Socket (Socket) -- | Simple sendFile - give it a Socket and a Handle, and it sends the entire -- file through the socket. -- -- WARNING: This function will raise 'IOError' 'IllegalOperation' -- if the 'Handle' is not for an 'Fd'. sendFile :: Socket -> Handle -> IO () sendFile outs inh = do count <- hFileSize inh Internal.sendFile'' outs inh 0 count -- | A more interactive version of sendFile, which accepts a callback function -- in addition to the socket and handle. The callback will be called for each -- chunk of data the sendFileIterWith function acts on. -- -- WARNING: This function will raise 'IOError' 'IllegalOperation' -- if the 'Handle' is not for an 'Fd'. sendFileIterWith :: (IO Iter -> IO a) -> Socket -> Handle -> ByteCount -> IO a sendFileIterWith stepper outs inh blockSize = do count <- hFileSize inh Internal.sendFileIterWith'' stepper outs inh blockSize 0 count -- | A sendFile that allows the user to send a subset of the file associated -- with the given handle. -- -- WARNING: This function will raise 'IOError' 'IllegalOperation' -- if the 'Handle' is not for an 'Fd'. sendFile' :: Socket -> Handle -> Offset -> ByteCount -> IO () sendFile' = Internal.sendFile'' -- | A more powerful version of sendFileIterWith, which allows the sending of a -- subset of the given file. -- -- WARNING: This function will raise 'IOError' 'IllegalOperation' -- if the 'Handle' is not for an 'Fd'. sendFileIterWith' :: (IO Iter -> IO a) -> Socket -> Handle -> ByteCount -> Offset -> ByteCount -> IO a sendFileIterWith' = Internal.sendFileIterWith'' sendfile-0.7.9/src/Network/Socket/SendFile/Util.hs0000644000000000000000000000137712111753554020134 0ustar0000000000000000module Network.Socket.SendFile.Util ( wrapSendFile' ) where -- | wraps sendFile' to check arguments wrapSendFile' :: Integral i => (a -> b -> i -> i -> i -> IO c) -> a -> b -> Integer -> Integer -> Integer -> IO c wrapSendFile' fun outp inp blockSize off count -- | count == 0 = return () -- Send nothing -- why do the work? Also, Windows and FreeBSD treat '0' as 'send the whole file'. | count < 0 = error "SendFile - count must be a positive integer" | (count /= 0) && (blockSize <= 0) = error "SendFile - blockSize must be a positive integer greater than 1" | off < 0 = error "SendFile - offset must be a positive integer" | otherwise = fun outp inp (fromIntegral blockSize) (fromIntegral off) (fromIntegral count) sendfile-0.7.9/src/Network/Socket/SendFile/FreeBSD.hs0000644000000000000000000000712212111753554020423 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | FreeBSD system-dependent code for 'sendfile'. module Network.Socket.SendFile.FreeBSD (_sendFile, sendFileIter, sendfile) where import Data.Int (Int64) 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 Network.Socket.SendFile.Iter (Iter(..), runIter) import System.Posix.Types (COff(..), Fd(..)) -- | automatically loop and send everything _sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO () _sendFile out_fd in_fd off count = do _ <- runIter (sendFileIter out_fd in_fd (fromIntegral count) (fromIntegral off) (fromIntegral count)) -- set blockSize == count. ie. send it all if we can. return () sendFileIter :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -> IO Iter sendFileIter out_fd in_fd blockSize off count = sendFileIterI out_fd in_fd (min (fromIntegral blockSize) maxBytes) (fromIntegral off) (fromIntegral count) sendFileIterI :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> CSize -- ^ maximum number of bytes to send at once -> COff -- ^ offset into file -> CSize -- ^ total number of bytes to send -> IO Iter sendFileIterI _out_fd _in_fd _blockSize _off 0 = return (Done 0) sendFileIterI out_fd in_fd blockSize off remaining = do let bytes = min remaining blockSize (wouldBlock, nsent) <- alloca $ \sbytes -> sendfileI out_fd in_fd off bytes sbytes let cont = sendFileIterI out_fd in_fd blockSize (off + nsent) (remaining `safeMinus` (fromIntegral nsent)) case wouldBlock of True -> return (WouldBlock (fromIntegral nsent) out_fd cont) False -> return (Sent (fromIntegral nsent) cont) -- | low-level wrapper around sendfile -- non-blocking -- returns number of bytes written and if EAGAIN -- does not call 'threadWaitWrite' sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64) sendfile out_fd in_fd off count = alloca $ \sbytes -> do (wb, sent) <- sendfileI out_fd in_fd (fromIntegral off) (fromIntegral count) sbytes return (wb, fromIntegral sent) -- NOTE: should we retry automatically on EINTR (but not EAGAIN) sendfileI :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO (Bool, COff) sendfileI out_fd in_fd off count sbytes = do status <- c_sendfile out_fd in_fd off count sbytes if (status == 0) then do nsent <- peek sbytes return (False, nsent) else do errno <- getErrno if (errno == eAGAIN) || (errno == eINTR) then do nsent <- peek sbytes return (True, nsent) else throwErrno "Network.Socket.SendFile.FreeBSD.sendfileI" 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 c_sendfile :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO CInt c_sendfile out_fd in_fd off count sbytes = c_sendfile_freebsd in_fd out_fd off count nullPtr sbytes 0 sendfile-0.7.9/src/Network/Socket/SendFile/Linux.hsc0000644000000000000000000000662712111753554020464 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | Linux system-dependent code for 'sendfile'. module Network.Socket.SendFile.Linux (_sendFile, sendFileIter, sendfile) where import Data.Int (Int32, Int64) -- Int64 is imported on 64-bit systems import Data.Word (Word32, Word64) -- Word64 is imported on 64-bit systems import Foreign.C (CInt(..)) import Foreign.C.Error (eAGAIN, getErrno, throwErrno) import Foreign.Marshal (alloca) import Foreign.Ptr (Ptr) import Foreign.Storable(poke) import Network.Socket.SendFile.Iter (Iter(..), runIter) import System.Posix.Types (Fd(..)) #include #include -- | automatically loop and send everything _sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO () _sendFile out_fd in_fd off count = do _ <- runIter (sendFileIter out_fd in_fd count off count) -- set blockSize == count. ie. send it all if we can. return () -- | a way to send things in chunks sendFileIter :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -> IO Iter sendFileIter out_fd in_fd blockSize off remaining = -- alloca $ \poff -> -- do poke poff off sendFileIterI out_fd in_fd (min blockSize maxBytes) off remaining sendFileIterI :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -> IO Iter sendFileIterI _out_fd _in_fd _blockSize _off 0 = return (Done 0) sendFileIterI out_fd in_fd blockSize off remaining = do let bytes = min remaining blockSize (wouldBlock, sbytes) <- sendfile out_fd in_fd off bytes let cont = sendFileIterI out_fd in_fd blockSize (off + sbytes) (remaining `safeMinus` sbytes) case wouldBlock of True -> return (WouldBlock sbytes out_fd cont) False -> return (Sent sbytes cont) -- | low-level wrapper around sendfile -- non-blocking -- returns number of bytes written and whether the fd would block (aka, EAGAIN) -- does not call 'threadWaitWrite' sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64) sendfile out_fd in_fd off bytes = alloca $ \poff -> do poke poff off sendfileI out_fd in_fd poff bytes -- low-level wrapper around linux sendfile sendfileI :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO (Bool, Int64) sendfileI out_fd in_fd poff bytes = do sbytes <- {-# SCC "c_sendfile" #-} c_sendfile out_fd in_fd poff (fromIntegral bytes) if sbytes <= -1 then do errno <- getErrno if errno == eAGAIN then return (True, 0) else throwErrno "Network.Socket.SendFile.Linux.sendfileI" else return (False, fromIntegral sbytes) safeMinus :: (Ord a, Num a, Show a) => a -> a -> a safeMinus x y | y > x = error $ "y > x " ++ show (y,x) | otherwise = x - y -- max num of bytes in one send maxBytes :: Int64 maxBytes = fromIntegral (maxBound :: (#type ssize_t)) -- sendfile64 gives LFS support foreign import ccall unsafe "sendfile64" c_sendfile :: Fd -> Fd -> Ptr (#type off64_t) -> (#type size_t) -> IO (#type ssize_t) sendfile-0.7.9/src/Network/Socket/SendFile/Portable.hs0000644000000000000000000001700312111753554020760 0ustar0000000000000000{-# LANGUAGE CPP #-} module Network.Socket.SendFile.Portable ( sendFile , sendFileIterWith , sendFile' , sendFileIterWith' , sendFile'' , sendFileIterWith'' , unsafeSendFile , unsafeSendFileIterWith , unsafeSendFile' , unsafeSendFile'' , unsafeSendFileIterWith' , unsafeSendFileIterWith'' , sendFileMode ) where import Data.ByteString.Char8 (hGet, hPut, length, ByteString) import qualified Data.ByteString.Char8 as C import Network.Socket.ByteString (send) import Network.Socket (Socket(..), fdSocket) import Network.Socket.SendFile.Iter (Iter(..), runIter) import Network.Socket.SendFile.Util (wrapSendFile') import Prelude hiding (length) import System.IO (Handle, IOMode(..), SeekMode(..), hFileSize, hFlush, hIsEOF, hSeek, withBinaryFile) import System.Posix.Types (Fd(..)) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 611 import System.IO.Error #endif #endif sendFileMode :: String sendFileMode = "PORTABLE_SENDFILE" sendFileIterWith'' :: (IO Iter -> IO a) -> Socket -> Handle -> Integer -> Integer -> Integer -> IO a sendFileIterWith'' stepper = wrapSendFile' $ \outs inp blockSize off count -> do hSeek inp AbsoluteSeek off stepper (sendFileIterS outs inp blockSize {- off -} count Nothing) sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO () sendFile'' outs inh off count = do _ <- sendFileIterWith'' runIter outs inh count off count return () unsafeSendFileIterWith'' :: (IO Iter -> IO a) -> Handle -> Handle -> Integer -> Integer -> Integer -> IO a unsafeSendFileIterWith'' stepper = wrapSendFile' $ \outp inp blockSize off count -> do hSeek inp AbsoluteSeek off a <- stepper (unsafeSendFileIter outp inp blockSize count Nothing) hFlush outp return a unsafeSendFile'' :: Handle -> Handle -> Integer -> Integer -> IO () unsafeSendFile'' outh inh off count = do _ <- unsafeSendFileIterWith'' runIter outh inh count off count return () sendFileIterS :: Socket -- ^ output network socket -> Handle -- ^ input handle -> Integer -- ^ maximum number of bytes to send at once -> Integer -- ^ total number of bytes to send -> Maybe ByteString -> IO Iter sendFileIterS _socket _inh _blockSize {- _off -} 0 _ = return (Done 0) sendFileIterS socket inh blockSize {- off -} remaining mBuf = do buf <- nextBlock nsent <- send socket buf let leftOver = if nsent < (C.length buf) then Just (C.drop nsent buf) else Nothing let cont = sendFileIterS socket inh blockSize {- (off + (fromIntegral nsent)) -} (remaining `safeMinus` (fromIntegral nsent)) leftOver if nsent < (length buf) then return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont) else return (Sent (fromIntegral nsent) cont) where nextBlock = case mBuf of (Just b) -> return b Nothing -> do eof <- hIsEOF inh if eof then ioError (mkIOError eofErrorType ("Reached EOF but was hoping to read " ++ show remaining ++ " more byte(s).") (Just inh) Nothing) else do let bytes = min 32768 (min blockSize remaining) hGet inh (fromIntegral bytes) -- we could check that we got fewer bytes than requested here, but we will send what we got and catch the EOF next time around safeMinus :: (Show a, Ord a, Num a) => a -> a -> a safeMinus x y | y > x = error $ "y > x " ++ show (y,x) | otherwise = x - y unsafeSendFileIter :: Handle -- ^ output handle -> Handle -- ^ input handle -> Integer -- ^ maximum number of bytes to send at once -- -> Integer -- ^ offset into file -> Integer -- ^ total number of bytes to send -> Maybe ByteString -> IO Iter unsafeSendFileIter _outh _inh _blockSize 0 _mBuf = return (Done 0) unsafeSendFileIter outh inh blockSize remaining mBuf = do buf <- nextBlock hPut outh buf -- eventually this should use a non-blocking version of hPut let nsent = length buf {- leftOver = if nsent < (C.length buf) then Just (C.drop nsent buf) else Nothing -} cont = unsafeSendFileIter outh inh blockSize {- (off + (fromIntegral nsent)) -} (remaining - (fromIntegral nsent)) Nothing if nsent < (length buf) then do error "unsafeSendFileIter: internal error" -- return (WouldBlock (fromIntegral nsent) (Fd $ fdSocket socket) cont) else return (Sent (fromIntegral nsent) cont) where nextBlock = case mBuf of (Just b) -> return b Nothing -> do eof <- hIsEOF inh if eof then ioError (mkIOError eofErrorType ("Reached EOF but was hoping to read " ++ show remaining ++ " more byte(s).") (Just inh) Nothing) else do let bytes = min 32768 (min blockSize remaining) hGet inh (fromIntegral bytes) -- we could check that we got fewer bytes than requested here, but we will send what we got and catch the EOF next time around -- copied from Internal.hs -- not sure how to avoid having two copies of this code yet sendFile :: Socket -> FilePath -> IO () sendFile outs infp = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp sendFile'' outs inp 0 count sendFileIterWith :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> IO a sendFileIterWith stepper outs infp blockSize = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp sendFileIterWith'' stepper outs inp blockSize 0 count sendFile' :: Socket -> FilePath -> Integer -> Integer -> IO () sendFile' outs infp offset count = withBinaryFile infp ReadMode $ \inp -> sendFile'' outs inp offset count sendFileIterWith' :: (IO Iter -> IO a) -> Socket -> FilePath -> Integer -> Integer -> Integer -> IO a sendFileIterWith' stepper outs infp blockSize offset count = withBinaryFile infp ReadMode $ \inp -> sendFileIterWith'' stepper outs inp blockSize offset count unsafeSendFile :: Handle -> FilePath -> IO () unsafeSendFile outp infp = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp unsafeSendFile'' outp inp 0 count unsafeSendFileIterWith :: (IO Iter -> IO a) -> Handle -> FilePath -> Integer -> IO a unsafeSendFileIterWith stepper outp infp blockSize = withBinaryFile infp ReadMode $ \inp -> do count <- hFileSize inp unsafeSendFileIterWith'' stepper outp inp blockSize 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 unsafeSendFileIterWith' :: (IO Iter -> IO a) -> Handle -- ^ The output handle -> FilePath -- ^ The input filepath -> Integer -- ^ maximum block size -> Integer -- ^ The offset to start at -> Integer -- ^ The number of bytes to send -> IO a unsafeSendFileIterWith' stepper outp infp blockSize offset count = withBinaryFile infp ReadMode $ \inp -> do unsafeSendFileIterWith'' stepper outp inp blockSize offset count sendfile-0.7.9/src/Network/Socket/SendFile/Darwin.hsc0000644000000000000000000000713412111753554020603 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} -- | Darwin system-dependent code for 'sendfile'. module Network.Socket.SendFile.Darwin (_sendFile, sendFileIter, sendfile) where 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.Socket.SendFile.Iter (Iter(..), runIter) import System.Posix.Types (Fd(..)) #include _sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO () _sendFile out_fd in_fd off count = do _ <- runIter (sendFileIter out_fd in_fd count off count) -- set blockSize == count. ie. send it all if we can. return () -- | a way to send things in chunks sendFileIter :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -> IO Iter sendFileIter out_fd in_fd blockSize off remaining = sendFileIterI out_fd in_fd (min blockSize maxBytes) off remaining sendFileIterI :: Fd -- ^ file descriptor corresponding to network socket -> Fd -- ^ file descriptor corresponding to file -> Int64 -- ^ maximum number of bytes to send at once -> Int64 -- ^ offset into file -> Int64 -- ^ total number of bytes to send -- -> Ptr Int64 -- ^ sent bytes ptr -> IO Iter sendFileIterI _out_fd _in_fd _blockSize _off 0 = return (Done 0) sendFileIterI out_fd in_fd blockSize off remaining = do let bytes = min remaining blockSize (wouldBlock, nsent) <- alloca $ \len -> do poke len bytes sendfileI out_fd in_fd off len let cont = sendFileIterI out_fd in_fd blockSize (off + nsent) (remaining `safeMinus` nsent) case wouldBlock of True -> return (WouldBlock (fromIntegral nsent) out_fd cont) False -> return (Sent (fromIntegral nsent) cont) -- | low-level wrapper around sendfile -- non-blocking -- returns number of bytes written and if EAGAIN/EINTR -- does not call 'threadWaitWrite' sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64) sendfile out_fd in_fd off count = alloca $ \len -> do poke len count sendfileI out_fd in_fd off len -- NOTE: should we retry automatically on EINTR (but not EAGAIN) sendfileI :: Fd -> Fd -> Int64 -> Ptr Int64 -> IO (Bool, Int64) sendfileI out_fd in_fd off len = do status <- c_sendfile out_fd in_fd off len if (status == 0) then do nsent <- peek len return $ (False, nsent) else do errno <- getErrno if (errno == eAGAIN) || (errno == eINTR) then do nsent <- peek len return (True, nsent) else throwErrno "Network.Socket.SendFile.Darwin.sendfileI" 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 :: 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