1 {-# OPTIONS -fno-implicit-prelude #-}
3 -- ---------------------------------------------------------------------------
4 -- $Id: Posix.hsc,v 1.4 2001/12/21 15:07:25 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 -- NOTE: On Win32 platforms, this will only work with file descriptors
94 -- referring to file handles. i.e., it'll fail for socket FDs.
95 fdType :: Int -> IO FDType
97 allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
98 throwErrnoIfMinus1Retry "fdType" $
99 c_fstat (fromIntegral fd) p_stat
102 statGetType p_stat = do
103 c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode
105 _ | s_isdir c_mode -> return Directory
106 | s_isfifo c_mode || s_issock c_mode -> return Stream
107 | s_isreg c_mode -> return RegularFile
108 | otherwise -> ioException ioe_unknownfiletype
111 ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
112 "unknown file type" Nothing
114 -- It isn't clear whether ftruncate is POSIX or not (I've read several
115 -- manpages and they seem to conflict), so we truncate using open/2.
116 fileTruncate :: FilePath -> IO ()
117 fileTruncate file = do
118 let flags = o_WRONLY .|. o_TRUNC
119 withCString file $ \file_cstr -> do
120 fd <- fromIntegral `liftM`
121 throwErrnoIfMinus1Retry "fileTruncate"
122 (c_open file_cstr (fromIntegral flags) 0o666)
126 #ifdef mingw32_TARGET_OS
127 closeFd :: Bool -> CInt -> IO CInt
129 | isStream = c_closesocket fd
130 | otherwise = c_close fd
132 foreign import "closesocket" unsafe
133 c_closesocket :: CInt -> IO CInt
136 -- ---------------------------------------------------------------------------
137 -- Terminal-related stuff
139 fdIsTTY :: Int -> IO Bool
140 fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool
142 #ifndef mingw32_TARGET_OS
144 setEcho :: Int -> Bool -> IO ()
146 allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
147 throwErrnoIfMinus1Retry "setEcho"
148 (c_tcgetattr (fromIntegral fd) p_tios)
149 c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
150 let new_c_lflag | on = c_lflag .|. (#const ECHO)
151 | otherwise = c_lflag .&. complement (#const ECHO)
152 (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
153 tcSetAttr fd (#const TCSANOW) p_tios
155 getEcho :: Int -> IO Bool
157 allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
158 throwErrnoIfMinus1Retry "setEcho"
159 (c_tcgetattr (fromIntegral fd) p_tios)
160 c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
161 return ((c_lflag .&. (#const ECHO)) /= 0)
163 setCooked :: Int -> Bool -> IO ()
164 setCooked fd cooked =
165 allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
166 throwErrnoIfMinus1Retry "setCooked"
167 (c_tcgetattr (fromIntegral fd) p_tios)
169 -- turn on/off ICANON
170 c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
171 let new_c_lflag | cooked = c_lflag .|. (#const ICANON)
172 | otherwise = c_lflag .&. complement (#const ICANON)
173 (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
175 -- set VMIN & VTIME to 1/0 respectively
177 let c_cc = (#ptr struct termios, c_cc) p_tios
178 vmin = c_cc `plusPtr` (#const VMIN) :: Ptr Word8
179 vtime = c_cc `plusPtr` (#const VTIME) :: Ptr Word8
183 tcSetAttr fd (#const TCSANOW) p_tios
185 -- tcsetattr() when invoked by a background process causes the process
186 -- to be sent SIGTTOU regardless of whether the process has TOSTOP set
187 -- in its terminal flags (try it...). This function provides a
188 -- wrapper which temporarily blocks SIGTTOU around the call, making it
191 tcSetAttr :: FD -> CInt -> Ptr CTermios -> IO ()
192 tcSetAttr fd options p_tios = do
193 allocaBytes (#const sizeof(sigset_t)) $ \ p_sigset -> do
194 allocaBytes (#const sizeof(sigset_t)) $ \ p_old_sigset -> do
195 c_sigemptyset p_sigset
196 c_sigaddset p_sigset (#const SIGTTOU)
197 c_sigprocmask (#const SIG_BLOCK) p_sigset p_old_sigset
198 throwErrnoIfMinus1Retry_ "tcSetAttr" $
199 c_tcsetattr (fromIntegral fd) options p_tios
200 c_sigprocmask (#const SIG_SETMASK) p_old_sigset nullPtr
204 -- bogus defns for win32
205 setCooked :: Int -> Bool -> IO ()
206 setCooked fd cooked = return ()
208 setEcho :: Int -> Bool -> IO ()
209 setEcho fd on = return ()
211 getEcho :: Int -> IO Bool
212 getEcho fd = return False
216 -- ---------------------------------------------------------------------------
217 -- Turning on non-blocking for a file descriptor
219 #ifndef mingw32_TARGET_OS
221 setNonBlockingFD fd = do
222 flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
223 (c_fcntl_read (fromIntegral fd) (#const F_GETFL))
224 -- An error when setting O_NONBLOCK isn't fatal: on some systems
225 -- there are certain file handles on which this will fail (eg. /dev/null
226 -- on FreeBSD) so we throw away the return code from fcntl_write.
227 fcntl_write (fromIntegral fd)
228 (#const F_SETFL) (flags .|. #const O_NONBLOCK)
231 -- bogus defns for win32
232 setNonBlockingFD fd = return ()
236 -- -----------------------------------------------------------------------------
240 o_RDONLY = (#const O_RDONLY) :: CInt
241 o_WRONLY = (#const O_WRONLY) :: CInt
242 o_RDWR = (#const O_RDWR) :: CInt
243 o_APPEND = (#const O_APPEND) :: CInt
244 o_CREAT = (#const O_CREAT) :: CInt
245 o_EXCL = (#const O_EXCL) :: CInt
246 o_TRUNC = (#const O_TRUNC) :: CInt
248 #ifdef mingw32_TARGET_OS
250 o_NONBLOCK = 0 :: CInt
252 o_NOCTTY = (#const O_NOCTTY) :: CInt
253 o_NONBLOCK = (#const O_NONBLOCK) :: CInt
257 o_BINARY = (#const O_BINARY) :: CInt
260 foreign import ccall "access" unsafe
261 c_access :: CString -> CMode -> IO CInt
263 foreign import ccall "chmod" unsafe
264 c_chmod :: CString -> CMode -> IO CInt
266 foreign import ccall "chdir" unsafe
267 c_chdir :: CString -> IO CInt
269 foreign import ccall "chown" unsafe
270 c_chown :: CString -> CUid -> CGid -> IO CInt
272 foreign import ccall "close" unsafe
273 c_close :: CInt -> IO CInt
275 foreign import ccall "closedir" unsafe
276 c_closedir :: Ptr CDir -> IO CInt
278 foreign import ccall "creat" unsafe
279 c_creat :: CString -> CMode -> IO CInt
281 foreign import ccall "dup" unsafe
282 c_dup :: CInt -> IO CInt
284 foreign import ccall "dup2" unsafe
285 c_dup2 :: CInt -> CInt -> IO CInt
287 foreign import ccall "fpathconf" unsafe
288 c_fpathconf :: CInt -> CInt -> IO CLong
290 foreign import ccall "fstat" unsafe
291 c_fstat :: CInt -> Ptr CStat -> IO CInt
293 foreign import ccall "getcwd" unsafe
294 c_getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar)
296 foreign import ccall "isatty" unsafe
297 c_isatty :: CInt -> IO CInt
299 foreign import ccall "link" unsafe
300 c_link :: CString -> CString -> IO CInt
302 foreign import ccall "lseek" unsafe
303 c_lseek :: CInt -> COff -> CInt -> IO COff
306 foreign import ccall "lstat" unsafe
307 c_lstat :: CString -> Ptr CStat -> IO CInt
310 foreign import ccall "open" unsafe
311 c_open :: CString -> CInt -> CMode -> IO CInt
313 foreign import ccall "opendir" unsafe
314 c_opendir :: CString -> IO (Ptr CDir)
316 foreign import ccall "mkdir" unsafe
317 #if defined(mingw32_TARGET_OS)
318 c_mkdir :: CString -> IO CInt
320 c_mkdir :: CString -> CMode -> IO CInt
323 foreign import ccall "mkfifo" unsafe
324 c_mkfifo :: CString -> CMode -> IO CInt
326 foreign import ccall "pathconf" unsafe
327 c_pathconf :: CString -> CInt -> IO CLong
329 foreign import ccall "pipe" unsafe
330 c_pipe :: Ptr CInt -> IO CInt
332 foreign import ccall "read" unsafe
333 c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
335 foreign import ccall "readdir" unsafe
336 c_readdir :: Ptr CDir -> IO (Ptr CDirent)
338 foreign import ccall "rename" unsafe
339 c_rename :: CString -> CString -> IO CInt
341 foreign import ccall "rewinddir" unsafe
342 c_rewinddir :: Ptr CDir -> IO ()
344 foreign import ccall "rmdir" unsafe
345 c_rmdir :: CString -> IO CInt
347 foreign import ccall "stat" unsafe
348 c_stat :: CString -> Ptr CStat -> IO CInt
350 foreign import ccall "umask" unsafe
351 c_umask :: CMode -> IO CMode
353 foreign import ccall "utime" unsafe
354 c_utime :: CString -> Ptr CUtimbuf -> IO CMode
356 foreign import ccall "write" unsafe
357 c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
359 #ifndef mingw32_TARGET_OS
360 foreign import ccall "fcntl" unsafe
361 c_fcntl_read :: CInt -> CInt -> IO CInt
363 foreign import ccall "fcntl" unsafe
364 c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt
366 foreign import ccall "fcntl" unsafe
367 c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt
369 foreign import ccall "fork" unsafe
372 foreign import ccall "sigemptyset_wrap" unsafe
373 c_sigemptyset :: Ptr CSigset -> IO ()
375 foreign import ccall "sigaddset" unsafe
376 c_sigaddset :: Ptr CSigset -> CInt -> IO ()
378 foreign import ccall "sigprocmask" unsafe
379 c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO ()
381 foreign import ccall "tcgetattr" unsafe
382 c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
384 foreign import ccall "tcsetattr" unsafe
385 c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
387 foreign import ccall "uname" unsafe
388 c_uname :: Ptr CUtsname -> IO CInt
390 foreign import ccall "unlink" unsafe
391 c_unlink :: CString -> IO CInt
393 foreign import ccall "waitpid" unsafe
394 c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
397 foreign import "s_isreg_wrap" unsafe s_isreg :: CMode -> Bool
398 foreign import "s_ischr_wrap" unsafe s_ischr :: CMode -> Bool
399 foreign import "s_isblk_wrap" unsafe s_isblk :: CMode -> Bool
400 foreign import "s_isdir_wrap" unsafe s_isdir :: CMode -> Bool
401 foreign import "s_isfifo_wrap" unsafe s_isfifo :: CMode -> Bool
403 #ifndef mingw32_TARGET_OS
404 foreign import "s_issock_wrap" s_issock :: CMode -> Bool
406 s_issock :: CMode -> Bool
407 s_issock cmode = False