[project @ 1999-10-29 13:53:37 by sof]
[ghc-hetmet.git] / ghc / lib / posix / PosixProcEnv.lhs
index cd757e7..659ea9e 100644 (file)
@@ -54,10 +54,15 @@ import GlaExts
 import PrelArr (ByteArray(..)) -- see internals
 import PrelIOBase
 import IO
+import Addr    ( nullAddr )
 
 import PosixErr
 import PosixUtil
+import CString   ( strcpy, allocWords, freeze, allocChars )
 
+\end{code}
+
+\begin{code}
 getProcessID :: IO ProcessID
 getProcessID = _ccall_ getpid
 
@@ -76,7 +81,7 @@ setUserID uid = nonzero_error (_ccall_ setuid uid) "setUserID"
 getLoginName :: IO String
 getLoginName =  do
     str <- _ccall_ getlogin
-    if str == ``NULL''
+    if str == nullAddr
        then syserr "getLoginName"
        else strcpy str
 
@@ -94,41 +99,49 @@ setGroupID gid = nonzero_error (_ccall_ setgid gid) "setGroupID"
 #if !defined(cygwin32_TARGET_OS)
 getGroups :: IO [GroupID]
 getGroups = do
-    ngroups <- _ccall_ getgroups 0 (``NULL''::Addr)
+    ngroups <- _ccall_ getgroups (0::Int) nullAddr
     words   <- allocWords ngroups
     ngroups <- _casm_ ``%r = getgroups(%0,(gid_t *)%1);'' ngroups words
-    if ngroups /= -1
+    if ngroups /= ((-1)::Int)
        then do
         arr <- freeze words
          return (map (extract arr) [0..(ngroups-1)])
        else
         syserr "getGroups"
   where
-    extract (ByteArray _ barr#) (I# n#) =
+    extract (ByteArray _ _ barr#) (I# n#) =
         case indexIntArray# barr# n# of
          r# -> (I# r#)
 #endif
 
 getEffectiveUserName :: IO String
 getEffectiveUserName = do
-    str <- _ccall_ cuserid (``NULL''::Addr)
-    if str == ``NULL''
+ {- cuserid() is deprecated, using getpwuid() instead. -}
+    euid <- getEffectiveUserID
+    ptr  <- _ccall_ getpwuid euid
+    str  <- _casm_ ``%r = ((struct passwd *)%0)->pw_name;'' (ptr::Addr)
+    strcpy str   
+
+{- OLD:
+    str <- _ccall_ cuserid nullAddr
+    if str == nullAddr
        then syserr "getEffectiveUserName"
        else strcpy str
+-}
 
 getProcessGroupID :: IO ProcessGroupID
 getProcessGroupID = _ccall_ getpgrp
 
 createProcessGroup :: ProcessID -> IO ProcessGroupID
 createProcessGroup pid = do
-    pgid <- _ccall_ setpgid pid 0
-    if pgid == 0
+    pgid <- _ccall_ setpgid pid (0::Int)
+    if pgid == (0::Int)
        then return pgid
        else syserr "createProcessGroup"
 
 joinProcessGroup :: ProcessGroupID -> IO ()
 joinProcessGroup pgid =
-    nonzero_error (_ccall_ setpgid 0 pgid) "joinProcessGroupID"
+    nonzero_error (_ccall_ setpgid (0::Int) pgid) "joinProcessGroupID"
 
 setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
 setProcessGroupID pid pgid =
@@ -137,11 +150,11 @@ setProcessGroupID pid pgid =
 createSession :: IO ProcessGroupID
 createSession = do
     pgid <- _ccall_ setsid
-    if pgid /= -1
+    if pgid /= ((-1)::Int)
        then return pgid
        else syserr "createSession"
 
-type SystemID = ByteArray ()
+type SystemID = ByteArray Int
 
 systemName :: SystemID -> String
 systemName sid =  unsafePerformIO $ do
@@ -172,20 +185,20 @@ getSystemID :: IO SystemID
 getSystemID = do
     bytes <- allocChars (``sizeof(struct utsname)''::Int)
     rc    <- _casm_ ``%r = uname((struct utsname *)%0);'' bytes
-    if rc /= -1
+    if rc /= ((-1)::Int)
        then freeze bytes
        else syserr "getSystemID"
 
 epochTime :: IO EpochTime
 epochTime = do
-    secs <- _ccall_ time (``NULL''::Addr)
-    if secs /= -1
+    secs <- _ccall_ time nullAddr
+    if secs /= ((-1)::Int)
        then return secs
        else syserr "epochTime"
 
 -- All times in clock ticks (see getClockTick)
 
-type ProcessTimes = (ClockTick, ByteArray ())
+type ProcessTimes = (ClockTick, ByteArray Int)
 
 elapsedTime :: ProcessTimes -> ClockTick
 elapsedTime (realtime, _) = realtime
@@ -210,7 +223,7 @@ getProcessTimes :: IO ProcessTimes
 getProcessTimes = do
     bytes <- allocChars (``sizeof(struct tms)''::Int)
     elapsed <- _casm_ ``%r = times((struct tms *)%0);'' bytes
-    if elapsed /= -1
+    if elapsed /= ((-1)::Int)
        then do
            times <- freeze bytes
            return (elapsed, times)
@@ -220,30 +233,30 @@ getProcessTimes = do
 #if !defined(cygwin32_TARGET_OS)
 getControllingTerminalName :: IO FilePath
 getControllingTerminalName = do
-    str <- _ccall_ ctermid (``NULL''::Addr)
-    if str == ``NULL''
-       then fail (IOError Nothing NoSuchThing "getControllingTerminalName: no controlling terminal")
+    str <- _ccall_ ctermid nullAddr
+    if str == nullAddr
+       then ioError (IOError Nothing NoSuchThing "getControllingTerminalName" "no controlling terminal")
        else strcpy str
 #endif
 
 getTerminalName :: Fd -> IO FilePath
 getTerminalName fd = do
     str <- _ccall_ ttyname fd
-    if str == ``NULL''
+    if str == nullAddr
        then do
         err <- try (queryTerminal fd)
-        either (\err -> syserr "getTerminalName")
-               (\succ -> if succ then fail (IOError Nothing NoSuchThing
-                                           "getTerminalName: no name")
-                         else fail (IOError Nothing InappropriateType
-                                           "getTerminalName: not a terminal"))
+        either (\ _err -> syserr "getTerminalName")
+               (\ succ -> if succ then ioError (IOError Nothing NoSuchThing
+                                               "getTerminalName" "no name")
+                          else ioError (IOError Nothing InappropriateType
+                                               "getTerminalName" "not a terminal"))
            err
        else strcpy str
 
 queryTerminal :: Fd -> IO Bool
 queryTerminal (FD# fd) = do
     rc <- _ccall_ isatty fd
-    case rc of
+    case (rc::Int) of
       -1 -> syserr "queryTerminal"
       0  -> return False
       1  -> return True
@@ -273,9 +286,10 @@ getSysVar v =
 sysconf :: Int -> IO Limit
 sysconf n = do
  rc <- _ccall_ sysconf n
- if rc /= -1
+ if rc /= (-1::Int)
     then return rc
-    else fail (IOError Nothing NoSuchThing
-                      "getSysVar: no such system limit or option")
+    else ioError (IOError Nothing NoSuchThing
+                         "getSysVar" 
+                         "no such system limit or option")
 
 \end{code}