module System.SendFile
( sendFile
, sendFileMode
, sendHeaders
, sendHeadersImpl
) where
import Control.Concurrent (threadWaitWrite)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Unsafe as S
import Data.Word (Word64)
import Foreign.C.Error (throwErrnoIfMinus1RetryMayBlock)
import Foreign.C.Types (CChar (..), CInt (..), CSize (..))
import Foreign.Ptr (Ptr, plusPtr)
import System.Posix.Types (Fd (..))
import Data.ByteString.Builder (Builder, toLazyByteString)
import qualified System.SendFile.Linux as SF
sendFile :: Fd
-> Fd
-> Word64
-> Word64
-> IO ()
sendFile out_fd in_fd = go
where
go offs count | offs `seq` count <= 0 = return $! ()
| otherwise = do
nsent <- fromIntegral `fmap`
SF.sendFile out_fd in_fd
offs count
go (offs + nsent)
(count nsent)
sendFileMode :: String
sendFileMode = SF.sendFileMode
sendHeaders :: Builder -> Fd -> IO ()
sendHeaders = sendHeadersImpl c_send threadWaitWrite
sendHeadersImpl :: (Fd -> Ptr CChar -> CSize -> CInt -> IO CSize)
-> (Fd -> IO ())
-> Builder
-> Fd
-> IO ()
sendHeadersImpl sendFunc waitFunc headers fd =
sendFunc `seq` waitFunc `seq`
S.unsafeUseAsCStringLen (S.concat $ L.toChunks
$ toLazyByteString headers) $
\(cstr, clen) -> go cstr (fromIntegral clen)
where
flags = (32768)
go cstr clen | cstr `seq` clen <= 0 = return $! ()
| otherwise = do
nsent <- throwErrnoIfMinus1RetryMayBlock
"sendHeaders"
(sendFunc fd cstr clen flags)
(waitFunc fd)
let cstr' = plusPtr cstr (fromIntegral nsent)
go cstr' (clen nsent)
foreign import ccall unsafe "sys/socket.h send" c_send
:: Fd -> Ptr CChar -> CSize -> CInt -> IO CSize