%
% (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
%
\section[PosixProcEnv]{Haskell 1.3 POSIX Process Environment}

\begin{code}
{-# OPTIONS -#include "HsPosix.h" #-}

#include "config.h"

module PosixProcEnv (
    ProcessTimes(..),
    SysVar(..),
    SystemID(..),
    childSystemTime,
    childUserTime,
    createProcessGroup,
    createSession,
    elapsedTime,
    epochTime,
#if !defined(cygwin32_TARGET_OS)
    getControllingTerminalName,
#endif
    getEffectiveGroupID,
    getEffectiveUserID,
    getEffectiveUserName,
#if !defined(cygwin32_TARGET_OS)
    getGroups,
#endif
    getLoginName,
    getParentProcessID,
    getProcessGroupID,
    getProcessID,
    getProcessTimes,
    getRealGroupID,
    getRealUserID,
    getSysVar,
    getSystemID,
    getTerminalName,
    joinProcessGroup,

    queryTerminal,

    setGroupID,
    setProcessGroupID,
    setUserID,
    systemTime,
    userTime

    ) where

import GHC.IOBase

import GlaExts
import ByteArray 	(ByteArray(..)) -- see internals
import IO
import Addr	( Addr, nullAddr )

import PosixUtil
import CString   ( strcpy, allocWords, freeze, allocChars )

\end{code}

\begin{code}
getProcessID :: IO ProcessID
getProcessID = _ccall_ getpid

getParentProcessID :: IO ProcessID
getParentProcessID = _ccall_ getppid

getRealUserID :: IO UserID
getRealUserID = _ccall_ getuid

getEffectiveUserID :: IO UserID
getEffectiveUserID = _ccall_ geteuid

setUserID :: UserID -> IO ()
setUserID uid = nonzero_error (_ccall_ setuid uid) "setUserID"

getLoginName :: IO String
getLoginName =  do
    str <- _ccall_ getlogin
    if str == nullAddr
       then syserr "getLoginName"
       else strcpy str

getRealGroupID :: IO GroupID
getRealGroupID = _ccall_ getgid

getEffectiveGroupID :: IO GroupID
getEffectiveGroupID = _ccall_ getegid

setGroupID :: GroupID -> IO ()
setGroupID gid = nonzero_error (_ccall_ setgid gid) "setGroupID"

-- getgroups() is not supported in beta18 of
-- cygwin32
#if !defined(cygwin32_TARGET_OS)
getGroups :: IO [GroupID]
getGroups = do
    ngroups <- _ccall_ getgroups (0::Int) nullAddr
    words   <- allocWords ngroups
    ngroups <- _casm_ ``%r = getgroups(%0,(gid_t *)%1);'' ngroups words
    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#) =
        case indexIntArray# barr# n# of
	  r# -> (I# r#)
#endif

getEffectiveUserName :: IO String
getEffectiveUserName = do
 {- 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::Int)
    if pgid == (0::Int)
       then return pgid
       else syserr "createProcessGroup"

joinProcessGroup :: ProcessGroupID -> IO ()
joinProcessGroup pgid =
    nonzero_error (_ccall_ setpgid (0::Int) pgid) "joinProcessGroupID"

setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
setProcessGroupID pid pgid =
    nonzero_error (_ccall_ setpgid pid pgid) "setProcessGroupID"

createSession :: IO ProcessGroupID
createSession = do
    pgid <- _ccall_ setsid
    if pgid /= ((-1)::Int)
       then return pgid
       else syserr "createSession"

data SystemID =
  SystemID { systemName :: String
  	   , nodeName   :: String
	   , release    :: String
	   , version    :: String
	   , machine    :: String
	   }

getSystemID :: IO SystemID
getSystemID = do
    sid   <- allocChars (``sizeof(struct utsname)''::Int)
    rc    <- _casm_ ``%r = uname((struct utsname *)%0);'' sid
    if rc == ((-1)::Int)
       then syserr "getSystemID"
       else do
	sysN <- _casm_ ``%r = ((struct utsname *)%0)->sysname;''  sid >>= strcpy
        node <- _casm_ ``%r = ((struct utsname *)%0)->nodename;'' sid >>= strcpy
        rel  <- _casm_ ``%r = ((struct utsname *)%0)->release;'' sid  >>= strcpy
        ver  <- _casm_ ``%r = ((struct utsname *)%0)->version;'' sid  >>= strcpy
        mach <- _casm_ ``%r = ((struct utsname *)%0)->machine;'' sid  >>= strcpy
	return (SystemID{ systemName = sysN
			, nodeName   = node
			, release    = rel
			, version    = ver
			, machine    = mach
			})
	
	
epochTime :: IO EpochTime
epochTime = do
    secs <- _ccall_ time nullAddr
    if secs /= ((-1)::Int)
       then return secs
       else syserr "epochTime"

-- All times in clock ticks (see getClockTick)

data ProcessTimes
  = ProcessTimes { elapsedTime     :: ClockTick
  		 , userTime        :: ClockTick
		 , systemTime      :: ClockTick
		 , childUserTime   :: ClockTick
		 , childSystemTime :: ClockTick
		 }

getProcessTimes :: IO ProcessTimes
getProcessTimes = do
    times <- allocChars (``sizeof(struct tms)''::Int)
    elapsed <- _casm_ ``%r = times((struct tms *)%0);'' times
    if elapsed == ((-1)::Int)
       then syserr "getProcessTimes"
       else do
         ut  <- _casm_ ``%r = ((struct tms *)%0)->tms_utime;'' times
         st  <- _casm_ ``%r = ((struct tms *)%0)->tms_stime;'' times
         cut <- _casm_ ``%r = ((struct tms *)%0)->tms_cutime;'' times
         cst <- _casm_ ``%r = ((struct tms *)%0)->tms_cstime;'' times
	 return (ProcessTimes{ elapsedTime     = elapsed
	 		     , userTime        = ut
	 		     , systemTime      = st
	 		     , childUserTime   = cut
	 		     , childSystemTime = cst
			     })

#if !defined(cygwin32_TARGET_OS)
getControllingTerminalName :: IO FilePath
getControllingTerminalName = do
    str <- _ccall_ ctermid nullAddr
    if str == nullAddr
       then ioException (IOError Nothing NoSuchThing
	   "getControllingTerminalName" "no controlling terminal" Nothing)
       else strcpy str
#endif

getTerminalName :: Fd -> IO FilePath
getTerminalName fd = do
    str <- _ccall_ ttyname fd
    if str == nullAddr
       then do
        err <- try (queryTerminal fd)
        either (\ _err -> syserr "getTerminalName")
               (\ succ -> if succ then ioException (IOError Nothing NoSuchThing
				"getTerminalName" "no name" Nothing)
                          else ioException (IOError Nothing InappropriateType
				"getTerminalName" "not a terminal" Nothing))
           err
       else strcpy str

queryTerminal :: Fd -> IO Bool
queryTerminal fd = do
    rc <- _ccall_ isatty fd
    case (rc::Int) of
      -1 -> syserr "queryTerminal"
      0  -> return False
      1  -> return True

data SysVar = ArgumentLimit
            | ChildLimit
            | ClockTick
            | GroupLimit
            | OpenFileLimit
            | PosixVersion
            | HasSavedIDs
            | HasJobControl

getSysVar :: SysVar -> IO Limit
getSysVar v =
    case v of
      ArgumentLimit -> sysconf ``_SC_ARG_MAX''
      ChildLimit    -> sysconf ``_SC_CHILD_MAX''
      ClockTick	    -> sysconf ``_SC_CLK_TCK''
      GroupLimit    -> sysconf ``_SC_NGROUPS_MAX''
      OpenFileLimit -> sysconf ``_SC_OPEN_MAX''
      PosixVersion  -> sysconf ``_SC_VERSION''
      HasSavedIDs   -> sysconf ``_SC_SAVED_IDS''
      HasJobControl -> sysconf ``_SC_JOB_CONTROL''
--  where

sysconf :: Int -> IO Limit
sysconf n = do
 rc <- _ccall_ sysconf n
 if rc /= (-1::Int)
    then return rc
    else ioException (IOError Nothing NoSuchThing
		          "getSysVar" 
		          "no such system limit or option"
			  Nothing)

\end{code}
