module Network.Sendfile.Linux (sendfile) where
import Control.Applicative
import Control.Concurrent
import Control.Exception
import Data.Int
import Data.Word
import Foreign.C.Error (eAGAIN, getErrno, throwErrno)
import Foreign.Marshal (alloca)
import Foreign.Ptr (Ptr)
import Foreign.Storable (poke)
import Network.Sendfile.Types
import Network.Socket
import System.Posix.Files
import System.Posix.IO
import System.Posix.Types (Fd(..))
sendfile :: Socket -> FilePath -> FileRange -> IO () -> IO ()
sendfile sock path range hook = bracket
(openFd path ReadOnly Nothing defaultFileFlags)
closeFd
sendfile'
where
dst = Fd $ fdSocket sock
sendfile' fd = alloca $ \offp -> do
case range of
EntireFile -> do
poke offp 0
len <- fileSize <$> getFdStatus fd
let len' = fromIntegral len
sendPart dst fd offp len' hook
PartOfFile off len -> do
poke offp (fromIntegral off)
let len' = fromIntegral len
sendPart dst fd offp len' hook
sendPart :: Fd -> Fd -> Ptr (Int32) -> (Word32) -> IO () -> IO ()
sendPart dst src offp len hook = do
do bytes <- c_sendfile dst src offp len
case bytes of
1 -> do errno <- getErrno
if errno == eAGAIN
then loop len
else throwErrno "Network.SendFile.Linux.sendPart"
0 -> return ()
_ -> loop (len fromIntegral bytes)
where
loop left
| left == 0 = return ()
| otherwise = do
hook
threadWaitWrite dst
sendPart dst src offp left hook
foreign import ccall unsafe "sendfile" c_sendfile
:: Fd -> Fd -> Ptr (Int32) -> (Word32) -> IO (Int32)