{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK not-home #-}
module System.Posix.Internals where
#include "HsBaseConfig.h"
import System.Posix.Types
import Foreign
import Foreign.C
import Data.Maybe
#if !defined(HTYPE_TCFLAG_T)
import System.IO.Error
#endif
import GHC.Base
import GHC.Num
import GHC.Real
import GHC.IO
import GHC.IO.IOMode
import GHC.IO.Exception
import GHC.IO.Device
#if !defined(mingw32_HOST_OS)
import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding)
import qualified GHC.Foreign as GHC
#endif
puts :: String -> IO ()
puts :: String -> IO ()
puts String
s = String -> (CStringLen -> IO ()) -> IO ()
forall a. String -> (CStringLen -> IO a) -> IO a
withCAStringLen (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
len) -> do
CSsize
_ <- CInt -> Ptr Word8 -> CSize -> IO CSsize
c_write CInt
1 (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
data {-# CTYPE "struct flock" #-} CFLock
data {-# CTYPE "struct group" #-} CGroup
data {-# CTYPE "struct lconv" #-} CLconv
data {-# CTYPE "struct passwd" #-} CPasswd
data {-# CTYPE "struct sigaction" #-} CSigaction
data {-# CTYPE "sigset_t" #-} CSigset
data {-# CTYPE "struct stat" #-} CStat
data {-# CTYPE "struct termios" #-} CTermios
data {-# CTYPE "struct tm" #-} CTm
data {-# CTYPE "struct tms" #-} CTms
data {-# CTYPE "struct utimbuf" #-} CUtimbuf
data {-# CTYPE "struct utsname" #-} CUtsname
type FD = CInt
fdFileSize :: FD -> IO Integer
fdFileSize :: CInt -> IO Integer
fdFileSize CInt
fd =
Int -> (Ptr CStat -> IO Integer) -> IO Integer
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeof_stat ((Ptr CStat -> IO Integer) -> IO Integer)
-> (Ptr CStat -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \ Ptr CStat
p_stat -> do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"fileSize" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr CStat -> IO CInt
c_fstat CInt
fd Ptr CStat
p_stat
CMode
c_mode <- Ptr CStat -> IO CMode
st_mode Ptr CStat
p_stat :: IO CMode
if Bool -> Bool
not (CMode -> Bool
s_isreg CMode
c_mode)
then Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1)
else do
COff
c_size <- Ptr CStat -> IO COff
st_size Ptr CStat
p_stat
Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (COff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral COff
c_size)
fileType :: FilePath -> IO IODeviceType
fileType :: String -> IO IODeviceType
fileType String
file =
Int -> (Ptr CStat -> IO IODeviceType) -> IO IODeviceType
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeof_stat ((Ptr CStat -> IO IODeviceType) -> IO IODeviceType)
-> (Ptr CStat -> IO IODeviceType) -> IO IODeviceType
forall a b. (a -> b) -> a -> b
$ \ Ptr CStat
p_stat ->
String -> (Ptr CChar -> IO IODeviceType) -> IO IODeviceType
forall a. String -> (Ptr CChar -> IO a) -> IO a
withFilePath String
file ((Ptr CChar -> IO IODeviceType) -> IO IODeviceType)
-> (Ptr CChar -> IO IODeviceType) -> IO IODeviceType
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
p_file -> do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"fileType" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr CChar -> Ptr CStat -> IO CInt
c_stat Ptr CChar
p_file Ptr CStat
p_stat
Ptr CStat -> IO IODeviceType
statGetType Ptr CStat
p_stat
fdStat :: FD -> IO (IODeviceType, CDev, CIno)
fdStat :: CInt -> IO (IODeviceType, CDev, CIno)
fdStat CInt
fd =
Int
-> (Ptr CStat -> IO (IODeviceType, CDev, CIno))
-> IO (IODeviceType, CDev, CIno)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeof_stat ((Ptr CStat -> IO (IODeviceType, CDev, CIno))
-> IO (IODeviceType, CDev, CIno))
-> (Ptr CStat -> IO (IODeviceType, CDev, CIno))
-> IO (IODeviceType, CDev, CIno)
forall a b. (a -> b) -> a -> b
$ \ Ptr CStat
p_stat -> do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"fdType" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr CStat -> IO CInt
c_fstat CInt
fd Ptr CStat
p_stat
IODeviceType
ty <- Ptr CStat -> IO IODeviceType
statGetType Ptr CStat
p_stat
CDev
dev <- Ptr CStat -> IO CDev
st_dev Ptr CStat
p_stat
CIno
ino <- Ptr CStat -> IO CIno
st_ino Ptr CStat
p_stat
(IODeviceType, CDev, CIno) -> IO (IODeviceType, CDev, CIno)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IODeviceType
ty,CDev
dev,CIno
ino)
fdType :: FD -> IO IODeviceType
fdType :: CInt -> IO IODeviceType
fdType CInt
fd = do (IODeviceType
ty,CDev
_,CIno
_) <- CInt -> IO (IODeviceType, CDev, CIno)
fdStat CInt
fd; IODeviceType -> IO IODeviceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
ty
statGetType :: Ptr CStat -> IO IODeviceType
statGetType :: Ptr CStat -> IO IODeviceType
statGetType Ptr CStat
p_stat = do
CMode
c_mode <- Ptr CStat -> IO CMode
st_mode Ptr CStat
p_stat :: IO CMode
case () of
()
_ | CMode -> Bool
s_isdir CMode
c_mode -> IODeviceType -> IO IODeviceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
Directory
| CMode -> Bool
s_isfifo CMode
c_mode Bool -> Bool -> Bool
|| CMode -> Bool
s_issock CMode
c_mode Bool -> Bool -> Bool
|| CMode -> Bool
s_ischr CMode
c_mode
-> IODeviceType -> IO IODeviceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
Stream
| CMode -> Bool
s_isreg CMode
c_mode -> IODeviceType -> IO IODeviceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
RegularFile
| CMode -> Bool
s_isblk CMode
c_mode -> IODeviceType -> IO IODeviceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
RawDevice
| Bool
otherwise -> IOError -> IO IODeviceType
forall a. IOError -> IO a
ioError IOError
ioe_unknownfiletype
ioe_unknownfiletype :: IOException
ioe_unknownfiletype :: IOError
ioe_unknownfiletype = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
UnsupportedOperation String
"fdType"
String
"unknown file type"
Maybe CInt
forall a. Maybe a
Nothing
Maybe String
forall a. Maybe a
Nothing
fdGetMode :: FD -> IO IOMode
#if defined(mingw32_HOST_OS)
fdGetMode _ = do
let flags = o_RDWR
#else
fdGetMode :: CInt -> IO IOMode
fdGetMode CInt
fd = do
CInt
flags <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"fdGetMode"
(CInt -> CInt -> IO CInt
c_fcntl_read CInt
fd CInt
const_f_getfl)
#endif
let
wH :: Bool
wH = (CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
o_WRONLY) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
aH :: Bool
aH = (CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
o_APPEND) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
rwH :: Bool
rwH = (CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
o_RDWR) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
mode :: IOMode
mode
| Bool
wH Bool -> Bool -> Bool
&& Bool
aH = IOMode
AppendMode
| Bool
wH = IOMode
WriteMode
| Bool
rwH = IOMode
ReadWriteMode
| Bool
otherwise = IOMode
ReadMode
IOMode -> IO IOMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IOMode
mode
#if defined(mingw32_HOST_OS)
withFilePath :: FilePath -> (CWString -> IO a) -> IO a
withFilePath = withCWString
newFilePath :: FilePath -> IO CWString
newFilePath = newCWString
peekFilePath :: CWString -> IO FilePath
peekFilePath = peekCWString
#else
withFilePath :: FilePath -> (CString -> IO a) -> IO a
newFilePath :: FilePath -> IO CString
peekFilePath :: CString -> IO FilePath
peekFilePathLen :: CStringLen -> IO FilePath
withFilePath :: forall a. String -> (Ptr CChar -> IO a) -> IO a
withFilePath String
fp Ptr CChar -> IO a
f = IO TextEncoding
getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> String -> (Ptr CChar -> IO a) -> IO a
forall a. TextEncoding -> String -> (Ptr CChar -> IO a) -> IO a
GHC.withCString TextEncoding
enc String
fp Ptr CChar -> IO a
f
newFilePath :: String -> IO (Ptr CChar)
newFilePath String
fp = IO TextEncoding
getFileSystemEncoding IO TextEncoding
-> (TextEncoding -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> String -> IO (Ptr CChar)
GHC.newCString TextEncoding
enc String
fp
peekFilePath :: Ptr CChar -> IO String
peekFilePath Ptr CChar
fp = IO TextEncoding
getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> Ptr CChar -> IO String
GHC.peekCString TextEncoding
enc Ptr CChar
fp
peekFilePathLen :: CStringLen -> IO String
peekFilePathLen CStringLen
fp = IO TextEncoding
getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> CStringLen -> IO String
GHC.peekCStringLen TextEncoding
enc CStringLen
fp
#endif
#if defined(HTYPE_TCFLAG_T)
setEcho :: FD -> Bool -> IO ()
setEcho :: CInt -> Bool -> IO ()
setEcho CInt
fd Bool
on =
CInt -> (Ptr CTermios -> IO ()) -> IO ()
forall a. CInt -> (Ptr CTermios -> IO a) -> IO a
tcSetAttr CInt
fd ((Ptr CTermios -> IO ()) -> IO ())
-> (Ptr CTermios -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CTermios
p_tios -> do
CTcflag
lflag <- Ptr CTermios -> IO CTcflag
c_lflag Ptr CTermios
p_tios :: IO CTcflag
let new_lflag :: CTcflag
new_lflag
| Bool
on = CTcflag
lflag CTcflag -> CTcflag -> CTcflag
forall a. Bits a => a -> a -> a
.|. CInt -> CTcflag
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_echo
| Bool
otherwise = CTcflag
lflag CTcflag -> CTcflag -> CTcflag
forall a. Bits a => a -> a -> a
.&. CTcflag -> CTcflag
forall a. Bits a => a -> a
complement (CInt -> CTcflag
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_echo)
Ptr CTermios -> CTcflag -> IO ()
poke_c_lflag Ptr CTermios
p_tios (CTcflag
new_lflag :: CTcflag)
getEcho :: FD -> IO Bool
getEcho :: CInt -> IO Bool
getEcho CInt
fd =
CInt -> (Ptr CTermios -> IO Bool) -> IO Bool
forall a. CInt -> (Ptr CTermios -> IO a) -> IO a
tcSetAttr CInt
fd ((Ptr CTermios -> IO Bool) -> IO Bool)
-> (Ptr CTermios -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr CTermios
p_tios -> do
CTcflag
lflag <- Ptr CTermios -> IO CTcflag
c_lflag Ptr CTermios
p_tios :: IO CTcflag
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CTcflag
lflag CTcflag -> CTcflag -> CTcflag
forall a. Bits a => a -> a -> a
.&. CInt -> CTcflag
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_echo) CTcflag -> CTcflag -> Bool
forall a. Eq a => a -> a -> Bool
/= CTcflag
0)
setCooked :: FD -> Bool -> IO ()
setCooked :: CInt -> Bool -> IO ()
setCooked CInt
fd Bool
cooked =
CInt -> (Ptr CTermios -> IO ()) -> IO ()
forall a. CInt -> (Ptr CTermios -> IO a) -> IO a
tcSetAttr CInt
fd ((Ptr CTermios -> IO ()) -> IO ())
-> (Ptr CTermios -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CTermios
p_tios -> do
CTcflag
lflag <- Ptr CTermios -> IO CTcflag
c_lflag Ptr CTermios
p_tios :: IO CTcflag
let new_lflag :: CTcflag
new_lflag | Bool
cooked = CTcflag
lflag CTcflag -> CTcflag -> CTcflag
forall a. Bits a => a -> a -> a
.|. (CInt -> CTcflag
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_icanon)
| Bool
otherwise = CTcflag
lflag CTcflag -> CTcflag -> CTcflag
forall a. Bits a => a -> a -> a
.&. CTcflag -> CTcflag
forall a. Bits a => a -> a
complement (CInt -> CTcflag
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_icanon)
Ptr CTermios -> CTcflag -> IO ()
poke_c_lflag Ptr CTermios
p_tios (CTcflag
new_lflag :: CTcflag)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
cooked) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Ptr Word8
c_cc <- Ptr CTermios -> IO (Ptr Word8)
ptr_c_cc Ptr CTermios
p_tios
let vmin :: Ptr Word8
vmin = (Ptr Word8
c_cc Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_vmin)) :: Ptr Word8
vtime :: Ptr Word8
vtime = (Ptr Word8
c_cc Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
const_vtime)) :: Ptr Word8
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
vmin Word8
1
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
vtime Word8
0
tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a
tcSetAttr :: forall a. CInt -> (Ptr CTermios -> IO a) -> IO a
tcSetAttr CInt
fd Ptr CTermios -> IO a
fun =
Int -> (Ptr CTermios -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeof_termios ((Ptr CTermios -> IO a) -> IO a) -> (Ptr CTermios -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CTermios
p_tios -> do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"tcSetAttr"
(CInt -> Ptr CTermios -> IO CInt
c_tcgetattr CInt
fd Ptr CTermios
p_tios)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
fd CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
<= CInt
2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Ptr CTermios
p <- CInt -> IO (Ptr CTermios)
get_saved_termios CInt
fd
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CTermios
p Ptr CTermios -> Ptr CTermios -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CTermios
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Ptr CTermios
saved_tios <- Int -> IO (Ptr CTermios)
forall a. Int -> IO (Ptr a)
mallocBytes Int
sizeof_termios
Ptr CTermios -> Ptr CTermios -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CTermios
saved_tios Ptr CTermios
p_tios Int
sizeof_termios
CInt -> Ptr CTermios -> IO ()
set_saved_termios CInt
fd Ptr CTermios
saved_tios
Int -> (Ptr CSigset -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeof_sigset_t ((Ptr CSigset -> IO a) -> IO a) -> (Ptr CSigset -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CSigset
p_sigset ->
Int -> (Ptr CSigset -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sizeof_sigset_t ((Ptr CSigset -> IO a) -> IO a) -> (Ptr CSigset -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CSigset
p_old_sigset -> do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"sigemptyset" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr CSigset -> IO CInt
c_sigemptyset Ptr CSigset
p_sigset
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"sigaddset" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr CSigset -> CInt -> IO CInt
c_sigaddset Ptr CSigset
p_sigset CInt
const_sigttou
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"sigprocmask" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
c_sigprocmask CInt
const_sig_block Ptr CSigset
p_sigset Ptr CSigset
p_old_sigset
a
r <- Ptr CTermios -> IO a
fun Ptr CTermios
p_tios
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"tcSetAttr" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> Ptr CTermios -> IO CInt
c_tcsetattr CInt
fd CInt
const_tcsanow Ptr CTermios
p_tios
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"sigprocmask" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
c_sigprocmask CInt
const_sig_setmask Ptr CSigset
p_old_sigset Ptr CSigset
forall a. Ptr a
nullPtr
a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios"
get_saved_termios :: CInt -> IO (Ptr CTermios)
foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()
#else
setCooked :: FD -> Bool -> IO ()
setCooked fd cooked = do
x <- set_console_buffering fd (if cooked then 1 else 0)
if (x /= 0)
then ioError (ioe_unk_error "setCooked" "failed to set buffering")
else return ()
ioe_unk_error :: String -> String -> IOException
ioe_unk_error loc msg
= ioeSetErrorString (mkIOError OtherError loc Nothing Nothing) msg
setEcho :: FD -> Bool -> IO ()
setEcho fd on = do
x <- set_console_echo fd (if on then 1 else 0)
if (x /= 0)
then ioError (ioe_unk_error "setEcho" "failed to set echoing")
else return ()
getEcho :: FD -> IO Bool
getEcho fd = do
r <- get_console_echo fd
if (r == (-1))
then ioError (ioe_unk_error "getEcho" "failed to get echoing")
else return (r == 1)
foreign import ccall unsafe "consUtils.h set_console_buffering__"
set_console_buffering :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "consUtils.h set_console_echo__"
set_console_echo :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "consUtils.h get_console_echo__"
get_console_echo :: CInt -> IO CInt
foreign import ccall unsafe "consUtils.h is_console__"
is_console :: CInt -> IO CInt
#endif
setNonBlockingFD :: FD -> Bool -> IO ()
#if !defined(mingw32_HOST_OS)
setNonBlockingFD :: CInt -> Bool -> IO ()
setNonBlockingFD CInt
fd Bool
set = do
CInt
flags <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"setNonBlockingFD"
(CInt -> CInt -> IO CInt
c_fcntl_read CInt
fd CInt
const_f_getfl)
let flags' :: CInt
flags' | Bool
set = CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
o_NONBLOCK
| Bool
otherwise = CInt
flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt -> CInt
forall a. Bits a => a -> a
complement CInt
o_NONBLOCK
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
flags CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
flags') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CInt
_ <- CInt -> CInt -> CLong -> IO CInt
c_fcntl_write CInt
fd CInt
const_f_setfl (CInt -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
flags')
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
setNonBlockingFD _ _ = return ()
#endif
#if !defined(mingw32_HOST_OS)
setCloseOnExec :: FD -> IO ()
setCloseOnExec :: CInt -> IO ()
setCloseOnExec CInt
fd =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setCloseOnExec" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> CLong -> IO CInt
c_fcntl_write CInt
fd CInt
const_f_setfd CLong
const_fd_cloexec
#endif
#if !defined(mingw32_HOST_OS)
type CFilePath = CString
#else
type CFilePath = CWString
#endif
foreign import ccall unsafe "HsBase.h __hscore_open"
c_open :: CFilePath -> CInt -> CMode -> IO CInt
c_interruptible_open :: CFilePath -> CInt -> CMode -> IO CInt
c_interruptible_open :: Ptr CChar -> CInt -> CMode -> IO CInt
c_interruptible_open Ptr CChar
filepath CInt
oflags CMode
mode =
IO MaskingState
getMaskingState IO MaskingState -> (MaskingState -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaskingState
MaskedUninterruptible -> Ptr CChar -> CInt -> CMode -> IO CInt
c_safe_open_ Ptr CChar
filepath CInt
oflags CMode
mode
MaskingState
_ -> do
CInt
open_res <- Ptr CChar -> CInt -> CMode -> IO CInt
c_interruptible_open_ Ptr CChar
filepath CInt
oflags CMode
mode
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
open_res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
if Bool
hostIsThreaded
then
IO () -> IO ()
forall a. IO a -> IO a
interruptible (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
else
IO () -> IO ()
forall a. IO a -> IO a
interruptible ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> (# State# RealWorld -> State# RealWorld
yield# State# RealWorld
s, () #))
CInt -> IO CInt
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
open_res
foreign import ccall interruptible "HsBase.h __hscore_open"
c_interruptible_open_ :: CFilePath -> CInt -> CMode -> IO CInt
hostIsThreaded :: Bool
hostIsThreaded :: Bool
hostIsThreaded = Int
rtsIsThreaded_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
foreign import ccall unsafe "rts_isThreaded" rtsIsThreaded_ :: Int
c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt
c_safe_open :: Ptr CChar -> CInt -> CMode -> IO CInt
c_safe_open Ptr CChar
filepath CInt
oflags CMode
mode =
IO MaskingState
getMaskingState IO MaskingState -> (MaskingState -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaskingState
Unmasked -> Ptr CChar -> CInt -> CMode -> IO CInt
c_interruptible_open_ Ptr CChar
filepath CInt
oflags CMode
mode
MaskingState
_ -> Ptr CChar -> CInt -> CMode -> IO CInt
c_safe_open_ Ptr CChar
filepath CInt
oflags CMode
mode
foreign import ccall safe "HsBase.h __hscore_open"
c_safe_open_ :: CFilePath -> CInt -> CMode -> IO CInt
foreign import ccall unsafe "HsBase.h __hscore_fstat"
c_fstat :: CInt -> Ptr CStat -> IO CInt
foreign import ccall unsafe "HsBase.h __hscore_lstat"
lstat :: CFilePath -> Ptr CStat -> IO CInt
foreign import capi unsafe "unistd.h lseek"
c_lseek :: CInt -> COff -> CInt -> IO COff
foreign import ccall unsafe "HsBase.h access"
c_access :: CString -> CInt -> IO CInt
foreign import ccall unsafe "HsBase.h chmod"
c_chmod :: CString -> CMode -> IO CInt
foreign import ccall unsafe "HsBase.h close"
c_close :: CInt -> IO CInt
foreign import ccall unsafe "HsBase.h creat"
c_creat :: CString -> CMode -> IO CInt
foreign import ccall unsafe "HsBase.h dup"
c_dup :: CInt -> IO CInt
foreign import ccall unsafe "HsBase.h dup2"
c_dup2 :: CInt -> CInt -> IO CInt
foreign import ccall unsafe "HsBase.h isatty"
c_isatty :: CInt -> IO CInt
#if defined(mingw32_HOST_OS)
foreign import capi unsafe "HsBase.h _read"
c_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt
foreign import capi safe "HsBase.h _read"
c_safe_read :: CInt -> Ptr Word8 -> CUInt -> IO CInt
foreign import ccall unsafe "HsBase.h _umask"
c_umask :: CMode -> IO CMode
foreign import capi unsafe "HsBase.h _write"
c_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt
foreign import capi safe "HsBase.h _write"
c_safe_write :: CInt -> Ptr Word8 -> CUInt -> IO CInt
foreign import ccall unsafe "HsBase.h _pipe"
c_pipe :: Ptr CInt -> IO CInt
#else
foreign import capi unsafe "HsBase.h read"
c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
foreign import capi safe "HsBase.h read"
c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
foreign import ccall unsafe "HsBase.h umask"
c_umask :: CMode -> IO CMode
foreign import capi unsafe "HsBase.h write"
c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
foreign import capi safe "HsBase.h write"
c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
foreign import ccall unsafe "HsBase.h pipe"
c_pipe :: Ptr CInt -> IO CInt
#endif
foreign import ccall unsafe "HsBase.h unlink"
c_unlink :: CString -> IO CInt
foreign import capi unsafe "HsBase.h utime"
c_utime :: CString -> Ptr CUtimbuf -> IO CInt
foreign import ccall unsafe "HsBase.h getpid"
c_getpid :: IO CPid
foreign import ccall unsafe "HsBase.h __hscore_stat"
c_stat :: CFilePath -> Ptr CStat -> IO CInt
foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
c_ftruncate :: CInt -> COff -> IO CInt
#if !defined(mingw32_HOST_OS)
foreign import capi unsafe "HsBase.h fcntl"
c_fcntl_read :: CInt -> CInt -> IO CInt
foreign import capi unsafe "HsBase.h fcntl"
c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt
foreign import capi unsafe "HsBase.h fcntl"
c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt
foreign import ccall unsafe "HsBase.h fork"
c_fork :: IO CPid
foreign import ccall unsafe "HsBase.h link"
c_link :: CString -> CString -> IO CInt
foreign import capi unsafe "HsBase.h mkfifo"
c_mkfifo :: CString -> CMode -> IO CInt
foreign import capi unsafe "signal.h sigemptyset"
c_sigemptyset :: Ptr CSigset -> IO CInt
foreign import capi unsafe "signal.h sigaddset"
c_sigaddset :: Ptr CSigset -> CInt -> IO CInt
foreign import capi unsafe "signal.h sigprocmask"
c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
foreign import capi unsafe "HsBase.h tcgetattr"
c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
foreign import capi unsafe "HsBase.h tcsetattr"
c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
foreign import ccall unsafe "HsBase.h waitpid"
c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
#endif
foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_rdwr" o_RDWR :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_append" o_APPEND :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_creat" o_CREAT :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_excl" o_EXCL :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_trunc" o_TRUNC :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_noctty" o_NOCTTY :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_nonblock" o_NONBLOCK :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_binary" o_BINARY :: CInt
foreign import capi unsafe "sys/stat.h S_ISREG" c_s_isreg :: CMode -> CInt
foreign import capi unsafe "sys/stat.h S_ISCHR" c_s_ischr :: CMode -> CInt
foreign import capi unsafe "sys/stat.h S_ISBLK" c_s_isblk :: CMode -> CInt
foreign import capi unsafe "sys/stat.h S_ISDIR" c_s_isdir :: CMode -> CInt
foreign import capi unsafe "sys/stat.h S_ISFIFO" c_s_isfifo :: CMode -> CInt
s_isreg :: CMode -> Bool
s_isreg :: CMode -> Bool
s_isreg CMode
cm = CMode -> CInt
c_s_isreg CMode
cm CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
s_ischr :: CMode -> Bool
s_ischr :: CMode -> Bool
s_ischr CMode
cm = CMode -> CInt
c_s_ischr CMode
cm CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
s_isblk :: CMode -> Bool
s_isblk :: CMode -> Bool
s_isblk CMode
cm = CMode -> CInt
c_s_isblk CMode
cm CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
s_isdir :: CMode -> Bool
s_isdir :: CMode -> Bool
s_isdir CMode
cm = CMode -> CInt
c_s_isdir CMode
cm CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
s_isfifo :: CMode -> Bool
s_isfifo :: CMode -> Bool
s_isfifo CMode
cm = CMode -> CInt
c_s_isfifo CMode
cm CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
foreign import ccall unsafe "HsBase.h __hscore_sizeof_stat" sizeof_stat :: Int
foreign import ccall unsafe "HsBase.h __hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime
#if defined(mingw32_HOST_OS)
foreign import ccall unsafe "HsBase.h __hscore_st_size" st_size :: Ptr CStat -> IO Int64
#else
foreign import ccall unsafe "HsBase.h __hscore_st_size" st_size :: Ptr CStat -> IO COff
#endif
foreign import ccall unsafe "HsBase.h __hscore_st_mode" st_mode :: Ptr CStat -> IO CMode
foreign import ccall unsafe "HsBase.h __hscore_st_dev" st_dev :: Ptr CStat -> IO CDev
foreign import ccall unsafe "HsBase.h __hscore_st_ino" st_ino :: Ptr CStat -> IO CIno
foreign import ccall unsafe "HsBase.h __hscore_echo" const_echo :: CInt
foreign import ccall unsafe "HsBase.h __hscore_tcsanow" const_tcsanow :: CInt
foreign import ccall unsafe "HsBase.h __hscore_icanon" const_icanon :: CInt
foreign import ccall unsafe "HsBase.h __hscore_vmin" const_vmin :: CInt
foreign import ccall unsafe "HsBase.h __hscore_vtime" const_vtime :: CInt
foreign import ccall unsafe "HsBase.h __hscore_sigttou" const_sigttou :: CInt
foreign import ccall unsafe "HsBase.h __hscore_sig_block" const_sig_block :: CInt
foreign import ccall unsafe "HsBase.h __hscore_sig_setmask" const_sig_setmask :: CInt
foreign import ccall unsafe "HsBase.h __hscore_f_getfl" const_f_getfl :: CInt
foreign import ccall unsafe "HsBase.h __hscore_f_setfl" const_f_setfl :: CInt
foreign import ccall unsafe "HsBase.h __hscore_f_setfd" const_f_setfd :: CInt
foreign import ccall unsafe "HsBase.h __hscore_fd_cloexec" const_fd_cloexec :: CLong
#if defined(HTYPE_TCFLAG_T)
foreign import ccall unsafe "HsBase.h __hscore_sizeof_termios" sizeof_termios :: Int
foreign import ccall unsafe "HsBase.h __hscore_sizeof_sigset_t" sizeof_sigset_t :: Int
foreign import ccall unsafe "HsBase.h __hscore_lflag" c_lflag :: Ptr CTermios -> IO CTcflag
foreign import ccall unsafe "HsBase.h __hscore_poke_lflag" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO ()
foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8)
#endif
s_issock :: CMode -> Bool
#if !defined(mingw32_HOST_OS)
s_issock :: CMode -> Bool
s_issock CMode
cmode = CMode -> CInt
c_s_issock CMode
cmode CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
foreign import capi unsafe "sys/stat.h S_ISSOCK" c_s_issock :: CMode -> CInt
#else
s_issock _ = False
#endif
foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
foreign import capi unsafe "stdio.h value SEEK_CUR" sEEK_CUR :: CInt
foreign import capi unsafe "stdio.h value SEEK_SET" sEEK_SET :: CInt
foreign import capi unsafe "stdio.h value SEEK_END" sEEK_END :: CInt