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
61 getProcessID :: IO ProcessID
62 getProcessID = _ccall_ getpid
64 getParentProcessID :: IO ProcessID
65 getParentProcessID = _ccall_ getppid
67 getRealUserID :: IO UserID
68 getRealUserID = _ccall_ getuid
70 getEffectiveUserID :: IO UserID
71 getEffectiveUserID = _ccall_ geteuid
73 setUserID :: UserID -> IO ()
74 setUserID uid = nonzero_error (_ccall_ setuid uid) "setUserID"
76 getLoginName :: IO String
78 str <- _ccall_ getlogin
80 then syserr "getLoginName"
83 getRealGroupID :: IO GroupID
84 getRealGroupID = _ccall_ getgid
86 getEffectiveGroupID :: IO GroupID
87 getEffectiveGroupID = _ccall_ getegid
89 setGroupID :: GroupID -> IO ()
90 setGroupID gid = nonzero_error (_ccall_ setgid gid) "setGroupID"
92 -- getgroups() is not supported in beta18 of
94 #if !defined(cygwin32_TARGET_OS)
95 getGroups :: IO [GroupID]
97 ngroups <- _ccall_ getgroups 0 (``NULL''::Addr)
98 words <- allocWords ngroups
99 ngroups <- _casm_ ``%r = getgroups(%0,(gid_t *)%1);'' ngroups words
103 return (map (extract arr) [0..(ngroups-1)])
107 extract (ByteArray _ barr#) (I# n#) =
108 case indexIntArray# barr# n# of
112 getEffectiveUserName :: IO String
113 getEffectiveUserName = do
114 str <- _ccall_ cuserid (``NULL''::Addr)
116 then syserr "getEffectiveUserName"
119 getProcessGroupID :: IO ProcessGroupID
120 getProcessGroupID = _ccall_ getpgrp
122 createProcessGroup :: ProcessID -> IO ProcessGroupID
123 createProcessGroup pid = do
124 pgid <- _ccall_ setpgid pid 0
127 else syserr "createProcessGroup"
129 joinProcessGroup :: ProcessGroupID -> IO ()
130 joinProcessGroup pgid =
131 nonzero_error (_ccall_ setpgid 0 pgid) "joinProcessGroupID"
133 setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
134 setProcessGroupID pid pgid =
135 nonzero_error (_ccall_ setpgid pid pgid) "setProcessGroupID"
137 createSession :: IO ProcessGroupID
139 pgid <- _ccall_ setsid
142 else syserr "createSession"
144 type SystemID = ByteArray ()
146 systemName :: SystemID -> String
147 systemName sid = unsafePerformIO $ do
148 str <-_casm_ ``%r = ((struct utsname *)%0)->sysname;'' sid
151 nodeName :: SystemID -> String
152 nodeName sid = unsafePerformIO $ do
153 str <- _casm_ ``%r = ((struct utsname *)%0)->nodename;'' sid
156 release :: SystemID -> String
157 release sid = unsafePerformIO $ do
158 str <- _casm_ ``%r = ((struct utsname *)%0)->release;'' sid
161 version :: SystemID -> String
162 version sid = unsafePerformIO $ do
163 str <- _casm_ ``%r = ((struct utsname *)%0)->version;'' sid
166 machine :: SystemID -> String
167 machine sid = unsafePerformIO $ do
168 str <- _casm_ ``%r = ((struct utsname *)%0)->machine;'' sid
171 getSystemID :: IO SystemID
173 bytes <- allocChars (``sizeof(struct utsname)''::Int)
174 rc <- _casm_ ``%r = uname((struct utsname *)%0);'' bytes
177 else syserr "getSystemID"
179 epochTime :: IO EpochTime
181 secs <- _ccall_ time (``NULL''::Addr)
184 else syserr "epochTime"
186 -- All times in clock ticks (see getClockTick)
188 type ProcessTimes = (ClockTick, ByteArray ())
190 elapsedTime :: ProcessTimes -> ClockTick
191 elapsedTime (realtime, _) = realtime
193 userTime :: ProcessTimes -> ClockTick
194 userTime (_, times) = unsafePerformIO $
195 _casm_ ``%r = ((struct tms *)%0)->tms_utime;'' times
197 systemTime :: ProcessTimes -> ClockTick
198 systemTime (_, times) = unsafePerformIO $
199 _casm_ ``%r = ((struct tms *)%0)->tms_stime;'' times
201 childUserTime :: ProcessTimes -> ClockTick
202 childUserTime (_, times) = unsafePerformIO $
203 _casm_ ``%r = ((struct tms *)%0)->tms_cutime;'' times
205 childSystemTime :: ProcessTimes -> ClockTick
206 childSystemTime (_, times) = unsafePerformIO $
207 _casm_ ``%r = ((struct tms *)%0)->tms_cstime;'' times
209 getProcessTimes :: IO ProcessTimes
211 bytes <- allocChars (``sizeof(struct tms)''::Int)
212 elapsed <- _casm_ ``%r = times((struct tms *)%0);'' bytes
215 times <- freeze bytes
216 return (elapsed, times)
218 syserr "getProcessTimes"
220 #if !defined(cygwin32_TARGET_OS)
221 getControllingTerminalName :: IO FilePath
222 getControllingTerminalName = do
223 str <- _ccall_ ctermid (``NULL''::Addr)
225 then fail (IOError Nothing NoSuchThing "getControllingTerminalName: no controlling terminal")
229 getTerminalName :: Fd -> IO FilePath
230 getTerminalName fd = do
231 str <- _ccall_ ttyname fd
234 err <- try (queryTerminal fd)
235 either (\err -> syserr "getTerminalName")
236 (\succ -> if succ then fail (IOError Nothing NoSuchThing
237 "getTerminalName: no name")
238 else fail (IOError Nothing InappropriateType
239 "getTerminalName: not a terminal"))
243 queryTerminal :: Fd -> IO Bool
244 queryTerminal (FD# fd) = do
245 rc <- _ccall_ isatty fd
247 -1 -> syserr "queryTerminal"
251 data SysVar = ArgumentLimit
260 getSysVar :: SysVar -> IO Limit
263 ArgumentLimit -> sysconf ``_SC_ARG_MAX''
264 ChildLimit -> sysconf ``_SC_CHILD_MAX''
265 ClockTick -> sysconf ``_SC_CLK_TCK''
266 GroupLimit -> sysconf ``_SC_NGROUPS_MAX''
267 OpenFileLimit -> sysconf ``_SC_OPEN_MAX''
268 PosixVersion -> sysconf ``_SC_VERSION''
269 HasSavedIDs -> sysconf ``_SC_SAVED_IDS''
270 HasJobControl -> sysconf ``_SC_JOB_CONTROL''
273 sysconf :: Int -> IO Limit
275 rc <- _ccall_ sysconf n
278 else fail (IOError Nothing NoSuchThing
279 "getSysVar: no such system limit or option")