Darwin.hsc

{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- | Darwin system-dependent code for 'sendfile'.
module System.SendFile.Darwin
  ( sendFile
  , sendFileImpl
  , sendFileMode
  ) where

import           Control.Concurrent (threadWaitWrite)
import           Data.Int
import           Data.Word
import           Foreign.C.Error    (throwErrnoIfMinus1RetryMayBlock_)
#if __GLASGOW_HASKELL__ >= 703
import           Foreign.C.Types    (CInt (CInt))
#else
import           Foreign.C.Types    (CInt)
#endif
import           Foreign.Marshal    (alloca)
import           Foreign.Ptr        (Ptr, nullPtr)
import           Foreign.Storable   (peek, poke)
#if __GLASGOW_HASKELL__ >= 703
import           System.Posix.Types (COff (COff), Fd (Fd))
#else
import           System.Posix.Types (COff, Fd)
#endif

------------------------------------------------------------------------------
sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFile = sendFileImpl c_sendfile threadWaitWrite
{-# INLINE sendFile #-}


------------------------------------------------------------------------------
sendFileImpl :: (Fd -> Fd -> COff -> Ptr COff -> IO CInt)
             -> (Fd -> IO ())
             -> Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFileImpl !rawSendFile !wait out_fd in_fd off count
  | count == 0 = return 0
  | otherwise  = alloca $ \pbytes -> do
        poke pbytes $ fromIntegral count
        sbytes <- sendfile rawSendFile wait out_fd in_fd (fromIntegral off)
                           pbytes
        return $ fromIntegral sbytes
{-# INLINE sendFileImpl #-}


------------------------------------------------------------------------------
sendfile :: (Fd -> Fd -> COff -> Ptr COff -> IO CInt)
         -> (Fd -> IO ())
         -> Fd -> Fd -> COff -> Ptr COff -> IO COff
sendfile rawSendFile wait out_fd in_fd off pbytes = do
    throwErrnoIfMinus1RetryMayBlock_ "sendfile"
                                     (rawSendFile out_fd in_fd off pbytes)
                                     (wait out_fd)
    peek pbytes
{-# INLINE sendfile #-}

------------------------------------------------------------------------------
-- in Darwin sendfile gives LFS support (no sendfile64 routine)
foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile_darwin
    :: Fd -> Fd -> COff -> Ptr COff -> Ptr () -> CInt -> IO CInt


------------------------------------------------------------------------------
c_sendfile :: Fd -> Fd -> COff -> Ptr COff -> IO CInt
c_sendfile out_fd in_fd off pbytes =
    c_sendfile_darwin in_fd out_fd off pbytes nullPtr 0
{-# INLINE c_sendfile #-}


------------------------------------------------------------------------------
sendFileMode :: String
sendFileMode = "DARWIN_SENDFILE"