1{-# LANGUAGE ForeignFunctionInterface #-} 2{-# LANGUAGE CPP #-} 3 4module Network.Sendfile.Linux ( 5 sendfile 6 , sendfile' 7 , sendfileFd 8 , sendfileFd' 9 , sendfileWithHeader 10 , sendfileFdWithHeader 11 ) where 12 13import Control.Exception 14import Control.Monad 15import Data.ByteString as B 16import Data.ByteString.Internal 17import Foreign.C.Error (eAGAIN, getErrno, throwErrno) 18import Foreign.C.Types 19import Foreign.Marshal (alloca) 20import Foreign.Ptr (Ptr, plusPtr, castPtr) 21import Foreign.ForeignPtr 22import Foreign.Storable (poke, sizeOf) 23import GHC.Conc (threadWaitWrite) 24import Network.Sendfile.Types 25import Network.Socket 26import System.Posix.Files 27import System.Posix.IO ( OpenMode(..) 28 , OpenFileFlags(..) 29 , defaultFileFlags 30 , closeFd 31 ) 32import System.Posix.Types 33 34#include <sys/sendfile.h> 35#include <sys/socket.h> 36 37isLargeOffset :: Bool 38isLargeOffset = sizeOf (0 :: COff) == 8 39 40isLargeSize :: Bool 41isLargeSize = sizeOf (0 :: CSize) == 8 42 43safeSize :: CSize 44safeSize 45 | isLargeSize = 2^(60 :: Int) 46 | otherwise = 2^(30 :: Int) 47 48---------------------------------------------------------------- 49 50-- | 51-- Simple binding for sendfile() of Linux. 52-- Used system calls: 53-- 54-- - EntireFile -- open(), stat(), sendfile(), and close() 55-- 56-- - PartOfFile -- open(), sendfile(), and close() 57-- 58-- If the size of the file is unknown when sending the entire file, 59-- specifying PartOfFile is much faster. 60-- 61-- The fourth action argument is called when a file is sent as chunks. 62-- Chucking is inevitable if the socket is non-blocking (this is the 63-- default) and the file is large. The action is called after a chunk 64-- is sent and bofore waiting the socket to be ready for writing. 65 66sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO () 67sendfile sock path range hook = bracket setup teardown $ \fd -> 68 sendfileFd sock fd range hook 69 where 70 setup = openFd path ReadOnly defaultFileFlags{nonBlock=True} 71 teardown = closeFd 72 73sendfile' :: Fd -> ByteString -> FileRange -> IO () -> IO () 74sendfile' dst path range hook = bracket setup teardown $ \src -> 75 sendfileFd' dst src range hook 76 where 77 setup = openFdBS path ReadOnly defaultFileFlags{nonBlock=True} 78 teardown = closeFd 79 80-- | 81-- Simple binding for sendfile() of Linux. 82-- Used system calls: 83-- 84-- - EntireFile -- stat() and sendfile() 85-- 86-- - PartOfFile -- sendfile() 87-- 88-- If the size of the file is unknown when sending the entire file, 89-- specifying PartOfFile is much faster. 90-- 91-- The fourth action argument is called when a file is sent as chunks. 92-- Chucking is inevitable if the socket is non-blocking (this is the 93-- default) and the file is large. The action is called after a chunk 94-- is sent and bofore waiting the socket to be ready for writing. 95sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO () 96sendfileFd sock fd range hook = do 97#if MIN_VERSION_network(3,1,0) 98 withFdSocket sock $ \s -> do 99 let dst = Fd s 100#elif MIN_VERSION_network(3,0,0) 101 dst <- Fd <$> fdSocket sock 102#else 103 let dst = Fd $ fdSocket sock 104#endif 105 sendfileFd' dst fd range hook 106 107sendfileFd' :: Fd -> Fd -> FileRange -> IO () -> IO () 108sendfileFd' dst src range hook = 109 alloca $ \offp -> case range of 110 EntireFile -> do 111 poke offp 0 112 -- System call is very slow. Use PartOfFile instead. 113 len <- fileSize <$> getFdStatus src 114 let len' = fromIntegral len 115 sendfileloop dst src offp len' hook 116 PartOfFile off len -> do 117 poke offp (fromIntegral off) 118 let len' = fromIntegral len 119 sendfileloop dst src offp len' hook 120 121sendfileloop :: Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO () 122sendfileloop dst src offp len hook = do 123 -- Multicore IO manager use edge-trigger mode. 124 -- So, calling threadWaitWrite only when errnor is eAGAIN. 125 let toSend 126 | len > safeSize = safeSize 127 | otherwise = len 128 bytes <- c_sendfile dst src offp toSend 129 case bytes of 130 -1 -> do 131 errno <- getErrno 132 if errno == eAGAIN then do 133 threadWaitWrite dst 134 sendfileloop dst src offp len hook 135 else 136 throwErrno "Network.SendFile.Linux.sendfileloop" 137 0 -> return () -- the file is truncated 138 _ -> do 139 hook 140 let left = len - fromIntegral bytes 141 when (left /= 0) $ sendfileloop dst src offp left hook 142 143-- Dst Src in order. take care 144foreign import ccall unsafe "sendfile" 145 c_sendfile32 :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize 146 147foreign import ccall unsafe "sendfile64" 148 c_sendfile64 :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize 149 150c_sendfile :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize 151c_sendfile 152 | isLargeOffset = c_sendfile64 153 | otherwise = c_sendfile32 154 155---------------------------------------------------------------- 156 157-- | 158-- Simple binding for send() and sendfile() of Linux. 159-- Used system calls: 160-- 161-- - EntireFile -- send(), open(), stat(), sendfile(), and close() 162-- 163-- - PartOfFile -- send(), open(), sendfile(), and close() 164-- 165-- The fifth header is sent with send() + the MSG_MORE flag. If the 166-- file is small enough, the header and the file is send in a single 167-- TCP packet. 168-- 169-- If the size of the file is unknown when sending the entire file, 170-- specifying PartOfFile is much faster. 171-- 172-- The fourth action argument is called when a file is sent as chunks. 173-- Chucking is inevitable if the socket is non-blocking (this is the 174-- default) and the file is large. The action is called after a chunk 175-- is sent and bofore waiting the socket to be ready for writing. 176 177sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString] -> IO () 178sendfileWithHeader sock path range hook hdr = do 179 -- Copying is much faster than syscall. 180 sendMsgMore sock $ B.concat hdr 181 sendfile sock path range hook 182 183-- | 184-- Simple binding for send() and sendfile() of Linux. 185-- Used system calls: 186-- 187-- - EntireFile -- send(), stat() and sendfile() 188-- 189-- - PartOfFile -- send() and sendfile() 190-- 191-- The fifth header is sent with send() + the MSG_MORE flag. If the 192-- file is small enough, the header and the file is send in a single 193-- TCP packet. 194-- 195-- If the size of the file is unknown when sending the entire file, 196-- specifying PartOfFile is much faster. 197-- 198-- The fourth action argument is called when a file is sent as chunks. 199-- Chucking is inevitable if the socket is non-blocking (this is the 200-- default) and the file is large. The action is called after a chunk 201-- is sent and bofore waiting the socket to be ready for writing. 202 203sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] -> IO () 204sendfileFdWithHeader sock fd range hook hdr = do 205 -- Copying is much faster than syscall. 206 sendMsgMore sock $ B.concat hdr 207 sendfileFd sock fd range hook 208 209sendMsgMore :: Socket -> ByteString -> IO () 210sendMsgMore sock bs = withForeignPtr fptr $ \ptr -> do 211#if MIN_VERSION_network(3,1,0) 212 withFdSocket sock $ \fd -> do 213 let s = Fd fd 214#elif MIN_VERSION_network(3,0,0) 215 s <- Fd <$> fdSocket sock 216#else 217 let s = Fd $ fdSocket sock 218#endif 219 let buf = castPtr (ptr `plusPtr` off) 220 siz = fromIntegral len 221 sendloop s buf siz 222 where 223 PS fptr off len = bs 224 225sendloop :: Fd -> Ptr CChar -> CSize -> IO () 226sendloop s buf len = do 227 bytes <- c_send s buf len (#const MSG_MORE) 228 if bytes == -1 then do 229 errno <- getErrno 230 if errno == eAGAIN then do 231 threadWaitWrite s 232 sendloop s buf len 233 else 234 throwErrno "Network.SendFile.Linux.sendloop" 235 else do 236 let sent = fromIntegral bytes 237 when (sent /= len) $ do 238 let left = len - sent 239 ptr = buf `plusPtr` fromIntegral bytes 240 sendloop s ptr left 241 242foreign import ccall unsafe "send" 243 c_send :: Fd -> Ptr CChar -> CSize -> CInt -> IO CSsize 244