module System.Syscall.Linux
( c_open, c_close,
c_read, c_write,
c_fcntl,
StructStat(..), c_stat, c_fstat, c_lstat,
c_sendfile
)
where
import Foreign
import Foreign.C
newtype FcntlFlags = FcntlFlags { unFcntlFlags :: CInt } deriving (Eq, Ord)
o_rdonly :: FcntlFlags
o_rdonly = FcntlFlags 0
o_wronly :: FcntlFlags
o_wronly = FcntlFlags 1
o_rdwr :: FcntlFlags
o_rdwr = FcntlFlags 2
o_creat :: FcntlFlags
o_creat = FcntlFlags 64
o_append :: FcntlFlags
o_append = FcntlFlags 1024
instance Show FcntlFlags where
show f | f == o_rdonly = "O_RDONLY"
| f == o_wronly = "O_WRONLY"
| f == o_rdwr = "O_RDWR"
| f == o_creat = "O_CREAT"
| f == o_append = "O_APPEND"
| otherwise = show $ unFcntlFlags f
foreign import ccall unsafe "unistd.h open" c_open
:: CString -> CInt -> IO CInt
foreign import ccall unsafe "unistd.h close" c_close
:: CInt -> IO CInt
foreign import ccall unsafe "unistd.h read" c_read
:: CInt -> Ptr () -> CSize -> IO (CSize)
foreign import ccall unsafe "unistd.h write" c_write
:: CInt -> Ptr () -> CSize -> IO (CSize)
foreign import ccall unsafe "fcntl.h fcntl" c_fcntl
:: CInt -> CInt -> CLong -> IO CInt
data StructStat = StructStat {
stSize :: ! Int64
}
type StructStatPtr = Ptr StructStat
instance Storable StructStat where
alignment _ = 4
sizeOf _ = (96)
peek p = do
size <- (\hsc_ptr -> peekByteOff hsc_ptr 44) p
return (StructStat size)
poke p (StructStat size) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 44) p size
foreign import ccall unsafe "stat" c_stat
:: CString -> StructStatPtr -> IO CInt
foreign import ccall unsafe "fstat" c_fstat
:: CInt -> StructStatPtr -> IO CInt
foreign import ccall unsafe "lstat" c_lstat
:: CString -> StructStatPtr -> IO CInt
foreign import ccall unsafe "sendfile" c_sendfile
:: CInt -> CInt -> Ptr (Int64) -> (Word32) -> IO (Int32)