1 {-# OPTIONS -fno-implicit-prelude #-}
3 -- ---------------------------------------------------------------------------
4 -- $Id: Posix.hsc,v 1.3 2001/08/17 12:50:34 simonmar Exp $
6 -- POSIX support layer for the standard libraries
8 -- Non-posix compliant in order to support the following features:
9 -- * S_ISSOCK (no sockets in POSIX)
11 module GHC.Posix where
13 -- See above comment for non-Posixness reasons.
14 -- #include "PosixSource.h"
31 -- ---------------------------------------------------------------------------
49 type CDev = #type dev_t
50 type CIno = #type ino_t
51 type CMode = #type mode_t
52 type COff = #type off_t
53 type CPid = #type pid_t
55 #ifdef mingw32_TARGET_OS
56 type CSsize = #type size_t
58 type CGid = #type gid_t
59 type CNlink = #type nlink_t
60 type CSsize = #type ssize_t
61 type CUid = #type uid_t
63 type CSpeed = #type speed_t
64 type CTcflag = #type tcflag_t
67 -- ---------------------------------------------------------------------------
68 -- stat()-related stuff
70 fdFileSize :: Int -> IO Integer
72 allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
73 throwErrnoIfMinus1Retry "fdFileSize" $
74 c_fstat (fromIntegral fd) p_stat
75 c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode
76 if not (s_isreg c_mode)
79 c_size <- (#peek struct stat, st_size) p_stat :: IO COff
80 return (fromIntegral c_size)
82 data FDType = Directory | Stream | RegularFile
85 fileType :: FilePath -> IO FDType
87 allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
88 withCString file $ \p_file -> do
89 throwErrnoIfMinus1Retry "fileType" $
93 fdType :: Int -> IO FDType
95 allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
96 throwErrnoIfMinus1Retry "fdType" $
97 c_fstat (fromIntegral fd) p_stat
100 statGetType p_stat = do
101 c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode
103 _ | s_isdir c_mode -> return Directory
104 | s_isfifo c_mode || s_issock c_mode -> return Stream
105 | s_isreg c_mode -> return RegularFile
106 | otherwise -> ioException ioe_unknownfiletype
109 ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
110 "unknown file type" Nothing
112 -- It isn't clear whether ftruncate is POSIX or not (I've read several
113 -- manpages and they seem to conflict), so we truncate using open/2.
114 fileTruncate :: FilePath -> IO ()
115 fileTruncate file = do
116 let flags = o_WRONLY .|. o_TRUNC
117 withCString file $ \file_cstr -> do
118 fd <- fromIntegral `liftM`
119 throwErrnoIfMinus1Retry "fileTruncate"
120 (c_open file_cstr (fromIntegral flags) 0o666)
124 -- ---------------------------------------------------------------------------
125 -- Terminal-related stuff
127 fdIsTTY :: Int -> IO Bool
128 fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
130 #ifndef mingw32_TARGET_OS
132 setEcho :: Int -> Bool -> IO ()
134 allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
135 throwErrnoIfMinus1Retry "setEcho"
136 (c_tcgetattr (fromIntegral fd) p_tios)
137 c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
138 let new_c_lflag | on = c_lflag .|. (#const ECHO)
139 | otherwise = c_lflag .&. complement (#const ECHO)
140 (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
141 tcSetAttr fd (#const TCSANOW) p_tios
143 getEcho :: Int -> IO Bool
145 allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
146 throwErrnoIfMinus1Retry "setEcho"
147 (c_tcgetattr (fromIntegral fd) p_tios)
148 c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
149 return ((c_lflag .&. (#const ECHO)) /= 0)
151 setCooked :: Int -> Bool -> IO ()
152 setCooked fd cooked =
153 allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
154 throwErrnoIfMinus1Retry "setCooked"
155 (c_tcgetattr (fromIntegral fd) p_tios)
157 -- turn on/off ICANON
158 c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
159 let new_c_lflag | cooked = c_lflag .|. (#const ICANON)
160 | otherwise = c_lflag .&. complement (#const ICANON)
161 (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
163 -- set VMIN & VTIME to 1/0 respectively
165 let c_cc = (#ptr struct termios, c_cc) p_tios
166 vmin = c_cc `plusPtr` (#const VMIN) :: Ptr Word8
167 vtime = c_cc `plusPtr` (#const VTIME) :: Ptr Word8
171 tcSetAttr fd (#const TCSANOW) p_tios
173 -- tcsetattr() when invoked by a background process causes the process
174 -- to be sent SIGTTOU regardless of whether the process has TOSTOP set
175 -- in its terminal flags (try it...). This function provides a
176 -- wrapper which temporarily blocks SIGTTOU around the call, making it
179 tcSetAttr :: FD -> CInt -> Ptr CTermios -> IO ()
180 tcSetAttr fd options p_tios = do
181 allocaBytes (#const sizeof(sigset_t)) $ \ p_sigset -> do
182 allocaBytes (#const sizeof(sigset_t)) $ \ p_old_sigset -> do
183 c_sigemptyset p_sigset
184 c_sigaddset p_sigset (#const SIGTTOU)
185 c_sigprocmask (#const SIG_BLOCK) p_sigset p_old_sigset
186 throwErrnoIfMinus1Retry_ "tcSetAttr" $
187 c_tcsetattr (fromIntegral fd) options p_tios
188 c_sigprocmask (#const SIG_SETMASK) p_old_sigset nullPtr
192 -- bogus defns for win32
193 setCooked :: Int -> Bool -> IO ()
194 setCooked fd cooked = return ()
196 setEcho :: Int -> Bool -> IO ()
197 setEcho fd on = return ()
199 getEcho :: Int -> IO Bool
200 getEcho fd = return False
204 -- ---------------------------------------------------------------------------
205 -- Turning on non-blocking for a file descriptor
207 #ifndef mingw32_TARGET_OS
209 setNonBlockingFD fd = do
210 flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
211 (c_fcntl_read (fromIntegral fd) (#const F_GETFL))
212 throwErrnoIfMinus1Retry "setNonBlockingFD"
213 (c_fcntl_write (fromIntegral fd)
214 (#const F_SETFL) (flags .|. #const O_NONBLOCK))
217 -- bogus defns for win32
218 setNonBlockingFD fd = return ()
222 -- -----------------------------------------------------------------------------
226 o_RDONLY = (#const O_RDONLY) :: CInt
227 o_WRONLY = (#const O_WRONLY) :: CInt
228 o_RDWR = (#const O_RDWR) :: CInt
229 o_APPEND = (#const O_APPEND) :: CInt
230 o_CREAT = (#const O_CREAT) :: CInt
231 o_EXCL = (#const O_EXCL) :: CInt
232 o_TRUNC = (#const O_TRUNC) :: CInt
234 #ifdef mingw32_TARGET_OS
236 o_NONBLOCK = 0 :: CInt
238 o_NOCTTY = (#const O_NOCTTY) :: CInt
239 o_NONBLOCK = (#const O_NONBLOCK) :: CInt
243 o_BINARY = (#const O_BINARY) :: CInt
246 foreign import ccall "access" unsafe
247 c_access :: CString -> CMode -> IO CInt
249 foreign import ccall "chmod" unsafe
250 c_chmod :: CString -> CMode -> IO CInt
252 foreign import ccall "chdir" unsafe
253 c_chdir :: CString -> IO CInt
255 foreign import ccall "chown" unsafe
256 c_chown :: CString -> CUid -> CGid -> IO CInt
258 foreign import ccall "close" unsafe
259 c_close :: CInt -> IO CInt
261 foreign import ccall "closedir" unsafe
262 c_closedir :: Ptr CDir -> IO CInt
264 foreign import ccall "creat" unsafe
265 c_creat :: CString -> CMode -> IO CInt
267 foreign import ccall "dup" unsafe
268 c_dup :: CInt -> IO CInt
270 foreign import ccall "dup2" unsafe
271 c_dup2 :: CInt -> CInt -> IO CInt
273 foreign import ccall "fpathconf" unsafe
274 c_fpathconf :: CInt -> CInt -> IO CLong
276 foreign import ccall "fstat" unsafe
277 c_fstat :: CInt -> Ptr CStat -> IO CInt
279 foreign import ccall "getcwd" unsafe
280 c_getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar)
282 foreign import ccall "isatty" unsafe
283 c_isatty :: CInt -> IO CInt
285 foreign import ccall "link" unsafe
286 c_link :: CString -> CString -> IO CInt
288 foreign import ccall "lseek" unsafe
289 c_lseek :: CInt -> COff -> CInt -> IO COff
292 foreign import ccall "lstat" unsafe
293 c_lstat :: CString -> Ptr CStat -> IO CInt
296 foreign import ccall "open" unsafe
297 c_open :: CString -> CInt -> CMode -> IO CInt
299 foreign import ccall "opendir" unsafe
300 c_opendir :: CString -> IO (Ptr CDir)
302 foreign import ccall "mkdir" unsafe
303 #if defined(mingw32_TARGET_OS)
304 c_mkdir :: CString -> IO CInt
306 c_mkdir :: CString -> CMode -> IO CInt
309 foreign import ccall "mkfifo" unsafe
310 c_mkfifo :: CString -> CMode -> IO CInt
312 foreign import ccall "pathconf" unsafe
313 c_pathconf :: CString -> CInt -> IO CLong
315 foreign import ccall "pipe" unsafe
316 c_pipe :: Ptr CInt -> IO CInt
318 foreign import ccall "read" unsafe
319 c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
321 foreign import ccall "readdir" unsafe
322 c_readdir :: Ptr CDir -> IO (Ptr CDirent)
324 foreign import ccall "rename" unsafe
325 c_rename :: CString -> CString -> IO CInt
327 foreign import ccall "rewinddir" unsafe
328 c_rewinddir :: Ptr CDir -> IO ()
330 foreign import ccall "rmdir" unsafe
331 c_rmdir :: CString -> IO CInt
333 foreign import ccall "stat" unsafe
334 c_stat :: CString -> Ptr CStat -> IO CInt
336 foreign import ccall "umask" unsafe
337 c_umask :: CMode -> IO CMode
339 foreign import ccall "utime" unsafe
340 c_utime :: CString -> Ptr CUtimbuf -> IO CMode
342 foreign import ccall "write" unsafe
343 c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
345 #ifndef mingw32_TARGET_OS
346 foreign import ccall "fcntl" unsafe
347 c_fcntl_read :: CInt -> CInt -> IO CInt
349 foreign import ccall "fcntl" unsafe
350 c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt
352 foreign import ccall "fcntl" unsafe
353 c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt
355 foreign import ccall "fork" unsafe
358 foreign import ccall "sigemptyset" unsafe
359 c_sigemptyset :: Ptr CSigset -> IO ()
361 foreign import ccall "sigaddset" unsafe
362 c_sigaddset :: Ptr CSigset -> CInt -> IO ()
364 foreign import ccall "sigprocmask" unsafe
365 c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO ()
367 foreign import ccall "tcgetattr" unsafe
368 c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
370 foreign import ccall "tcsetattr" unsafe
371 c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
373 foreign import ccall "uname" unsafe
374 c_uname :: Ptr CUtsname -> IO CInt
376 foreign import ccall "unlink" unsafe
377 c_unlink :: CString -> IO CInt
379 foreign import ccall "waitpid" unsafe
380 c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
383 foreign import "s_isreg_wrap" unsafe s_isreg :: CMode -> Bool
384 foreign import "s_ischr_wrap" unsafe s_ischr :: CMode -> Bool
385 foreign import "s_isblk_wrap" unsafe s_isblk :: CMode -> Bool
386 foreign import "s_isdir_wrap" unsafe s_isdir :: CMode -> Bool
387 foreign import "s_isfifo_wrap" unsafe s_isfifo :: CMode -> Bool
389 #ifndef mingw32_TARGET_OS
390 foreign import "s_issock_wrap" s_issock :: CMode -> Bool
392 s_issock :: CMode -> Bool
393 s_issock cmode = False