packages feed

sendfile 0.6.2 → 0.7.0

raw patch · 8 files changed

+590/−171 lines, 8 filesdep ~base

Dependency ranges changed: base

Files

sendfile.cabal view
@@ -1,5 +1,5 @@ name:          sendfile-version:       0.6.2+version:       0.7.0 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.@@ -22,10 +22,10 @@ library     hs-source-dirs:  src -    exposed-modules: Network.Socket.SendFile+    exposed-modules: Network.Socket.SendFile, Network.Socket.SendFile.Iter, Network.Socket.SendFile.Internal -    other-modules:   Network.Socket.SendFile.Internal-    +--    other-modules:+     build-depends:   base >= 3 && < 5,                      network >= 2 && < 3
src/Network/Socket/SendFile.hs view
@@ -8,15 +8,25 @@ 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, sendFile', unsafeSendFile, unsafeSendFile', sendFileMode)+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) @@ -33,6 +43,17 @@     -> 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@@ -42,6 +63,19 @@     -> 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 handle+    -> 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@@ -49,6 +83,17 @@     -> 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@@ -58,9 +103,22 @@     -> 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'.+-- 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
@@ -1,58 +1,77 @@ {-# LANGUAGE ForeignFunctionInterface #-} -- | Darwin system-dependent code for 'sendfile'.-module Network.Socket.SendFile.Darwin (_sendFile) where+module Network.Socket.SendFile.Darwin (_sendFile, sendFileIter, sendfile) where+ import Data.Int (Int64)-import Foreign.C.Error (eAGAIN, getErrno, throwErrno)+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)-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+_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 () -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)+-- | 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 -{-- 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.--}+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) -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 + nsent) nremaining (ctr + (fromIntegral nsent))-              else throwErrno "Network.Socket.SendFile.Darwin"++-- | 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
src/Network/Socket/SendFile/FreeBSD.hs view
@@ -1,38 +1,67 @@ {-# LANGUAGE ForeignFunctionInterface #-} -- | FreeBSD system-dependent code for 'sendfile'.-module Network.Socket.SendFile.FreeBSD (_sendFile) where-import Control.Concurrent (threadWaitWrite)+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) -_sendFile :: Fd -> Fd -> Integer -> Integer -> IO ()+-- | automatically loop and send everything+_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO () _sendFile out_fd in_fd off count = -    alloca $ \sbytes -> do-      rsendfile out_fd in_fd (fromIntegral off) (fromIntegral count) sbytes+    do _ <- runIter (sendFileIter out_fd in_fd (fromIntegral count) (fromIntegral off) (fromIntegral count)) -- set blockSize == count. ie. send it all if we can.+       return () -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+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) -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)+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 nbytes <- peek sbytes-                           sendfile out_fd in_fd (off + nbytes) (count `safeMinus` (fromIntegral nbytes)) sbytes (totalSent + nbytes)-                   else throwErrno "Network.Socket.SendFile.FreeBSD.sendfile"+                   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@@ -45,3 +74,6 @@  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
src/Network/Socket/SendFile/Internal.hs view
@@ -1,62 +1,76 @@ {-# LANGUAGE CPP, RecordWildCards #-} module Network.Socket.SendFile.Internal (     sendFile,+    sendFileIterWith,     sendFile',+    sendFileIterWith',     unsafeSendFile,+    unsafeSendFileIterWith,     unsafeSendFile',+    unsafeSendFileIterWith',     sendFileMode,     ) where #if defined(PORTABLE_SENDFILE)-import Data.ByteString.Char8 (hGet, hPutStr, length, ByteString)-import Network.Socket.ByteString (sendAll)-import Network.Socket (Socket(..))+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 (runIter) import Prelude hiding (length)-import System.IO (Handle, IOMode(..), SeekMode(..), hFileSize, hSeek, withBinaryFile)+import System.IO (Handle, IOMode(..), SeekMode(..), hFileSize, hIsEOF, hSeek, withBinaryFile)+import System.Posix.Types (Fd(..)) #else import Network.Socket (Socket(..), fdSocket) 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 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)-import System.IO (hFlush)-import System.IO.Error #else import GHC.IOBase import GHC.Handle hiding (fdToHandle) import qualified GHC.Handle #endif #endif+#endif +import Network.Socket.SendFile.Iter (Iter(..))+import System.IO (hFlush)++#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+import System.IO.Error+#endif+#endif + #if defined(WIN32_SENDFILE)-import Network.Socket.SendFile.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)+import Network.Socket.SendFile.Linux (_sendFile, sendFileIter)  sendFileMode :: String sendFileMode = "LINUX_SENDFILE" #endif  #if defined(FREEBSD_SENDFILE)-import Network.Socket.SendFile.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)+import Network.Socket.SendFile.Darwin (_sendFile, sendFileIter)  sendFileMode :: String sendFileMode = "DARWIN_SENDFILE"@@ -66,59 +80,186 @@ 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'' = wrapSendFile' $ \outs inp off count -> do-    hSeek inp AbsoluteSeek off-    rsend (sendAll outs) inp count+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'' = 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+unsafeSendFile'' outh inh off count =+    do _ <- unsafeSendFileIterWith'' runIter outh inh count off count+       return () -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)+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 :: (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+ #else sendFile'' :: Socket -> Handle -> Integer -> Integer -> IO ()-sendFile'' outs inp off count =+sendFile'' outs inh off count =     do let out_fd = Fd (fdSocket outs)-       in_fd <- handleToFd inp-       wrapSendFile' _sendFile out_fd in_fd off count+       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-       out_fd <- handleToFd outp-       in_fd  <- handleToFd inp-       wrapSendFile' _sendFile out_fd in_fd off count-    +       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+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 = +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@@ -128,29 +269,25 @@ 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+ -- | 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 and FreeBSD treat '0' as 'send the whole file'.-    | otherwise  = fun outp inp (fromIntegral off) (fromIntegral count)+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) -#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
+ src/Network/Socket/SendFile/Iter.hs view
@@ -0,0 +1,108 @@+module 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
src/Network/Socket/SendFile/Linux.hsc view
@@ -1,40 +1,76 @@ {-# LANGUAGE ForeignFunctionInterface #-} -- | Linux system-dependent code for 'sendfile'.-module Network.Socket.SendFile.Linux (_sendFile) where-import Data.Int-import Data.Word+module Network.Socket.SendFile.Linux (_sendFile, sendFileIter, sendfile) where++import Data.Int (Int32, Int64)+import Data.Word (Word32) 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)-import Control.Concurrent (threadWaitWrite)- #include <sys/sendfile.h> +-- | automatically loop and send everything _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+_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 () -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)+-- | 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 sendfile out_fd in_fd poff bytes-                else throwErrno "Network.Socket.SendFile.Linux"-      else return (fromIntegral sbytes)+                then return (True, 0)+                else throwErrno "Network.Socket.SendFile.Linux.sendfileI"+      else return (False, fromIntegral sbytes)++safeMinus :: (Ord a, Num 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
src/Network/Socket/SendFile/Win32.hsc view
@@ -1,6 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} -- | Win32 system-dependent code for 'TransmitFile'.-module Network.Socket.SendFile.Win32 (_sendFile) where+module Network.Socket.SendFile.Win32 (_sendFile, sendFileIter) where import Data.Bits ((.|.)) import Data.Int import Foreign.C.Error (throwErrnoIf)@@ -8,6 +8,7 @@ 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) @@ -17,10 +18,35 @@ type SOCKET = Fd  _sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()-_sendFile out_fd in_fd off count = do-    in_hdl <- get_osfhandle in_fd-    rtransmitFile out_fd in_hdl off count+_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@@ -36,25 +62,23 @@     -> DWORD     -- ^ the move method     -> IO Int64  -- ^ the new absolute offset setFilePointerEx hdl off meth = alloca $ \res -> do-    failIfZero+    _ <- 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)+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+    _ <- 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 ()@@ -62,6 +86,11 @@     --   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.