2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
4 \section[PosixProcEnv]{Haskell 1.3 POSIX Process Environment}
20 #if !defined(cygwin32_TARGET_OS)
21 getControllingTerminalName,
26 #if !defined(cygwin32_TARGET_OS)
54 import PrelArr (ByteArray(..)) -- see internals
57 import Addr ( nullAddr )
61 import CString ( strcpy, allocWords, freeze, allocChars )
66 getProcessID :: IO ProcessID
67 getProcessID = _ccall_ getpid
69 getParentProcessID :: IO ProcessID
70 getParentProcessID = _ccall_ getppid
72 getRealUserID :: IO UserID
73 getRealUserID = _ccall_ getuid
75 getEffectiveUserID :: IO UserID
76 getEffectiveUserID = _ccall_ geteuid
78 setUserID :: UserID -> IO ()
79 setUserID uid = nonzero_error (_ccall_ setuid uid) "setUserID"
81 getLoginName :: IO String
83 str <- _ccall_ getlogin
85 then syserr "getLoginName"
88 getRealGroupID :: IO GroupID
89 getRealGroupID = _ccall_ getgid
91 getEffectiveGroupID :: IO GroupID
92 getEffectiveGroupID = _ccall_ getegid
94 setGroupID :: GroupID -> IO ()
95 setGroupID gid = nonzero_error (_ccall_ setgid gid) "setGroupID"
97 -- getgroups() is not supported in beta18 of
99 #if !defined(cygwin32_TARGET_OS)
100 getGroups :: IO [GroupID]
102 ngroups <- _ccall_ getgroups (0::Int) nullAddr
103 words <- allocWords ngroups
104 ngroups <- _casm_ ``%r = getgroups(%0,(gid_t *)%1);'' ngroups words
105 if ngroups /= ((-1)::Int)
108 return (map (extract arr) [0..(ngroups-1)])
112 extract (ByteArray _ barr#) (I# n#) =
113 case indexIntArray# barr# n# of
117 getEffectiveUserName :: IO String
118 getEffectiveUserName = do
119 {- cuserid() is deprecated, using getpwuid() instead. -}
120 euid <- getEffectiveUserID
121 ptr <- _ccall_ getpwuid euid
122 str <- _casm_ ``%r = ((struct passwd *)%0)->pw_name;'' (ptr::Addr)
126 str <- _ccall_ cuserid nullAddr
128 then syserr "getEffectiveUserName"
132 getProcessGroupID :: IO ProcessGroupID
133 getProcessGroupID = _ccall_ getpgrp
135 createProcessGroup :: ProcessID -> IO ProcessGroupID
136 createProcessGroup pid = do
137 pgid <- _ccall_ setpgid pid (0::Int)
140 else syserr "createProcessGroup"
142 joinProcessGroup :: ProcessGroupID -> IO ()
143 joinProcessGroup pgid =
144 nonzero_error (_ccall_ setpgid (0::Int) pgid) "joinProcessGroupID"
146 setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
147 setProcessGroupID pid pgid =
148 nonzero_error (_ccall_ setpgid pid pgid) "setProcessGroupID"
150 createSession :: IO ProcessGroupID
152 pgid <- _ccall_ setsid
153 if pgid /= ((-1)::Int)
155 else syserr "createSession"
157 type SystemID = ByteArray Int
159 systemName :: SystemID -> String
160 systemName sid = unsafePerformIO $ do
161 str <-_casm_ ``%r = ((struct utsname *)%0)->sysname;'' sid
164 nodeName :: SystemID -> String
165 nodeName sid = unsafePerformIO $ do
166 str <- _casm_ ``%r = ((struct utsname *)%0)->nodename;'' sid
169 release :: SystemID -> String
170 release sid = unsafePerformIO $ do
171 str <- _casm_ ``%r = ((struct utsname *)%0)->release;'' sid
174 version :: SystemID -> String
175 version sid = unsafePerformIO $ do
176 str <- _casm_ ``%r = ((struct utsname *)%0)->version;'' sid
179 machine :: SystemID -> String
180 machine sid = unsafePerformIO $ do
181 str <- _casm_ ``%r = ((struct utsname *)%0)->machine;'' sid
184 getSystemID :: IO SystemID
186 bytes <- allocChars (``sizeof(struct utsname)''::Int)
187 rc <- _casm_ ``%r = uname((struct utsname *)%0);'' bytes
190 else syserr "getSystemID"
192 epochTime :: IO EpochTime
194 secs <- _ccall_ time nullAddr
195 if secs /= ((-1)::Int)
197 else syserr "epochTime"
199 -- All times in clock ticks (see getClockTick)
201 type ProcessTimes = (ClockTick, ByteArray Int)
203 elapsedTime :: ProcessTimes -> ClockTick
204 elapsedTime (realtime, _) = realtime
206 userTime :: ProcessTimes -> ClockTick
207 userTime (_, times) = unsafePerformIO $
208 _casm_ ``%r = ((struct tms *)%0)->tms_utime;'' times
210 systemTime :: ProcessTimes -> ClockTick
211 systemTime (_, times) = unsafePerformIO $
212 _casm_ ``%r = ((struct tms *)%0)->tms_stime;'' times
214 childUserTime :: ProcessTimes -> ClockTick
215 childUserTime (_, times) = unsafePerformIO $
216 _casm_ ``%r = ((struct tms *)%0)->tms_cutime;'' times
218 childSystemTime :: ProcessTimes -> ClockTick
219 childSystemTime (_, times) = unsafePerformIO $
220 _casm_ ``%r = ((struct tms *)%0)->tms_cstime;'' times
222 getProcessTimes :: IO ProcessTimes
224 bytes <- allocChars (``sizeof(struct tms)''::Int)
225 elapsed <- _casm_ ``%r = times((struct tms *)%0);'' bytes
226 if elapsed /= ((-1)::Int)
228 times <- freeze bytes
229 return (elapsed, times)
231 syserr "getProcessTimes"
233 #if !defined(cygwin32_TARGET_OS)
234 getControllingTerminalName :: IO FilePath
235 getControllingTerminalName = do
236 str <- _ccall_ ctermid nullAddr
238 then ioError (IOError Nothing NoSuchThing "getControllingTerminalName" "no controlling terminal")
242 getTerminalName :: Fd -> IO FilePath
243 getTerminalName fd = do
244 str <- _ccall_ ttyname fd
247 err <- try (queryTerminal fd)
248 either (\err -> syserr "getTerminalName")
249 (\succ -> if succ then ioError (IOError Nothing NoSuchThing
250 "getTerminalName" "no name")
251 else ioError (IOError Nothing InappropriateType
252 "getTerminalName" "not a terminal"))
256 queryTerminal :: Fd -> IO Bool
257 queryTerminal (FD# fd) = do
258 rc <- _ccall_ isatty fd
260 -1 -> syserr "queryTerminal"
264 data SysVar = ArgumentLimit
273 getSysVar :: SysVar -> IO Limit
276 ArgumentLimit -> sysconf ``_SC_ARG_MAX''
277 ChildLimit -> sysconf ``_SC_CHILD_MAX''
278 ClockTick -> sysconf ``_SC_CLK_TCK''
279 GroupLimit -> sysconf ``_SC_NGROUPS_MAX''
280 OpenFileLimit -> sysconf ``_SC_OPEN_MAX''
281 PosixVersion -> sysconf ``_SC_VERSION''
282 HasSavedIDs -> sysconf ``_SC_SAVED_IDS''
283 HasJobControl -> sysconf ``_SC_JOB_CONTROL''
286 sysconf :: Int -> IO Limit
288 rc <- _ccall_ sysconf n
291 else ioError (IOError Nothing NoSuchThing
293 "no such system limit or option")