1{-# LANGUAGE BangPatterns             #-}
2{-# LANGUAGE CPP                      #-}
3{-# LANGUAGE ForeignFunctionInterface #-}
4
5------------------------------------------------------------------------------
6-- | Linux system-dependent code for 'sendfile'.
7module System.SendFile.Linux
8  ( sendFile
9  , sendFileImpl
10  , sendFileMode
11  ) where
12
13------------------------------------------------------------------------------
14import           Control.Concurrent (threadWaitWrite)
15import           Data.Int           (Int64)
16import           Data.Word          (Word64)
17import           Foreign.C.Error    (throwErrnoIfMinus1RetryMayBlock)
18#if __GLASGOW_HASKELL__ >= 703
19import           Foreign.C.Types    (CInt (..), CSize (..))
20#else
21import           Foreign.C.Types    (CSize)
22#endif
23import           Foreign.Marshal    (alloca)
24import           Foreign.Ptr        (Ptr, nullPtr)
25import           Foreign.Storable   (poke)
26#if __GLASGOW_HASKELL__ >= 703
27import           System.Posix.Types (COff (..), CSsize (..), Fd (..))
28#else
29import           System.Posix.Types (COff, CSsize, Fd)
30#endif
31
32
33------------------------------------------------------------------------------
34sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO Int64
35sendFile = sendFileImpl c_sendfile threadWaitWrite
36{-# INLINE sendFile #-}
37
38
39------------------------------------------------------------------------------
40sendFileImpl :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
41             -> (Fd -> IO ())
42             -> Fd -> Fd -> Word64 -> Word64 -> IO Int64
43sendFileImpl !raw_sendfile !wait out_fd in_fd off count
44  | count <= 0 = return 0
45  | off   == 0 = do
46        nsent <- sendfile raw_sendfile wait out_fd in_fd nullPtr bytes
47        return $! fromIntegral nsent
48  | otherwise  = alloca $ \poff -> do
49        poke poff (fromIntegral off)
50        nsent <- sendfile raw_sendfile wait out_fd in_fd poff bytes
51        return $! fromIntegral nsent
52    where
53      bytes = fromIntegral count
54{-# INLINE sendFileImpl #-}
55
56
57------------------------------------------------------------------------------
58sendfile :: (Fd -> Fd -> Ptr COff -> CSize -> IO CSsize)
59         -> (Fd -> IO ())
60         -> Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
61sendfile raw_sendfile wait out_fd in_fd poff bytes =
62    throwErrnoIfMinus1RetryMayBlock
63            "sendfile"
64            (raw_sendfile out_fd in_fd poff bytes)
65            (wait out_fd)
66{-# INLINE sendfile #-}
67
68
69------------------------------------------------------------------------------
70-- sendfile64 gives LFS support
71foreign import ccall unsafe "sys/sendfile.h sendfile64" c_sendfile
72    :: Fd -> Fd -> Ptr COff -> CSize -> IO CSsize
73
74
75------------------------------------------------------------------------------
76sendFileMode :: String
77sendFileMode = "LINUX_SENDFILE"
78