1{-# LANGUAGE BangPatterns #-} 2{-# LANGUAGE CPP #-} 3{-# LANGUAGE ForeignFunctionInterface #-} 4 5------------------------------------------------------------------------------ 6-- | Linux system-dependent code for 'sendfile'. 7module System.SendFile.Linux 8 ( sendFile 9 , sendFileImpl 10 , sendFileMode 11 ) where 12 13------------------------------------------------------------------------------ 14import Control.Concurrent (threadWaitWrite) 15import Data.Int (Int64) 16import Data.Word (Word64) 17import Foreign.C.Error (throwErrnoIfMinus1RetryMayBlock) 18#if __GLASGOW_HASKELL__ >= 703 19import Foreign.C.Types (CInt (..), CSize (..)) 20#else 21import Foreign.C.Types (CSize) 22#endif 23import Foreign.Marshal (alloca) 24import Foreign.Ptr (Ptr, nullPtr) 25import Foreign.Storable (poke) 26#if __GLASGOW_HASKELL__ >= 703 27import System.Posix.Types (COff (..), CSsize (..), Fd (..)) 28#else 29import System.Posix.Types (COff, CSsize, Fd) 30#endif 31 32 33------------------------------------------------------------------------------ 34sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO Int64 35sendFile = sendFileImpl c_sendfile threadWaitWrite 36{-# INLINE sendFile #-} 37 38 39------------------------------------------------------------------------------ 40sendFileImpl :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize) 41 -> (Fd -> IO ()) 42 -> Fd -> Fd -> Word64 -> Word64 -> IO Int64 43sendFileImpl !raw_sendfile !wait out_fd in_fd off count 44 | count <= 0 = return 0 45 | off == 0 = do 46 nsent <- sendfile raw_sendfile wait out_fd in_fd nullPtr bytes 47 return $! fromIntegral nsent 48 | otherwise = alloca $ \poff -> do 49 poke poff (fromIntegral off) 50 nsent <- sendfile raw_sendfile wait out_fd in_fd poff bytes 51 return $! fromIntegral nsent 52 where 53 bytes = fromIntegral count 54{-# INLINE sendFileImpl #-} 55 56 57------------------------------------------------------------------------------ 58sendfile :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize) 59 -> (Fd -> IO ()) 60 -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize 61sendfile raw_sendfile wait out_fd in_fd poff bytes = 62 throwErrnoIfMinus1RetryMayBlock 63 "sendfile" 64 (raw_sendfile out_fd in_fd poff bytes) 65 (wait out_fd) 66{-# INLINE sendfile #-} 67 68 69------------------------------------------------------------------------------ 70-- sendfile64 gives LFS support 71foreign import ccall unsafe "sys/sendfile.h sendfile64" c_sendfile 72 :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize 73 74 75------------------------------------------------------------------------------ 76sendFileMode :: String 77sendFileMode = "LINUX_SENDFILE" 78