{-# LINE 1 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE InterruptibleFFI, RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
module System.Posix.Process.Common (
    
    
    forkProcess,
    forkProcessWithUnmask,
    
    exitImmediately,
    
    getProcessID,
    getParentProcessID,
    
    getProcessGroupID,
    getProcessGroupIDOf,
    createProcessGroupFor,
    joinProcessGroup,
    setProcessGroupIDOf,
    
    createSession,
    
    ProcessTimes(..),
    getProcessTimes,
    
    nice,
    getProcessPriority,
    getProcessGroupPriority,
    getUserPriority,
    setProcessPriority,
    setProcessGroupPriority,
    setUserPriority,
    
    ProcessStatus(..),
    getProcessStatus,
    getAnyProcessStatus,
    getGroupProcessStatus,
    
    createProcessGroup,
    setProcessGroupID,
 ) where
import Foreign.C.Error
import Foreign.C.Types
import Foreign.Marshal.Alloc ( alloca, allocaBytes )
import Foreign.Ptr ( Ptr )
import Foreign.StablePtr ( StablePtr, newStablePtr, freeStablePtr )
import Foreign.Storable ( Storable(..) )
import System.Exit
import System.Posix.Process.Internals
import System.Posix.Types
import Control.Monad
import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) 
import GHC.TopHandler   ( runIO )
import GHC.IO ( unsafeUnmask, uninterruptibleMask_ )
getProcessID :: IO ProcessID
getProcessID :: IO CPid
getProcessID = IO CPid
c_getpid
foreign import ccall unsafe "getpid"
   c_getpid :: IO CPid
getParentProcessID :: IO ProcessID
getParentProcessID :: IO CPid
getParentProcessID = IO CPid
c_getppid
foreign import ccall unsafe "getppid"
  c_getppid :: IO CPid
getProcessGroupID :: IO ProcessGroupID
getProcessGroupID :: IO CPid
getProcessGroupID = IO CPid
c_getpgrp
foreign import ccall unsafe "getpgrp"
  c_getpgrp :: IO CPid
getProcessGroupIDOf :: ProcessID -> IO ProcessGroupID
getProcessGroupIDOf :: CPid -> IO CPid
getProcessGroupIDOf CPid
pid =
  String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getProcessGroupIDOf" (CPid -> IO CPid
c_getpgid CPid
pid)
foreign import ccall unsafe "getpgid"
  c_getpgid :: CPid -> IO CPid
createProcessGroupFor :: ProcessID -> IO ProcessGroupID
createProcessGroupFor :: CPid -> IO CPid
createProcessGroupFor CPid
pid = do
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"createProcessGroupFor" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
0)
  CPid -> IO CPid
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CPid
pid
joinProcessGroup :: ProcessGroupID -> IO ()
joinProcessGroup :: CPid -> IO ()
joinProcessGroup CPid
pgid =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"joinProcessGroup" (CPid -> CPid -> IO CInt
c_setpgid CPid
0 CPid
pgid)
setProcessGroupIDOf :: ProcessID -> ProcessGroupID -> IO ()
setProcessGroupIDOf :: CPid -> CPid -> IO ()
setProcessGroupIDOf CPid
pid CPid
pgid =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessGroupIDOf" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
pgid)
foreign import ccall unsafe "setpgid"
  c_setpgid :: CPid -> CPid -> IO CInt
createSession :: IO ProcessGroupID
createSession :: IO CPid
createSession = String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"createSession" IO CPid
c_setsid
foreign import ccall unsafe "setsid"
  c_setsid :: IO CPid
data ProcessTimes
  = ProcessTimes { ProcessTimes -> CClock
elapsedTime     :: ClockTick
                 , ProcessTimes -> CClock
userTime        :: ClockTick
                 , ProcessTimes -> CClock
systemTime      :: ClockTick
                 , ProcessTimes -> CClock
childUserTime   :: ClockTick
                 , ProcessTimes -> CClock
childSystemTime :: ClockTick
                 }
getProcessTimes :: IO ProcessTimes
getProcessTimes :: IO ProcessTimes
getProcessTimes = do
   Int -> (Ptr CTms -> IO ProcessTimes) -> IO ProcessTimes
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
32) ((Ptr CTms -> IO ProcessTimes) -> IO ProcessTimes)
-> (Ptr CTms -> IO ProcessTimes) -> IO ProcessTimes
forall a b. (a -> b) -> a -> b
$ \Ptr CTms
p_tms -> do
{-# LINE 194 "libraries/unix/System/Posix/Process/Common.hsc" #-}
     elapsed <- throwErrnoIfMinus1 "getProcessTimes" (c_times p_tms)
     ut  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))  p_tms
{-# LINE 196 "libraries/unix/System/Posix/Process/Common.hsc" #-}
     st  <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))  p_tms
{-# LINE 197 "libraries/unix/System/Posix/Process/Common.hsc" #-}
     cut <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p_tms
{-# LINE 198 "libraries/unix/System/Posix/Process/Common.hsc" #-}
     cst <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p_tms
{-# LINE 199 "libraries/unix/System/Posix/Process/Common.hsc" #-}
     return (ProcessTimes{ elapsedTime     = elapsed,
                           userTime        = ut,
                           systemTime      = st,
                           childUserTime   = cut,
                           childSystemTime = cst
                          })
data {-# CTYPE "struct tms" #-} CTms
foreign import capi unsafe "HsUnix.h times"
  c_times :: Ptr CTms -> IO CClock
nice :: Int -> IO ()
nice :: Int -> IO ()
nice Int
prio = do
  IO ()
resetErrno
  CInt
res <- CInt -> IO CInt
c_nice (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prio)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Errno
err <- IO Errno
getErrno
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/= Errno
eOK) (String -> IO ()
forall a. String -> IO a
throwErrno String
"nice")
foreign import ccall unsafe "nice"
  c_nice :: CInt -> IO CInt
getProcessPriority      :: ProcessID      -> IO Int
getProcessGroupPriority :: ProcessGroupID -> IO Int
getUserPriority         :: UserID         -> IO Int
getProcessPriority :: CPid -> IO Int
getProcessPriority CPid
pid = do
  CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getProcessPriority" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
         CInt -> CInt -> IO CInt
c_getpriority (CInt
0) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid)
{-# LINE 232 "libraries/unix/System/Posix/Process/Common.hsc" #-}
  return (fromIntegral r)
getProcessGroupPriority :: CPid -> IO Int
getProcessGroupPriority CPid
pid = do
  CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getProcessPriority" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
         CInt -> CInt -> IO CInt
c_getpriority (CInt
1) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid)
{-# LINE 237 "libraries/unix/System/Posix/Process/Common.hsc" #-}
  return (fromIntegral r)
getUserPriority :: UserID -> IO Int
getUserPriority UserID
uid = do
  CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getUserPriority" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
         CInt -> CInt -> IO CInt
c_getpriority (CInt
2) (UserID -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UserID
uid)
{-# LINE 242 "libraries/unix/System/Posix/Process/Common.hsc" #-}
  return (fromIntegral r)
foreign import ccall unsafe "getpriority"
  c_getpriority :: CInt -> CInt -> IO CInt
setProcessPriority      :: ProcessID      -> Int -> IO ()
setProcessGroupPriority :: ProcessGroupID -> Int -> IO ()
setUserPriority         :: UserID         -> Int -> IO ()
setProcessPriority :: CPid -> Int -> IO ()
setProcessPriority CPid
pid Int
val =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessPriority" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    CInt -> CInt -> CInt -> IO CInt
c_setpriority (CInt
0) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val)
{-# LINE 254 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setProcessGroupPriority :: CPid -> Int -> IO ()
setProcessGroupPriority CPid
pid Int
val =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessPriority" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    CInt -> CInt -> CInt -> IO CInt
c_setpriority (CInt
1) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val)
{-# LINE 258 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setUserPriority :: UserID -> Int -> IO ()
setUserPriority UserID
uid Int
val =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setUserPriority" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    CInt -> CInt -> CInt -> IO CInt
c_setpriority (CInt
2) (UserID -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UserID
uid) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val)
{-# LINE 262 "libraries/unix/System/Posix/Process/Common.hsc" #-}
foreign import ccall unsafe "setpriority"
  c_setpriority :: CInt -> CInt -> CInt -> IO CInt
forkProcess :: IO () -> IO ProcessID
forkProcess :: IO () -> IO CPid
forkProcess IO ()
action = do
  
  
  
  MaskingState
mstate <- IO MaskingState
getMaskingState
  let action' :: IO ()
action' = case MaskingState
mstate of
          MaskingState
Unmasked              -> IO () -> IO ()
forall a. IO a -> IO a
unsafeUnmask IO ()
action
          MaskingState
MaskedInterruptible   -> IO ()
action
          MaskingState
MaskedUninterruptible -> IO () -> IO ()
forall a. IO a -> IO a
uninterruptibleMask_ IO ()
action
  IO (StablePtr (IO ()))
-> (StablePtr (IO ()) -> IO ())
-> (StablePtr (IO ()) -> IO CPid)
-> IO CPid
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (IO () -> IO (StablePtr (IO ()))
forall a. a -> IO (StablePtr a)
newStablePtr (IO () -> IO ()
forall a. IO a -> IO a
runIO IO ()
action'))
    StablePtr (IO ()) -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr
    (\StablePtr (IO ())
stable -> String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"forkProcess" (StablePtr (IO ()) -> IO CPid
forkProcessPrim StablePtr (IO ())
stable))
foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid
forkProcessWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ProcessID
forkProcessWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO CPid
forkProcessWithUnmask (forall a. IO a -> IO a) -> IO ()
action = IO () -> IO CPid
forkProcess ((forall a. IO a -> IO a) -> IO ()
action IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask)
getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus :: Bool -> Bool -> CPid -> IO (Maybe ProcessStatus)
getProcessStatus Bool
block Bool
stopped CPid
pid =
  (Ptr CInt -> IO (Maybe ProcessStatus)) -> IO (Maybe ProcessStatus)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe ProcessStatus))
 -> IO (Maybe ProcessStatus))
-> (Ptr CInt -> IO (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wstatp -> do
    CPid
pid' <- String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"getProcessStatus"
                (CPid -> Ptr CInt -> CInt -> IO CPid
c_waitpid CPid
pid Ptr CInt
wstatp (Bool -> Bool -> CInt
waitOptions Bool
block Bool
stopped))
    case CPid
pid' of
      CPid
0  -> Maybe ProcessStatus -> IO (Maybe ProcessStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessStatus
forall a. Maybe a
Nothing
      CPid
_  -> do ProcessStatus
ps <- Ptr CInt -> IO ProcessStatus
readWaitStatus Ptr CInt
wstatp
               Maybe ProcessStatus -> IO (Maybe ProcessStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessStatus -> Maybe ProcessStatus
forall a. a -> Maybe a
Just ProcessStatus
ps)
foreign import ccall interruptible "waitpid"
  c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
getGroupProcessStatus :: Bool
                      -> Bool
                      -> ProcessGroupID
                      -> IO (Maybe (ProcessID, ProcessStatus))
getGroupProcessStatus :: Bool -> Bool -> CPid -> IO (Maybe (CPid, ProcessStatus))
getGroupProcessStatus Bool
block Bool
stopped CPid
pgid =
  (Ptr CInt -> IO (Maybe (CPid, ProcessStatus)))
-> IO (Maybe (CPid, ProcessStatus))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (CPid, ProcessStatus)))
 -> IO (Maybe (CPid, ProcessStatus)))
-> (Ptr CInt -> IO (Maybe (CPid, ProcessStatus)))
-> IO (Maybe (CPid, ProcessStatus))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wstatp -> do
    CPid
pid <- String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"getGroupProcessStatus"
                (CPid -> Ptr CInt -> CInt -> IO CPid
c_waitpid (-CPid
pgid) Ptr CInt
wstatp (Bool -> Bool -> CInt
waitOptions Bool
block Bool
stopped))
    case CPid
pid of
      CPid
0  -> Maybe (CPid, ProcessStatus) -> IO (Maybe (CPid, ProcessStatus))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CPid, ProcessStatus)
forall a. Maybe a
Nothing
      CPid
_  -> do ProcessStatus
ps <- Ptr CInt -> IO ProcessStatus
readWaitStatus Ptr CInt
wstatp
               Maybe (CPid, ProcessStatus) -> IO (Maybe (CPid, ProcessStatus))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CPid, ProcessStatus) -> Maybe (CPid, ProcessStatus)
forall a. a -> Maybe a
Just (CPid
pid, ProcessStatus
ps))
getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (CPid, ProcessStatus))
getAnyProcessStatus Bool
block Bool
stopped = Bool -> Bool -> CPid -> IO (Maybe (CPid, ProcessStatus))
getGroupProcessStatus Bool
block Bool
stopped CPid
1
waitOptions :: Bool -> Bool -> CInt
waitOptions :: Bool -> Bool -> CInt
waitOptions Bool
False Bool
False = (CInt
1)
{-# LINE 370 "libraries/unix/System/Posix/Process/Common.hsc" #-}
waitOptions False True  = (3)
{-# LINE 371 "libraries/unix/System/Posix/Process/Common.hsc" #-}
waitOptions True  False = 0
waitOptions Bool
True  Bool
True  = (CInt
2)
{-# LINE 373 "libraries/unix/System/Posix/Process/Common.hsc" #-}
readWaitStatus :: Ptr CInt -> IO ProcessStatus
readWaitStatus :: Ptr CInt -> IO ProcessStatus
readWaitStatus Ptr CInt
wstatp = do
  CInt
wstat <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wstatp
  CInt -> IO ProcessStatus
decipherWaitStatus CInt
wstat
exitImmediately :: ExitCode -> IO ()
exitImmediately :: ExitCode -> IO ()
exitImmediately ExitCode
exitcode = CInt -> IO ()
c_exit (ExitCode -> CInt
forall {a}. Num a => ExitCode -> a
exitcode2Int ExitCode
exitcode)
  where
    exitcode2Int :: ExitCode -> a
exitcode2Int ExitCode
ExitSuccess = a
0
    exitcode2Int (ExitFailure Int
n) = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
foreign import ccall unsafe "exit"
  c_exit :: CInt -> IO ()
{-# 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." #-} 
createProcessGroup :: ProcessID -> IO ProcessGroupID
createProcessGroup :: CPid -> IO CPid
createProcessGroup CPid
pid = do
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"createProcessGroup" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
0)
  CPid -> IO CPid
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CPid
pid
{-# 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." #-} 
setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
setProcessGroupID :: CPid -> CPid -> IO ()
setProcessGroupID CPid
pid CPid
pgid =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessGroupID" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
pgid)