packages feed

sendfile 0.4 → 0.5

raw patch · 7 files changed

+166/−75 lines, 7 files

Files

sendfile.cabal view
@@ -1,5 +1,5 @@ name:          sendfile-version:       0.4+version:       0.5 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.
src/Network/Socket/SendFile.hs view
@@ -1,11 +1,13 @@ -- | 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, and the number of bytes you want to send; sendFile' and unsafeSendFile' comprise this interface.+--   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 (especially if you are using hSeek before sending).+--   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,     -- * Safe functions (recommended)     sendFile,     sendFile',@@ -20,10 +22,15 @@     sendFileMode     ) where import qualified Network.Socket.SendFile.Internal (sendFile, sendFile', sendFileMode, unsafeSendFile, unsafeSendFile')-    -import System.IO (Handle) 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@@ -31,12 +38,13 @@     -> 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` and the number of bytes you would like to read; this number must be a positive integer. This unlocks the full potential `Handle`(s). For instance, if you wanted to start reading from a particular offset in the file you could utilize `hSeek`; if you needed the file size you could use 'hFileSize'.+-- | 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. sendFile'-    :: Socket  -- ^ The output socket-    -> Handle  -- ^ The input file handle-    -> Integer -- ^ The number of bytes to send-    -> IO ()   -- +    :: Socket    -- ^ The output socket+    -> Handle    -- ^ The input file handle+    -> Offset    -- ^ The offset to start at+    -> ByteCount -- ^ The number of bytes to send+    -> IO () sendFile' = Network.Socket.SendFile.Internal.sendFile'  -- | 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.@@ -48,12 +56,14 @@  -- | 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-    -> Integer -- ^ The number of bytes to send+    :: Handle    -- ^ The output handle+    -> Handle    -- ^ The input file handle+    -> 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'. sendFileMode :: String -- ^ The mode that sendfile was compiled with sendFileMode = Network.Socket.SendFile.Internal.sendFileMode+
src/Network/Socket/SendFile/FreeBSD.hs view
@@ -3,14 +3,17 @@ module Network.Socket.SendFile.FreeBSD (_sendFile) where import Foreign.C.Error (throwErrnoIfMinus1_) 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 ()-_sendFile out_fd in_fd count =+_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 nullPtr 0)+      (c_sendfile_freebsd in_fd out_fd 0 (fromIntegral count) nullPtr sbytes 0)+    fmap fromIntegral (peek sbytes)  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,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} module Network.Socket.SendFile.Internal (     sendFile,     sendFile',@@ -7,18 +6,19 @@     unsafeSendFile,     unsafeSendFile',     ) where--import Network.Socket (Socket(..), fdSocket)-import System.IO (-    Handle,-    IOMode(..),-    hFileSize,-    hFlush,-    withBinaryFile-    )-import System.Posix.Types (Fd(..))+#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)+#else import GHC.Handle (withHandle_) import GHC.IOBase (haFD)+import Network.Socket (Socket(..), fdSocket)+import System.IO (Handle, IOMode(..), hFileSize, hFlush, withBinaryFile)+import System.Posix.Types (Fd(..))+#endif  #if defined(WIN32_SENDFILE) import Network.Socket.SendFile.Win32 (_sendFile)@@ -42,52 +42,64 @@ #endif  #if defined(PORTABLE_SENDFILE)-import Data.ByteString.Char8 (hGet, hPutStr)-import Network.Socket.ByteString (sendAll)- sendFileMode :: String sendFileMode = "PORTABLE_SENDFILE" -sendFile' :: Socket -> Handle -> Integer -> IO ()-sendFile' = wrapSendFile' $ \outs inp count -> do-    sendAll outs =<< hGet inp (fromIntegral count)-    return ()+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 -> IO ()-unsafeSendFile' = wrapSendFile' $ \outp inp count -> do-    hPutStr outp =<< hGet inp (fromIntegral count)+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++rsend :: (ByteString -> IO ()) -> Handle -> Integer -> IO ()+rsend write inp n = do+  loop n+  where+    loop 0        = return ()+    loop reqBytes = do+      let bytes = min 32768 reqBytes :: Integer+      buf <- hGet inp (fromIntegral bytes)+      write buf+      loop $ reqBytes - (fromIntegral $ length buf)+ #else-sendFile' :: Socket -> Handle -> Integer -> IO ()-sendFile' outs inp count =+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 count+    wrapSendFile' _sendFile out_fd in_fd off count -unsafeSendFile' :: Handle -> Handle -> Integer -> IO ()-unsafeSendFile' outp inp count = do+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 count+    wrapSendFile' _sendFile out_fd in_fd off count #endif --- | wraps sendFile' to check arguments-wrapSendFile' :: (a -> b -> Integer -> IO ()) -> a -> b -> Integer -> IO ()-wrapSendFile' fun outp inp count-    | 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'.-    | otherwise  = fun outp inp count- sendFile :: Socket -> FilePath -> IO () sendFile outs infp = withBinaryFile infp ReadMode $ \inp -> do     count <- hFileSize inp-    sendFile' outs inp count+    sendFile' outs inp 0 count  unsafeSendFile :: Handle -> FilePath -> IO () unsafeSendFile outp infp = withBinaryFile infp ReadMode $ \inp -> do     count <- hFileSize inp-    unsafeSendFile' outp inp count+    unsafeSendFile' outp inp 0 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'.+    | otherwise  = fun outp inp (fromIntegral off) (fromIntegral count)+
− src/Network/Socket/SendFile/Linux.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--- | Linux system-dependent code for 'sendfile'.-module Network.Socket.SendFile.Linux (_sendFile) where-import Foreign.C.Error (throwErrnoIfMinus1_)-import Foreign.C.Types (CSize)-import Foreign.Ptr (Ptr, nullPtr)-import System.Posix.Types (COff, Fd)--_sendFile :: Fd -> Fd -> Integer -> IO ()-_sendFile out_fd in_fd count =-    throwErrnoIfMinus1_-      "Network.Socket.SendFile.Linux.sendFile'"-      (c_sendfile_linux out_fd in_fd nullPtr (fromIntegral count))--foreign import ccall unsafe "sys/sendfile.h sendfile" c_sendfile_linux-    :: Fd -> Fd -> Ptr COff -> CSize -> IO CSize-
+ src/Network/Socket/SendFile/Linux.hsc view
@@ -0,0 +1,46 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- | Linux system-dependent code for 'sendfile'.+module Network.Socket.SendFile.Linux (_sendFile) where+import Data.Int+import Data.Word+import Foreign.C.Error (eAGAIN, getErrno, throwErrno)+import Foreign.Marshal (alloca)+import Foreign.Ptr (Ptr)+import Foreign.Storable(poke)+import System.Posix.Types (Fd)+import Control.Concurrent (threadWaitWrite)++#include <sys/sendfile.h>++_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()+_sendFile out_fd in_fd off count = do+    alloca $ \poff -> do+    poke poff off+    rsendfile out_fd in_fd poff count++rsendfile :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO ()+rsendfile _      _     _    0         = return ()+rsendfile out_fd in_fd poff remaining = do+    let bytes = min remaining maxBytes+    sbytes <- sendfile out_fd in_fd poff bytes+    rsendfile out_fd in_fd poff (remaining - sbytes)+    +sendfile :: Fd -> Fd -> Ptr Int64 -> Int64 -> IO Int64+sendfile out_fd in_fd poff bytes = do+    threadWaitWrite out_fd+    sbytes <- c_sendfile out_fd in_fd poff (fromIntegral bytes)+    if sbytes <= -1+      then do errno <- getErrno+              if errno == eAGAIN+                then sendfile out_fd in_fd poff bytes+                else throwErrno "Network.Socket.SendFile.Linux"+      else return (fromIntegral sbytes)++-- 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 off_t) -> (#type size_t) -> IO (#type ssize_t)+
src/Network/Socket/SendFile/Win32.hsc view
@@ -1,9 +1,13 @@ {-# LANGUAGE ForeignFunctionInterface #-} -- | Win32 system-dependent code for 'TransmitFile'. module Network.Socket.SendFile.Win32 (_sendFile) where+import Data.Bits ((.|.))+import Data.Int import Foreign.C.Error (throwErrnoIf)-import Foreign.Ptr (IntPtr, Ptr, intPtrToPtr, nullPtr) import Foreign.C.Types (CInt)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (IntPtr, Ptr, intPtrToPtr, nullPtr)+import Foreign.Storable (peek) import System.Posix.Types (Fd) import System.Win32.Types (DWORD, HANDLE, failIfZero) @@ -12,10 +16,10 @@  type SOCKET = Fd -_sendFile :: Fd -> Fd -> Integer -> IO ()-_sendFile out_fd in_fd count = do+_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()+_sendFile out_fd in_fd off count = do     in_hdl <- get_osfhandle in_fd-    transmitFile out_fd in_hdl (fromIntegral count)+    rtransmitFile out_fd in_hdl off count  get_osfhandle :: Fd        -- ^ User file descriptor.               -> IO HANDLE -- ^ The operating-system file handle.@@ -26,6 +30,25 @@              (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++rtransmitFile :: SOCKET -> HANDLE -> Int64 -> Int64 -> IO ()+rtransmitFile _      _      _   0         = return ()+rtransmitFile out_fd in_hdl off remaining = do+    let bytes = min remaining maxBytes+    setFilePointerEx in_hdl off (#const FILE_BEGIN)+    transmitFile out_fd in_hdl (fromIntegral bytes)+    rtransmitFile out_fd in_hdl (off + bytes) (remaining - bytes)+ 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.@@ -33,17 +56,31 @@ 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))+      (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. +-- 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 unsafe "mswsock.h TransmitFile"+foreign import stdcall safe "mswsock.h TransmitFile"     c_TransmitFile :: SOCKET                    -> HANDLE                    -> DWORD