FreeBSD.hs

{-# LANGUAGE ForeignFunctionInterface #-}
-- | FreeBSD system-dependent code for 'sendfile'.
module Network.Socket.SendFile.FreeBSD (_sendFile, sendFileIter, sendfile) where
import Data.Int (Int64)
import Foreign.C.Error (eAGAIN, eINTR, getErrno, throwErrno)
import Foreign.C.Types (CInt, CSize)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peek)
import Network.Socket.SendFile.Iter (Iter(..), runIter)
import System.Posix.Types (COff, Fd)

-- | automatically loop and send everything
_sendFile :: Fd -> Fd -> Int64 -> Int64 -> IO ()
_sendFile out_fd in_fd off count = 
    do _ <- runIter (sendFileIter out_fd in_fd (fromIntegral count) (fromIntegral off) (fromIntegral count)) -- set blockSize == count. ie. send it all if we can.
       return ()

sendFileIter  :: Fd -- ^ file descriptor corresponding to network socket
              -> Fd -- ^ file descriptor corresponding to file
              -> Int64 -- ^ maximum number of bytes to send at once
              -> Int64 -- ^ offset into file
              -> Int64 -- ^ total number of bytes to send
              -> IO Iter
sendFileIter out_fd in_fd blockSize off count =
    sendFileIterI out_fd in_fd (min (fromIntegral blockSize) maxBytes) (fromIntegral off) (fromIntegral count)

sendFileIterI :: Fd -- ^ file descriptor corresponding to network socket
              -> Fd -- ^ file descriptor corresponding to file
              -> CSize -- ^ maximum number of bytes to send at once
              -> COff -- ^ offset into file
              -> CSize -- ^ total number of bytes to send
              -> IO Iter
sendFileIterI _out_fd _in_fd _blockSize _off  0         = return (Done 0)
sendFileIterI  out_fd  in_fd  blockSize  off  remaining =
    do let bytes = min remaining blockSize
       (wouldBlock, nsent) <- alloca $ \sbytes -> sendfileI out_fd in_fd off bytes sbytes
       let cont = sendFileIterI out_fd in_fd blockSize (off + nsent) (remaining `safeMinus` (fromIntegral nsent))
       case wouldBlock of
         True  -> return (WouldBlock (fromIntegral nsent) out_fd cont)
         False -> return (Sent (fromIntegral nsent) cont)

-- | low-level wrapper around sendfile
-- non-blocking
-- returns number of bytes written and if EAGAIN
-- does not call 'threadWaitWrite'
sendfile :: Fd -> Fd -> Int64 -> Int64 -> IO (Bool, Int64)
sendfile out_fd in_fd off count =
    alloca $ \sbytes ->
        do (wb, sent) <- sendfileI out_fd in_fd (fromIntegral off) (fromIntegral count) sbytes
           return (wb, fromIntegral sent)

-- NOTE: should we retry automatically on EINTR (but not EAGAIN)
sendfileI :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO (Bool, COff)
sendfileI out_fd in_fd off count sbytes =
    do status <- c_sendfile out_fd in_fd off count sbytes
       if (status == 0)
          then do nsent <- peek sbytes
                  return (False, nsent)
          else do errno <- getErrno
                  if (errno == eAGAIN) || (errno == eINTR) 
                   then do nsent <- peek sbytes
                           return (True, nsent)
                   else throwErrno "Network.Socket.SendFile.FreeBSD.sendfileI"

safeMinus :: (Ord a, Num a) => a -> a -> a
safeMinus x y
    | y >= x = 0
    | otherwise = x - y

-- max num of bytes in one send
maxBytes :: CSize
maxBytes = maxBound :: CSize

foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile_freebsd
    :: Fd -> Fd -> COff -> CSize -> Ptr () -> Ptr COff -> CInt -> IO CInt

c_sendfile :: Fd -> Fd -> COff -> CSize -> Ptr COff -> IO CInt
c_sendfile out_fd in_fd off count sbytes = c_sendfile_freebsd in_fd out_fd off count nullPtr sbytes 0