1{-# LANGUAGE CApiFFI #-} 2{-# LANGUAGE NondecreasingIndentation #-} 3#if __GLASGOW_HASKELL__ >= 709 4{-# LANGUAGE Safe #-} 5#else 6{-# LANGUAGE Trustworthy #-} 7#endif 8----------------------------------------------------------------------------- 9-- | 10-- Module : System.Posix.Unistd 11-- Copyright : (c) The University of Glasgow 2002 12-- License : BSD-style (see the file libraries/base/LICENSE) 13-- 14-- Maintainer : libraries@haskell.org 15-- Stability : provisional 16-- Portability : non-portable (requires POSIX) 17-- 18-- POSIX miscellaneous stuff, mostly from unistd.h 19-- 20----------------------------------------------------------------------------- 21 22module System.Posix.Unistd ( 23 -- * System environment 24 SystemID(..), 25 getSystemID, 26 27 SysVar(..), 28 getSysVar, 29 30 -- * Sleeping 31 sleep, usleep, nanosleep, 32 33 -- * File synchronisation 34 fileSynchronise, 35 fileSynchroniseDataOnly, 36 37 {- 38 ToDo from unistd.h: 39 confstr, 40 lots of sysconf variables 41 42 -- use Network.BSD 43 gethostid, gethostname 44 45 -- should be in System.Posix.Files? 46 pathconf, fpathconf, 47 48 -- System.Posix.Signals 49 ualarm, 50 51 -- System.Posix.IO 52 read, write, 53 54 -- should be in System.Posix.User? 55 getEffectiveUserName, 56-} 57 ) where 58 59#include "HsUnix.h" 60 61import Foreign.C.Error 62import Foreign.C.String ( peekCString ) 63import Foreign.C.Types 64import Foreign 65import System.Posix.Types 66import System.Posix.Internals 67 68#if !(HAVE_FSYNC && HAVE_FDATASYNC) 69import System.IO.Error ( ioeSetLocation ) 70import GHC.IO.Exception ( unsupportedOperation ) 71#endif 72 73-- ----------------------------------------------------------------------------- 74-- System environment (uname()) 75 76data SystemID = 77 SystemID { systemName :: String 78 , nodeName :: String 79 , release :: String 80 , version :: String 81 , machine :: String 82 } 83 84getSystemID :: IO SystemID 85getSystemID = do 86 allocaBytes (#const sizeof(struct utsname)) $ \p_sid -> do 87 throwErrnoIfMinus1_ "getSystemID" (c_uname p_sid) 88 sysN <- peekCString ((#ptr struct utsname, sysname) p_sid) 89 node <- peekCString ((#ptr struct utsname, nodename) p_sid) 90 rel <- peekCString ((#ptr struct utsname, release) p_sid) 91 ver <- peekCString ((#ptr struct utsname, version) p_sid) 92 mach <- peekCString ((#ptr struct utsname, machine) p_sid) 93 return (SystemID { systemName = sysN, 94 nodeName = node, 95 release = rel, 96 version = ver, 97 machine = mach 98 }) 99 100foreign import ccall unsafe "uname" 101 c_uname :: Ptr CUtsname -> IO CInt 102 103-- ----------------------------------------------------------------------------- 104-- sleeping 105 106-- | Sleep for the specified duration (in seconds). Returns the time remaining 107-- (if the sleep was interrupted by a signal, for example). 108-- 109-- /GHC Note/: 'Control.Concurrent.threadDelay' is a better choice. Since GHC 110-- uses signals for its internal clock, a call to 'sleep' will usually be 111-- interrupted immediately. That makes 'sleep' unusable in a program compiled 112-- with GHC, unless the RTS timer is disabled (with @+RTS -V0@). Furthermore, 113-- without the @-threaded@ option, 'sleep' will block all other user threads. 114-- Even with the @-threaded@ option, 'sleep' requires a full OS thread to 115-- itself. 'Control.Concurrent.threadDelay' has none of these shortcomings. 116-- 117sleep :: Int -> IO Int 118sleep 0 = return 0 119sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r) 120 121{-# WARNING sleep "This function has several shortcomings (see documentation). Please consider using Control.Concurrent.threadDelay instead." #-} 122 123foreign import ccall safe "sleep" 124 c_sleep :: CUInt -> IO CUInt 125 126-- | Sleep for the specified duration (in microseconds). 127-- 128-- /GHC Note/: 'Control.Concurrent.threadDelay' is a better choice. 129-- Without the @-threaded@ option, 'usleep' will block all other user 130-- threads. Even with the @-threaded@ option, 'usleep' requires a 131-- full OS thread to itself. 'Control.Concurrent.threadDelay' has 132-- neither of these shortcomings. 133-- 134usleep :: Int -> IO () 135#ifdef HAVE_NANOSLEEP 136usleep usecs = nanosleep (fromIntegral usecs * 1000) 137#else 138usleep 0 = return () 139#ifdef USLEEP_RETURNS_VOID 140usleep usecs = c_usleep (fromIntegral usecs) 141#else 142usleep usecs = throwErrnoIfMinus1_ "usleep" (c_usleep (fromIntegral usecs)) 143#endif 144 145#ifdef USLEEP_RETURNS_VOID 146foreign import ccall safe "usleep" 147 c_usleep :: CUInt -> IO () 148#else 149foreign import ccall safe "usleep" 150 c_usleep :: CUInt -> IO CInt 151#endif 152#endif /* HAVE_NANOSLEEP */ 153 154-- | Sleep for the specified duration (in nanoseconds) 155-- 156-- /GHC Note/: the comment for 'usleep' also applies here. 157nanosleep :: Integer -> IO () 158#ifndef HAVE_NANOSLEEP 159nanosleep = error "nanosleep: not available on this platform" 160#else 161nanosleep 0 = return () 162nanosleep nsecs = do 163 allocaBytes (#const sizeof(struct timespec)) $ \pts1 -> do 164 allocaBytes (#const sizeof(struct timespec)) $ \pts2 -> do 165 let (tv_sec0, tv_nsec0) = nsecs `divMod` 1000000000 166 let 167 loop tv_sec tv_nsec = do 168 (#poke struct timespec, tv_sec) pts1 tv_sec 169 (#poke struct timespec, tv_nsec) pts1 tv_nsec 170 res <- c_nanosleep pts1 pts2 171 if res == 0 172 then return () 173 else do errno <- getErrno 174 if errno == eINTR 175 then do 176 tv_sec' <- (#peek struct timespec, tv_sec) pts2 177 tv_nsec' <- (#peek struct timespec, tv_nsec) pts2 178 loop tv_sec' tv_nsec' 179 else throwErrno "nanosleep" 180 loop (fromIntegral tv_sec0 :: CTime) (fromIntegral tv_nsec0 :: CTime) 181 182data {-# CTYPE "struct timespec" #-} CTimeSpec 183 184foreign import capi safe "HsUnix.h nanosleep" 185 c_nanosleep :: Ptr CTimeSpec -> Ptr CTimeSpec -> IO CInt 186#endif 187 188-- ----------------------------------------------------------------------------- 189-- System variables 190 191data SysVar = ArgumentLimit 192 | ChildLimit 193 | ClockTick 194 | GroupLimit 195 | OpenFileLimit 196 | PosixVersion 197 | HasSavedIDs 198 | HasJobControl 199 -- ToDo: lots more 200 201getSysVar :: SysVar -> IO Integer 202getSysVar v = 203 case v of 204 ArgumentLimit -> sysconf (#const _SC_ARG_MAX) 205 ChildLimit -> sysconf (#const _SC_CHILD_MAX) 206 ClockTick -> sysconf (#const _SC_CLK_TCK) 207 GroupLimit -> sysconf (#const _SC_NGROUPS_MAX) 208 OpenFileLimit -> sysconf (#const _SC_OPEN_MAX) 209 PosixVersion -> sysconf (#const _SC_VERSION) 210 HasSavedIDs -> sysconf (#const _SC_SAVED_IDS) 211 HasJobControl -> sysconf (#const _SC_JOB_CONTROL) 212 213sysconf :: CInt -> IO Integer 214sysconf n = do 215 r <- throwErrnoIfMinus1 "getSysVar" (c_sysconf n) 216 return (fromIntegral r) 217 218foreign import ccall unsafe "sysconf" 219 c_sysconf :: CInt -> IO CLong 220 221-- ----------------------------------------------------------------------------- 222-- File synchronization 223 224-- | Performs @fsync(2)@ operation on file-descriptor. 225-- 226-- Throws 'IOError' (\"unsupported operation\") if platform does not 227-- provide @fsync(2)@ (use @#if HAVE_FSYNC@ CPP guard to 228-- detect availability). 229-- 230-- @since 2.7.1.0 231fileSynchronise :: Fd -> IO () 232#if HAVE_FSYNC 233fileSynchronise fd = do 234 throwErrnoIfMinus1_ "fileSynchronise" (c_fsync fd) 235 236foreign import capi safe "unistd.h fsync" 237 c_fsync :: Fd -> IO CInt 238#else 239{-# WARNING fileSynchronise 240 "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FSYNC@)" #-} 241fileSynchronise _ = ioError (ioeSetLocation unsupportedOperation 242 "fileSynchronise") 243#endif 244 245-- | Performs @fdatasync(2)@ operation on file-descriptor. 246-- 247-- Throws 'IOError' (\"unsupported operation\") if platform does not 248-- provide @fdatasync(2)@ (use @#if HAVE_FDATASYNC@ CPP guard to 249-- detect availability). 250-- 251-- @since 2.7.1.0 252fileSynchroniseDataOnly :: Fd -> IO () 253#if HAVE_FDATASYNC 254fileSynchroniseDataOnly fd = do 255 throwErrnoIfMinus1_ "fileSynchroniseDataOnly" (c_fdatasync fd) 256 257foreign import capi safe "unistd.h fdatasync" 258 c_fdatasync :: Fd -> IO CInt 259#else 260{-# WARNING fileSynchroniseDataOnly 261 "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FDATASYNC@)" #-} 262fileSynchroniseDataOnly _ = ioError (ioeSetLocation unsupportedOperation 263 "fileSynchroniseDataOnly") 264#endif 265