diff --git a/Network/Sendfile.hs b/Network/Sendfile.hs --- a/Network/Sendfile.hs +++ b/Network/Sendfile.hs @@ -9,6 +9,10 @@ module Network.Sendfile ( sendfile , sendfileWithHeader +#if OS_BSD || OS_MacOS || OS_Linux + , sendfileFd + , sendfileFdWithHeader +#endif , FileRange(..) ) where @@ -20,8 +24,6 @@ import Network.Sendfile.BSD #elif OS_Linux import Network.Sendfile.Linux -#elif OS_Windows -import Network.Sendfile.Windows #else import Network.Sendfile.Fallback #endif diff --git a/Network/Sendfile/BSD.hsc b/Network/Sendfile/BSD.hsc --- a/Network/Sendfile/BSD.hsc +++ b/Network/Sendfile/BSD.hsc @@ -2,7 +2,9 @@ module Network.Sendfile.BSD ( sendfile + , sendfileFd , sendfileWithHeader + , sendfileFdWithHeader ) where import Control.Concurrent @@ -39,14 +41,29 @@ sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO () sendfile sock path range hook = bracket setup teardown $ \fd -> + sendfileFd sock fd range hook + where + setup = openFd path ReadOnly Nothing defaultFileFlags + teardown = closeFd + +-- | +-- Simple binding for sendfile() of BSD and MacOS. +-- +-- - Used system calls: sendfile() +-- +-- The fourth action argument is called when a file is sent as chunks. +-- Chucking is inevitable if the socket is non-blocking (this is the +-- default) and the file is large. The action is called after a chunk +-- is sent and bofore waiting the socket to be ready for writing. + +sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO () +sendfileFd sock fd range hook = alloca $ \sentp -> do let (off,len) = case range of EntireFile -> (0, entire) PartOfFile off' len' -> (fromInteger off', fromInteger len') sendloop dst fd off len sentp hook where - setup = openFd path ReadOnly Nothing defaultFileFlags - teardown = closeFd dst = Fd $ fdSocket sock sendloop :: Fd -> Fd -> COff -> COff -> Ptr COff -> IO () -> IO () @@ -83,13 +100,35 @@ sendfileWithHeader :: Socket -> FilePath -> FileRange -> IO () -> [ByteString] -> IO () sendfileWithHeader sock path range hook hdr = - bracket setup teardown $ \fd -> alloca $ \sentp -> + bracket setup teardown $ \fd -> sendfileFdWithHeader sock fd range hook hdr + where + setup = openFd path ReadOnly Nothing defaultFileFlags + teardown = closeFd + +-- | +-- Simple binding for sendfile() of BSD and MacOS. +-- +-- - Used system calls: sendfile() +-- +-- The fifth header is also sent with sendfile(). If the file is +-- small enough, the header and the file is send in a single TCP packet +-- on FreeBSD. MacOS sends the header and the file separately but it is +-- fast. +-- +-- The fourth action argument is called when a file is sent as chunks. +-- Chucking is inevitable if the socket is non-blocking (this is the +-- default) and the file is large. The action is called after a chunk +-- is sent and bofore waiting the socket to be ready for writing. + +sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] -> IO () +sendfileFdWithHeader sock fd range hook hdr = + alloca $ \sentp -> if isFreeBSD && hlen >= 8192 then do -- If the length of the header is larger than 8191, -- threadWaitWrite does not come back on FreeBSD, sigh. -- We use writev() for the header and sendfile() for the file. sendMany sock hdr - sendfile sock path range hook + sendfileFd sock fd range hook else do -- On MacOS, the header and the body are sent separately. -- But it's fast. the writev() and sendfile() combination @@ -105,8 +144,6 @@ threadWaitWrite dst sendloop dst fd newoff newlen sentp hook where - setup = openFd path ReadOnly Nothing defaultFileFlags - teardown = closeFd dst = Fd $ fdSocket sock hlen = fromIntegral . sum . map BS.length $ hdr diff --git a/Network/Sendfile/Linux.hsc b/Network/Sendfile/Linux.hsc --- a/Network/Sendfile/Linux.hsc +++ b/Network/Sendfile/Linux.hsc @@ -2,7 +2,9 @@ module Network.Sendfile.Linux ( sendfile + , sendfileFd , sendfileWithHeader + , sendfileFdWithHeader ) where import Control.Applicative @@ -47,6 +49,29 @@ sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO () sendfile sock path range hook = bracket setup teardown $ \fd -> + sendfileFd sock fd range hook + where + setup = openFd path ReadOnly Nothing defaultFileFlags + teardown = closeFd + +-- | +-- Simple binding for sendfile() of Linux. +-- Used system calls: +-- +-- - EntireFile -- stat() and sendfile() +-- +-- - PartOfFile -- sendfile() +-- +-- If the size of the file is unknown when sending the entire file, +-- specifying PartOfFile is much faster. +-- +-- The fourth action argument is called when a file is sent as chunks. +-- Chucking is inevitable if the socket is non-blocking (this is the +-- default) and the file is large. The action is called after a chunk +-- is sent and bofore waiting the socket to be ready for writing. + +sendfileFd :: Socket -> Fd -> FileRange -> IO () -> IO () +sendfileFd sock fd range hook = alloca $ \offp -> case range of EntireFile -> do poke offp 0 @@ -59,8 +84,6 @@ let len' = fromIntegral len sendloop dst fd offp len' hook where - setup = openFd path ReadOnly Nothing defaultFileFlags - teardown = closeFd dst = Fd $ fdSocket sock sendloop :: Fd -> Fd -> Ptr COff -> CSize -> IO () -> IO () @@ -113,6 +136,32 @@ -- Copying is much faster than syscall. sendAllMsgMore sock $ B.concat hdr sendfile sock path range hook + +-- | +-- Simple binding for send() and sendfile() of Linux. +-- Used system calls: +-- +-- - EntireFile -- send(), stat() and sendfile() +-- +-- - PartOfFile -- send() and sendfile() +-- +-- The fifth header is sent with send() + the MSG_MORE flag. If the +-- file is small enough, the header and the file is send in a single +-- TCP packet. +-- +-- If the size of the file is unknown when sending the entire file, +-- specifying PartOfFile is much faster. +-- +-- The fourth action argument is called when a file is sent as chunks. +-- Chucking is inevitable if the socket is non-blocking (this is the +-- default) and the file is large. The action is called after a chunk +-- is sent and bofore waiting the socket to be ready for writing. + +sendfileFdWithHeader :: Socket -> Fd -> FileRange -> IO () -> [ByteString] -> IO () +sendfileFdWithHeader sock fd range hook hdr = do + -- Copying is much faster than syscall. + sendAllMsgMore sock $ B.concat hdr + sendfileFd sock fd range hook sendAllMsgMore :: Socket -> ByteString -> IO () sendAllMsgMore sock bs = do diff --git a/simple-sendfile.cabal b/simple-sendfile.cabal --- a/simple-sendfile.cabal +++ b/simple-sendfile.cabal @@ -1,5 +1,5 @@ Name: simple-sendfile -Version: 0.2.6 +Version: 0.2.7 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3