Internal.hsc

{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module SendFile.Internal (
    fileSize,
    sendFile,
    sendFile',
    sendFileMode
    ) where

import System.IO (
    Handle(..),
    IOMode(..),
    SeekMode(..),
    hFileSize,
    hFlush,
    hSeek,
    withBinaryFile
    )

#if defined(WIN32_SENDFILE)
import Foreign.C
import GHC.IOBase (haFD)
import GHC.Handle (withHandle_)

sendFileMode :: String
sendFileMode = "WIN32_SENDFILE"

sendFile' :: Handle -> FilePath -> Int -> Int -> IO ()
sendFile' outh infp offset count = do
    -- flush outh before handing it sendFile
    hFlush outh
    withHandle_ "sendFile" outh $ \outh' -> do 
    withCString infp $ \in_fp -> do
    let out_fd = haFD outh'
    err <- c_sendfile_win32 out_fd in_fp (fromIntegral offset) (fromIntegral count)
    if err == 0
        then return ()
        else fail ("system error " ++ show err)
    
foreign import ccall
    c_sendfile_win32 :: CInt -> CString -> CLong -> CLong -> IO Int
#endif

#if defined(LINUX_SENDFILE)
import Foreign.C
import GHC.IOBase (haFD)
import GHC.Handle (withHandle_)

sendFileMode :: String
sendFileMode = "LINUX_SENDFILE"

sendFile' :: Handle -> FilePath -> Int -> Int -> IO ()
sendFile' outh infp offset count = do
    -- flush outh before handing it sendFile
    hFlush outh
    withHandle_ "sendFile" outh $ \outh' -> do 
    withCString infp $ \in_fp -> do
    let out_fd = haFD outh'
    err <- c_sendfile_linux out_fd in_fp (fromIntegral offset) (fromIntegral count)
    if err == 0
        then return ()
        else fail ("errno " ++ show err)
    
foreign import ccall
    c_sendfile_linux :: CInt -> CString -> CLong -> CLong -> IO Int
#endif

#if defined(PORTABLE_SENDFILE)
import Prelude hiding (readFile)
import Data.ByteString.Char8

sendFileMode :: String
sendFileMode = "PORTABLE_SENDFILE"

-- FIXME: possibly immature / inefficient implementation
sendFile' :: Handle -> FilePath -> Int -> Int -> IO ()
sendFile' outh infp offset count =
    withBinaryFile infp ReadMode $ \inh -> do
    hSeek inh AbsoluteSeek (fromIntegral offset)
    hPutStr outh =<< hGet inh count
    hFlush outh 
    return ()
#endif

fileSize :: FilePath -> IO Int
fileSize fp = fmap fromIntegral (withBinaryFile fp ReadMode hFileSize)

sendFile :: Handle -> FilePath -> IO ()
sendFile outh infp = do
    count <- fileSize infp
    sendFile' outh infp 0 count