{-# LINE 1 "System/Posix/IO/Common.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}
module System.Posix.IO.Common (
stdInput, stdOutput, stdError,
OpenMode(..),
OpenFileFlags(..), defaultFileFlags,
openat_,
closeFd,
fdReadBuf, fdWriteBuf,
fdSeek,
FdOption(..),
queryFdOption,
setFdOption,
FileLock,
LockRequest(..),
getLock, setLock,
waitToSetLock,
createPipe,
dup, dupTo,
handleToFd,
fdToHandle,
) where
import System.IO
import System.IO.Error
import System.Posix.Types
import qualified System.Posix.Internals as Base
import Foreign
import Foreign.C
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import qualified GHC.IO.FD as FD
import qualified GHC.IO.Handle.FD as FD
import GHC.IO.Exception
import Data.Typeable (cast)
{-# LINE 81 "System/Posix/IO/Common.hsc" #-}
{-# LINE 92 "System/Posix/IO/Common.hsc" #-}
createPipe :: IO (Fd, Fd)
createPipe =
allocaArray 2 $ \p_fd -> do
throwErrnoIfMinus1_ "createPipe" (c_pipe p_fd)
rfd <- peekElemOff p_fd 0
wfd <- peekElemOff p_fd 1
return (Fd rfd, Fd wfd)
foreign import ccall unsafe "pipe"
c_pipe :: Ptr CInt -> IO CInt
{-# LINE 114 "System/Posix/IO/Common.hsc" #-}
{-# LINE 128 "System/Posix/IO/Common.hsc" #-}
dup :: Fd -> IO Fd
dup (Fd fd) = do r <- throwErrnoIfMinus1 "dup" (c_dup fd); return (Fd r)
dupTo :: Fd -> Fd -> IO Fd
dupTo (Fd fd1) (Fd fd2) = do
r <- throwErrnoIfMinus1 "dupTo" (c_dup2 fd1 fd2)
return (Fd r)
foreign import ccall unsafe "dup"
c_dup :: CInt -> IO CInt
foreign import ccall unsafe "dup2"
c_dup2 :: CInt -> CInt -> IO CInt
{-# LINE 149 "System/Posix/IO/Common.hsc" #-}
stdInput, stdOutput, stdError :: Fd
stdInput = Fd (0)
{-# LINE 155 "System/Posix/IO/Common.hsc" #-}
stdOutput = Fd (1)
{-# LINE 156 "System/Posix/IO/Common.hsc" #-}
stdError = Fd (2)
{-# LINE 157 "System/Posix/IO/Common.hsc" #-}
data OpenMode = ReadOnly | WriteOnly | ReadWrite
deriving (Read, Show, Eq, Ord)
data OpenFileFlags =
OpenFileFlags {
append :: Bool,
exclusive :: Bool,
noctty :: Bool,
nonBlock :: Bool,
trunc :: Bool,
nofollow :: Bool,
creat :: Maybe FileMode,
cloexec :: Bool,
directory :: Bool,
sync :: Bool
}
deriving (Read, Show, Eq, Ord)
defaultFileFlags :: OpenFileFlags
defaultFileFlags =
OpenFileFlags {
append = False,
exclusive = False,
noctty = False,
nonBlock = False,
trunc = False,
nofollow = False,
creat = Nothing,
cloexec = False,
directory = False,
sync = False
}
openat_ :: Maybe Fd
-> CString
-> OpenMode
-> OpenFileFlags
-> IO Fd
openat_ fdMay str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
nonBlockFlag truncateFlag nofollowFlag
creatFlag cloexecFlag directoryFlag
syncFlag) =
Fd <$> c_openat c_fd str all_flags mode_w
where
c_fd = maybe (-100) (\ (Fd fd) -> fd) fdMay
{-# LINE 224 "System/Posix/IO/Common.hsc" #-}
all_flags = creat .|. flags .|. open_mode
flags =
(if appendFlag then (1024) else 0) .|.
{-# LINE 228 "System/Posix/IO/Common.hsc" #-}
(if exclusiveFlag then (128) else 0) .|.
{-# LINE 229 "System/Posix/IO/Common.hsc" #-}
(if nocttyFlag then (256) else 0) .|.
{-# LINE 230 "System/Posix/IO/Common.hsc" #-}
(if nonBlockFlag then (2048) else 0) .|.
{-# LINE 231 "System/Posix/IO/Common.hsc" #-}
(if truncateFlag then (512) else 0) .|.
{-# LINE 232 "System/Posix/IO/Common.hsc" #-}
(if nofollowFlag then (131072) else 0) .|.
{-# LINE 233 "System/Posix/IO/Common.hsc" #-}
(if cloexecFlag then (524288) else 0) .|.
{-# LINE 234 "System/Posix/IO/Common.hsc" #-}
(if directoryFlag then (65536) else 0) .|.
{-# LINE 235 "System/Posix/IO/Common.hsc" #-}
(if syncFlag then (1052672) else 0)
{-# LINE 236 "System/Posix/IO/Common.hsc" #-}
(creat, mode_w) = case creatFlag of
Nothing -> (0,0)
Just x -> ((64), x)
{-# LINE 240 "System/Posix/IO/Common.hsc" #-}
open_mode = case how of
ReadOnly -> (0)
{-# LINE 243 "System/Posix/IO/Common.hsc" #-}
WriteOnly -> (1)
{-# LINE 244 "System/Posix/IO/Common.hsc" #-}
ReadWrite -> (2)
{-# LINE 245 "System/Posix/IO/Common.hsc" #-}
foreign import capi unsafe "HsUnix.h openat"
c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt
closeFd :: Fd -> IO ()
closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd)
foreign import ccall unsafe "HsUnix.h close"
c_close :: CInt -> IO CInt
handleToFd :: Handle -> IO Fd
fdToHandle :: Fd -> IO Handle
fdToHandle fd = FD.fdToHandle (fromIntegral fd)
handleToFd h@(FileHandle _ m) = do
withHandle' "handleToFd" h m $ handleToFd' h
handleToFd h@(DuplexHandle _ r w) = do
_ <- withHandle' "handleToFd" h r $ handleToFd' h
withHandle' "handleToFd" h w $ handleToFd' h
handleToFd' :: Handle -> Handle__ -> IO (Handle__, Fd)
handleToFd' h h_@Handle__{haType=_,..} = do
case cast haDevice of
Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation
"handleToFd" (Just h) Nothing)
"handle is not a file descriptor")
Just fd -> do
flushWriteBuffer h_
FD.release fd
return (Handle__{haType=ClosedHandle,..}, Fd (FD.fdFD fd))
data FdOption = AppendOnWrite
| CloseOnExec
| NonBlockingRead
| SynchronousWrites
fdOption2Int :: FdOption -> CInt
fdOption2Int CloseOnExec = (1)
{-# LINE 318 "System/Posix/IO/Common.hsc" #-}
fdOption2Int AppendOnWrite = (1024)
{-# LINE 319 "System/Posix/IO/Common.hsc" #-}
fdOption2Int NonBlockingRead = (2048)
{-# LINE 320 "System/Posix/IO/Common.hsc" #-}
fdOption2Int SynchronousWrites = (1052672)
{-# LINE 321 "System/Posix/IO/Common.hsc" #-}
queryFdOption :: Fd -> FdOption -> IO Bool
queryFdOption (Fd fd) opt = do
r <- throwErrnoIfMinus1 "queryFdOption" (Base.c_fcntl_read fd flag)
return ((r .&. fdOption2Int opt) /= 0)
where
flag = case opt of
CloseOnExec -> (1)
{-# LINE 330 "System/Posix/IO/Common.hsc" #-}
_ -> (3)
{-# LINE 331 "System/Posix/IO/Common.hsc" #-}
setFdOption :: Fd -> FdOption -> Bool -> IO ()
setFdOption (Fd fd) opt val = do
r <- throwErrnoIfMinus1 "setFdOption" (Base.c_fcntl_read fd getflag)
let r' | val = r .|. opt_val
| otherwise = r .&. (complement opt_val)
throwErrnoIfMinus1_ "setFdOption"
(Base.c_fcntl_write fd setflag (fromIntegral r'))
where
(getflag,setflag)= case opt of
CloseOnExec -> ((1),(2))
{-# LINE 343 "System/Posix/IO/Common.hsc" #-}
_ -> ((3),(4))
{-# LINE 344 "System/Posix/IO/Common.hsc" #-}
opt_val = fdOption2Int opt
mode2Int :: SeekMode -> CInt
mode2Int AbsoluteSeek = (0)
{-# LINE 351 "System/Posix/IO/Common.hsc" #-}
mode2Int RelativeSeek = (1)
{-# LINE 352 "System/Posix/IO/Common.hsc" #-}
mode2Int SeekFromEnd = (2)
{-# LINE 353 "System/Posix/IO/Common.hsc" #-}
fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
fdSeek (Fd fd) mode off =
throwErrnoIfMinus1 "fdSeek" (Base.c_lseek fd off (mode2Int mode))
data LockRequest = ReadLock
| WriteLock
| Unlock
type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
{-# LINE 386 "System/Posix/IO/Common.hsc" #-}
getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
getLock (Fd fd) lock =
allocaLock lock $ \p_flock -> do
throwErrnoIfMinus1_ "getLock" (Base.c_fcntl_lock fd (5) p_flock)
{-# LINE 392 "System/Posix/IO/Common.hsc" #-}
result <- bytes2ProcessIDAndLock p_flock
return (maybeResult result)
where
maybeResult (_, (Unlock, _, _, _)) = Nothing
maybeResult x = Just x
allocaLock :: FileLock -> (Ptr Base.CFLock -> IO a) -> IO a
allocaLock (lockreq, mode, start, len) io =
allocaBytes (32) $ \p -> do
{-# LINE 401 "System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (lockReq2Int lockreq :: CShort)
{-# LINE 402 "System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p (fromIntegral (mode2Int mode) :: CShort)
{-# LINE 403 "System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p start
{-# LINE 404 "System/Posix/IO/Common.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p len
{-# LINE 405 "System/Posix/IO/Common.hsc" #-}
io p
lockReq2Int :: LockRequest -> CShort
lockReq2Int ReadLock = (0)
{-# LINE 409 "System/Posix/IO/Common.hsc" #-}
lockReq2Int WriteLock = (1)
{-# LINE 410 "System/Posix/IO/Common.hsc" #-}
lockReq2Int Unlock = (2)
{-# LINE 411 "System/Posix/IO/Common.hsc" #-}
bytes2ProcessIDAndLock :: Ptr Base.CFLock -> IO (ProcessID, FileLock)
bytes2ProcessIDAndLock p = do
req <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 415 "System/Posix/IO/Common.hsc" #-}
mode <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) p
{-# LINE 416 "System/Posix/IO/Common.hsc" #-}
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 417 "System/Posix/IO/Common.hsc" #-}
len <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 418 "System/Posix/IO/Common.hsc" #-}
pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 419 "System/Posix/IO/Common.hsc" #-}
return (pid, (int2req req, int2mode mode, start, len))
where
int2req :: CShort -> LockRequest
int2req (0) = ReadLock
{-# LINE 423 "System/Posix/IO/Common.hsc" #-}
int2req (1) = WriteLock
{-# LINE 424 "System/Posix/IO/Common.hsc" #-}
int2req (2) = Unlock
{-# LINE 425 "System/Posix/IO/Common.hsc" #-}
int2req _ = error $ "int2req: bad argument"
int2mode :: CShort -> SeekMode
int2mode (0) = AbsoluteSeek
{-# LINE 429 "System/Posix/IO/Common.hsc" #-}
int2mode (1) = RelativeSeek
{-# LINE 430 "System/Posix/IO/Common.hsc" #-}
int2mode (2) = SeekFromEnd
{-# LINE 431 "System/Posix/IO/Common.hsc" #-}
int2mode _ = error $ "int2mode: bad argument"
setLock :: Fd -> FileLock -> IO ()
setLock (Fd fd) lock = do
allocaLock lock $ \p_flock ->
throwErrnoIfMinus1_ "setLock" (Base.c_fcntl_lock fd (6) p_flock)
{-# LINE 438 "System/Posix/IO/Common.hsc" #-}
waitToSetLock :: Fd -> FileLock -> IO ()
waitToSetLock (Fd fd) lock = do
allocaLock lock $ \p_flock ->
throwErrnoIfMinus1_ "waitToSetLock"
(Base.c_fcntl_lock fd (7) p_flock)
{-# LINE 445 "System/Posix/IO/Common.hsc" #-}
{-# LINE 447 "System/Posix/IO/Common.hsc" #-}
fdReadBuf :: Fd
-> Ptr Word8
-> ByteCount
-> IO ByteCount
fdReadBuf _fd _buf 0 = return 0
fdReadBuf fd buf nbytes =
fmap fromIntegral $
throwErrnoIfMinus1Retry "fdReadBuf" $
c_safe_read (fromIntegral fd) (castPtr buf) nbytes
foreign import ccall safe "read"
c_safe_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
fdWriteBuf :: Fd
-> Ptr Word8
-> ByteCount
-> IO ByteCount
fdWriteBuf fd buf len =
fmap fromIntegral $
throwErrnoIfMinus1Retry "fdWriteBuf" $
c_safe_write (fromIntegral fd) (castPtr buf) len
foreign import ccall safe "write"
c_safe_write :: CInt -> Ptr CChar -> CSize -> IO CSsize