{-# LINE 1 "libraries/unix/System/Posix/Process/Common.hsc" #-}{-# LANGUAGE InterruptibleFFI, RankNTypes #-}{-# LINE 2 "libraries/unix/System/Posix/Process/Common.hsc" #-}{-# LINE 3 "libraries/unix/System/Posix/Process/Common.hsc" #-}{-# LANGUAGE Trustworthy #-}{-# LINE 5 "libraries/unix/System/Posix/Process/Common.hsc" #-}------------------------------------------------------------------------------- |-- Module : System.Posix.Process.Common-- Copyright : (c) The University of Glasgow 2002-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : provisional-- Portability : non-portable (requires POSIX)---- POSIX process support. See also the System.Cmd and System.Process-- modules in the process package.-------------------------------------------------------------------------------moduleSystem.Posix.Process.Common(-- * Processes-- ** Forking and executing{-# LINE 25 "libraries/unix/System/Posix/Process/Common.hsc" #-}forkProcess,forkProcessWithUnmask,{-# LINE 28 "libraries/unix/System/Posix/Process/Common.hsc" #-}-- ** ExitingexitImmediately,-- ** Process environmentgetProcessID,getParentProcessID,-- ** Process groupsgetProcessGroupID,getProcessGroupIDOf,createProcessGroupFor,joinProcessGroup,setProcessGroupIDOf,-- ** SessionscreateSession,-- ** Process timesProcessTimes(..),getProcessTimes,-- ** Scheduling prioritynice,getProcessPriority,getProcessGroupPriority,getUserPriority,setProcessPriority,setProcessGroupPriority,setUserPriority,-- ** Process statusProcessStatus(..),getProcessStatus,getAnyProcessStatus,getGroupProcessStatus,-- ** DeprecatedcreateProcessGroup,setProcessGroupID,)where{-# LINE 72 "libraries/unix/System/Posix/Process/Common.hsc" #-}importForeign.C.ErrorimportForeign.C.TypesimportForeign.Marshal.Alloc(alloca,allocaBytes)importForeign.Ptr(Ptr)importForeign.StablePtr(StablePtr,newStablePtr,freeStablePtr)importForeign.Storable(Storable(..))importSystem.ExitimportSystem.Posix.Process.InternalsimportSystem.Posix.TypesimportControl.Monad{-# LINE 85 "libraries/unix/System/Posix/Process/Common.hsc" #-}importControl.Exception.Base(bracket,getMaskingState,MaskingState(..))-- used by forkProcessimportGHC.TopHandler(runIO)importGHC.IO(unsafeUnmask,uninterruptibleMask_){-# LINE 89 "libraries/unix/System/Posix/Process/Common.hsc" #-}{-# LINE 93 "libraries/unix/System/Posix/Process/Common.hsc" #-}-- ------------------------------------------------------------------------------- Process environment-- | 'getProcessID' calls @getpid@ to obtain the 'ProcessID' for-- the current process.getProcessID::IOProcessIDgetProcessID=c_getpidforeignimportccallunsafe"getpid"c_getpid::IOCPid-- | 'getProcessID' calls @getppid@ to obtain the 'ProcessID' for-- the parent of the current process.getParentProcessID::IOProcessIDgetParentProcessID=c_getppidforeignimportccallunsafe"getppid"c_getppid::IOCPid-- | 'getProcessGroupID' calls @getpgrp@ to obtain the-- 'ProcessGroupID' for the current process.getProcessGroupID::IOProcessGroupIDgetProcessGroupID=c_getpgrpforeignimportccallunsafe"getpgrp"c_getpgrp::IOCPid-- | @'getProcessGroupIDOf' pid@ calls @getpgid@ to obtain the-- 'ProcessGroupID' for process @pid@.getProcessGroupIDOf::ProcessID->IOProcessGroupIDgetProcessGroupIDOfpid=throwErrnoIfMinus1"getProcessGroupIDOf"(c_getpgidpid)foreignimportccallunsafe"getpgid"c_getpgid::CPid->IOCPid{-
To be added in the future, after the deprecation period for the
existing createProcessGroup has elapsed:
-- | 'createProcessGroup' calls @setpgid(0,0)@ to make
-- the current process a new process group leader.
createProcessGroup :: IO ProcessGroupID
createProcessGroup = do
throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid 0 0)
pgid <- getProcessGroupID
return pgid
-}-- | @'createProcessGroupFor' pid@ calls @setpgid@ to make-- process @pid@ a new process group leader.createProcessGroupFor::ProcessID->IOProcessGroupIDcreateProcessGroupForpid=dothrowErrnoIfMinus1_"createProcessGroupFor"(c_setpgidpid0)returnpid-- | @'joinProcessGroup' pgid@ calls @setpgid@ to set the-- 'ProcessGroupID' of the current process to @pgid@.joinProcessGroup::ProcessGroupID->IO()joinProcessGrouppgid=throwErrnoIfMinus1_"joinProcessGroup"(c_setpgid0pgid){-
To be added in the future, after the deprecation period for the
existing setProcessGroupID has elapsed:
-- | @'setProcessGroupID' pgid@ calls @setpgid@ to set the
-- 'ProcessGroupID' of the current process to @pgid@.
setProcessGroupID :: ProcessGroupID -> IO ()
setProcessGroupID pgid =
throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid 0 pgid)
-}-- | @'setProcessGroupIDOf' pid pgid@ calls @setpgid@ to set the-- 'ProcessGroupIDOf' for process @pid@ to @pgid@.setProcessGroupIDOf::ProcessID->ProcessGroupID->IO()setProcessGroupIDOfpidpgid=throwErrnoIfMinus1_"setProcessGroupIDOf"(c_setpgidpidpgid)foreignimportccallunsafe"setpgid"c_setpgid::CPid->CPid->IOCInt-- | 'createSession' calls @setsid@ to create a new session-- with the current process as session leader.createSession::IOProcessGroupIDcreateSession=throwErrnoIfMinus1"createSession"c_setsidforeignimportccallunsafe"setsid"c_setsid::IOCPid-- ------------------------------------------------------------------------------- Process times-- All times in clock ticks (see getClockTick)dataProcessTimes=ProcessTimes{elapsedTime::ClockTick,userTime::ClockTick,systemTime::ClockTick,childUserTime::ClockTick,childSystemTime::ClockTick}-- | 'getProcessTimes' calls @times@ to obtain time-accounting-- information for the current process and its children.getProcessTimes::IOProcessTimesgetProcessTimes=doallocaBytes(32)$\p_tms->do{-# LINE 202 "libraries/unix/System/Posix/Process/Common.hsc" #-}elapsed<-throwErrnoIfMinus1"getProcessTimes"(c_timesp_tms)ut<-((\hsc_ptr->peekByteOffhsc_ptr0))p_tms{-# LINE 204 "libraries/unix/System/Posix/Process/Common.hsc" #-}st<-((\hsc_ptr->peekByteOffhsc_ptr8))p_tms{-# LINE 205 "libraries/unix/System/Posix/Process/Common.hsc" #-}cut<-((\hsc_ptr->peekByteOffhsc_ptr16))p_tms{-# LINE 206 "libraries/unix/System/Posix/Process/Common.hsc" #-}cst<-((\hsc_ptr->peekByteOffhsc_ptr24))p_tms{-# LINE 207 "libraries/unix/System/Posix/Process/Common.hsc" #-}return(ProcessTimes{elapsedTime=elapsed,userTime=ut,systemTime=st,childUserTime=cut,childSystemTime=cst})typeCTms=()foreignimportccallunsafe"__hsunix_times"c_times::PtrCTms->IOCClock-- ------------------------------------------------------------------------------- Process scheduling prioritynice::Int->IO()niceprio=doresetErrnores<-c_nice(fromIntegralprio)when(res==-1)$doerr<-getErrnowhen(err/=eOK)(throwErrno"nice")foreignimportccallunsafe"nice"c_nice::CInt->IOCIntgetProcessPriority::ProcessID->IOIntgetProcessGroupPriority::ProcessGroupID->IOIntgetUserPriority::UserID->IOIntgetProcessPrioritypid=dor<-throwErrnoIfMinus1"getProcessPriority"$c_getpriority(0)(fromIntegralpid){-# LINE 240 "libraries/unix/System/Posix/Process/Common.hsc" #-}return(fromIntegralr)getProcessGroupPrioritypid=dor<-throwErrnoIfMinus1"getProcessPriority"$c_getpriority(1)(fromIntegralpid){-# LINE 245 "libraries/unix/System/Posix/Process/Common.hsc" #-}return(fromIntegralr)getUserPriorityuid=dor<-throwErrnoIfMinus1"getUserPriority"$c_getpriority(2)(fromIntegraluid){-# LINE 250 "libraries/unix/System/Posix/Process/Common.hsc" #-}return(fromIntegralr)foreignimportccallunsafe"getpriority"c_getpriority::CInt->CInt->IOCIntsetProcessPriority::ProcessID->Int->IO()setProcessGroupPriority::ProcessGroupID->Int->IO()setUserPriority::UserID->Int->IO()setProcessPrioritypidval=throwErrnoIfMinus1_"setProcessPriority"$c_setpriority(0)(fromIntegralpid)(fromIntegralval){-# LINE 262 "libraries/unix/System/Posix/Process/Common.hsc" #-}setProcessGroupPrioritypidval=throwErrnoIfMinus1_"setProcessPriority"$c_setpriority(1)(fromIntegralpid)(fromIntegralval){-# LINE 266 "libraries/unix/System/Posix/Process/Common.hsc" #-}setUserPriorityuidval=throwErrnoIfMinus1_"setUserPriority"$c_setpriority(2)(fromIntegraluid)(fromIntegralval){-# LINE 270 "libraries/unix/System/Posix/Process/Common.hsc" #-}foreignimportccallunsafe"setpriority"c_setpriority::CInt->CInt->CInt->IOCInt-- ------------------------------------------------------------------------------- Forking, execution{-# LINE 278 "libraries/unix/System/Posix/Process/Common.hsc" #-}{- | 'forkProcess' corresponds to the POSIX @fork@ system call.
The 'IO' action passed as an argument is executed in the child process; no other
threads will be copied to the child process.
On success, 'forkProcess' returns the child's 'ProcessID' to the parent process;
in case of an error, an exception is thrown.
The exception masking state of the executed action is inherited
(c.f. 'forkIO'), see also 'forkProcessWithUnmask' (/since: 2.7.0.0/).
'forkProcess' comes with a giant warning: since any other running
threads are not copied into the child process, it's easy to go wrong:
e.g. by accessing some shared resource that was held by another thread
in the parent.
-}forkProcess::IO()->IOProcessIDforkProcessaction=do-- wrap action to re-establish caller's masking state, as-- 'forkProcessPrim' starts in 'MaskedInterruptible' state by-- default; see also #1048mstate<-getMaskingStateletaction'=casemstateofUnmasked->unsafeUnmaskactionMaskedInterruptible->actionMaskedUninterruptible->uninterruptibleMask_actionbracket(newStablePtr(runIOaction'))freeStablePtr(\stable->throwErrnoIfMinus1"forkProcess"(forkProcessPrimstable))foreignimportccall"forkProcess"forkProcessPrim::StablePtr(IO())->IOCPid-- | Variant of 'forkProcess' in the style of 'forkIOWithUnmask'.---- /Since: 2.7.0.0/forkProcessWithUnmask::((foralla.IOa->IOa)->IO())->IOProcessIDforkProcessWithUnmaskaction=forkProcess(actionunsafeUnmask){-# LINE 318 "libraries/unix/System/Posix/Process/Common.hsc" #-}-- ------------------------------------------------------------------------------- Waiting for process termination-- | @'getProcessStatus' blk stopped pid@ calls @waitpid@, returning-- @'Just' tc@, the 'ProcessStatus' for process @pid@ if it is-- available, 'Nothing' otherwise. If @blk@ is 'False', then-- @WNOHANG@ is set in the options for @waitpid@, otherwise not.-- If @stopped@ is 'True', then @WUNTRACED@ is set in the-- options for @waitpid@, otherwise not.getProcessStatus::Bool->Bool->ProcessID->IO(MaybeProcessStatus)getProcessStatusblockstoppedpid=alloca$\wstatp->dopid'<-throwErrnoIfMinus1Retry"getProcessStatus"(c_waitpidpidwstatp(waitOptionsblockstopped))casepid'of0->returnNothing_->dops<-readWaitStatuswstatpreturn(Justps)-- safe/interruptible, because this call might blockforeignimportccallinterruptible"waitpid"c_waitpid::CPid->PtrCInt->CInt->IOCPid-- | @'getGroupProcessStatus' blk stopped pgid@ calls @waitpid@,-- returning @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus'-- for any process in group @pgid@ if one is available, or 'Nothing'-- if there are child processes but none have exited. If there are-- no child processes, then 'getGroupProcessStatus' raises an-- 'isDoesNotExistError' exception.---- If @blk@ is 'False', then @WNOHANG@ is set in the options for-- @waitpid@, otherwise not. If @stopped@ is 'True', then-- @WUNTRACED@ is set in the options for @waitpid@, otherwise not.getGroupProcessStatus::Bool->Bool->ProcessGroupID->IO(Maybe(ProcessID,ProcessStatus))getGroupProcessStatusblockstoppedpgid=alloca$\wstatp->dopid<-throwErrnoIfMinus1Retry"getGroupProcessStatus"(c_waitpid(-pgid)wstatp(waitOptionsblockstopped))casepidof0->returnNothing_->dops<-readWaitStatuswstatpreturn(Just(pid,ps))-- | @'getAnyProcessStatus' blk stopped@ calls @waitpid@, returning-- @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus' for any-- child process if a child process has exited, or 'Nothing' if-- there are child processes but none have exited. If there are no-- child processes, then 'getAnyProcessStatus' raises an-- 'isDoesNotExistError' exception.---- If @blk@ is 'False', then @WNOHANG@ is set in the options for-- @waitpid@, otherwise not. If @stopped@ is 'True', then-- @WUNTRACED@ is set in the options for @waitpid@, otherwise not.getAnyProcessStatus::Bool->Bool->IO(Maybe(ProcessID,ProcessStatus))getAnyProcessStatusblockstopped=getGroupProcessStatusblockstopped1waitOptions::Bool->Bool->CInt-- block stoppedwaitOptionsFalseFalse=(1){-# LINE 381 "libraries/unix/System/Posix/Process/Common.hsc" #-}waitOptionsFalseTrue=(3){-# LINE 382 "libraries/unix/System/Posix/Process/Common.hsc" #-}waitOptionsTrueFalse=0waitOptionsTrueTrue=(2){-# LINE 384 "libraries/unix/System/Posix/Process/Common.hsc" #-}-- Turn a (ptr to a) wait status into a ProcessStatusreadWaitStatus::PtrCInt->IOProcessStatusreadWaitStatuswstatp=dowstat<-peekwstatpdecipherWaitStatuswstat-- ------------------------------------------------------------------------------- Exiting-- | @'exitImmediately' status@ calls @_exit@ to terminate the process-- with the indicated exit @status@.-- The operation never returns.exitImmediately::ExitCode->IO()exitImmediatelyexitcode=c_exit(exitcode2Intexitcode)whereexitcode2IntExitSuccess=0exitcode2Int(ExitFailuren)=fromIntegralnforeignimportccallunsafe"exit"c_exit::CInt->IO()-- ------------------------------------------------------------------------------- Deprecated or subject to change{-# DEPRECATED createProcessGroup "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'createProcessGroupFor' instead." #-}-- deprecated in 7.2-- | @'createProcessGroup' pid@ calls @setpgid@ to make-- process @pid@ a new process group leader.-- This function is currently deprecated,-- and might be changed to making the current-- process a new process group leader in future versions.createProcessGroup::ProcessID->IOProcessGroupIDcreateProcessGrouppid=dothrowErrnoIfMinus1_"createProcessGroup"(c_setpgidpid0)returnpid{-# DEPRECATED setProcessGroupID "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'setProcessGroupIDOf' instead." #-}-- deprecated in 7.2-- | @'setProcessGroupID' pid pgid@ calls @setpgid@ to set the-- 'ProcessGroupID' for process @pid@ to @pgid@.-- This function is currently deprecated,-- and might be changed to setting the 'ProcessGroupID'-- for the current process in future versions.setProcessGroupID::ProcessID->ProcessGroupID->IO()setProcessGroupIDpidpgid=throwErrnoIfMinus1_"setProcessGroupID"(c_setpgidpidpgid)-- -----------------------------------------------------------------------------