aboutsummaryrefslogtreecommitdiffhomepage
path: root/System/Posix/Process.hsc
diff options
context:
space:
mode:
Diffstat (limited to 'System/Posix/Process.hsc')
-rw-r--r--System/Posix/Process.hsc334
1 files changed, 3 insertions, 331 deletions
diff --git a/System/Posix/Process.hsc b/System/Posix/Process.hsc
index 57779ce..9b1d72f 100644
--- a/System/Posix/Process.hsc
+++ b/System/Posix/Process.hsc
@@ -70,23 +70,10 @@ module System.Posix.Process (
#include "HsUnix.h"
-import Foreign.C.Error
-import Foreign.C.String
-import Foreign.C.Types
-import Foreign.Marshal.Alloc ( alloca, allocaBytes )
-import Foreign.Marshal.Array ( withArray0 )
-import Foreign.Marshal.Utils ( withMany )
-import Foreign.Ptr ( Ptr, nullPtr )
-import Foreign.StablePtr ( StablePtr, newStablePtr, freeStablePtr )
-import Foreign.Storable ( Storable(..) )
-import System.Exit
+import Foreign
+import Foreign.C
import System.Posix.Process.Internals
-import System.Posix.Types
-import Control.Monad
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.TopHandler ( runIO )
-#endif
+import System.Posix.Process.Common
#if __GLASGOW_HASKELL__ > 611
import System.Posix.Internals ( withFilePath )
@@ -99,216 +86,6 @@ withFilePath = withCString
{-# CFILES cbits/HsUnix.c #-}
#endif
--- -----------------------------------------------------------------------------
--- Process environment
-
--- | 'getProcessID' calls @getpid@ to obtain the 'ProcessID' for
--- the current process.
-getProcessID :: IO ProcessID
-getProcessID = c_getpid
-
-foreign import ccall unsafe "getpid"
- c_getpid :: IO CPid
-
--- | 'getProcessID' calls @getppid@ to obtain the 'ProcessID' for
--- the parent of the current process.
-getParentProcessID :: IO ProcessID
-getParentProcessID = c_getppid
-
-foreign import ccall unsafe "getppid"
- c_getppid :: IO CPid
-
--- | 'getProcessGroupID' calls @getpgrp@ to obtain the
--- 'ProcessGroupID' for the current process.
-getProcessGroupID :: IO ProcessGroupID
-getProcessGroupID = c_getpgrp
-
-foreign import ccall unsafe "getpgrp"
- c_getpgrp :: IO CPid
-
--- | @'getProcessGroupIDOf' pid@ calls @getpgid@ to obtain the
--- 'ProcessGroupID' for process @pid@.
-getProcessGroupIDOf :: ProcessID -> IO ProcessGroupID
-getProcessGroupIDOf pid =
- throwErrnoIfMinus1 "getProcessGroupIDOf" (c_getpgid pid)
-
-foreign import ccall unsafe "getpgid"
- c_getpgid :: CPid -> IO CPid
-
-{-
- 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 -> IO ProcessGroupID
-createProcessGroupFor pid = do
- throwErrnoIfMinus1_ "createProcessGroupFor" (c_setpgid pid 0)
- return pid
-
--- | @'joinProcessGroup' pgid@ calls @setpgid@ to set the
--- 'ProcessGroupID' of the current process to @pgid@.
-joinProcessGroup :: ProcessGroupID -> IO ()
-joinProcessGroup pgid =
- throwErrnoIfMinus1_ "joinProcessGroup" (c_setpgid 0 pgid)
-
-{-
- 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 ()
-setProcessGroupIDOf pid pgid =
- throwErrnoIfMinus1_ "setProcessGroupIDOf" (c_setpgid pid pgid)
-
-foreign import ccall unsafe "setpgid"
- c_setpgid :: CPid -> CPid -> IO CInt
-
--- | 'createSession' calls @setsid@ to create a new session
--- with the current process as session leader.
-createSession :: IO ProcessGroupID
-createSession = throwErrnoIfMinus1 "createSession" c_setsid
-
-foreign import ccall unsafe "setsid"
- c_setsid :: IO CPid
-
--- -----------------------------------------------------------------------------
--- Process times
-
--- All times in clock ticks (see getClockTick)
-
-data ProcessTimes
- = 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 :: IO ProcessTimes
-getProcessTimes = do
- allocaBytes (#const sizeof(struct tms)) $ \p_tms -> do
- elapsed <- throwErrnoIfMinus1 "getProcessTimes" (c_times p_tms)
- ut <- (#peek struct tms, tms_utime) p_tms
- st <- (#peek struct tms, tms_stime) p_tms
- cut <- (#peek struct tms, tms_cutime) p_tms
- cst <- (#peek struct tms, tms_cstime) p_tms
- return (ProcessTimes{ elapsedTime = elapsed,
- userTime = ut,
- systemTime = st,
- childUserTime = cut,
- childSystemTime = cst
- })
-
-type CTms = ()
-
-foreign import ccall unsafe "__hsunix_times"
- c_times :: Ptr CTms -> IO CClock
-
--- -----------------------------------------------------------------------------
--- Process scheduling priority
-
-nice :: Int -> IO ()
-nice prio = do
- resetErrno
- res <- c_nice (fromIntegral prio)
- when (res == -1) $ do
- err <- getErrno
- when (err /= eOK) (throwErrno "nice")
-
-foreign import ccall unsafe "nice"
- c_nice :: CInt -> IO CInt
-
-getProcessPriority :: ProcessID -> IO Int
-getProcessGroupPriority :: ProcessGroupID -> IO Int
-getUserPriority :: UserID -> IO Int
-
-getProcessPriority pid = do
- r <- throwErrnoIfMinus1 "getProcessPriority" $
- c_getpriority (#const PRIO_PROCESS) (fromIntegral pid)
- return (fromIntegral r)
-
-getProcessGroupPriority pid = do
- r <- throwErrnoIfMinus1 "getProcessPriority" $
- c_getpriority (#const PRIO_PGRP) (fromIntegral pid)
- return (fromIntegral r)
-
-getUserPriority uid = do
- r <- throwErrnoIfMinus1 "getUserPriority" $
- c_getpriority (#const PRIO_USER) (fromIntegral uid)
- 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 pid val =
- throwErrnoIfMinus1_ "setProcessPriority" $
- c_setpriority (#const PRIO_PROCESS) (fromIntegral pid) (fromIntegral val)
-
-setProcessGroupPriority pid val =
- throwErrnoIfMinus1_ "setProcessPriority" $
- c_setpriority (#const PRIO_PGRP) (fromIntegral pid) (fromIntegral val)
-
-setUserPriority uid val =
- throwErrnoIfMinus1_ "setUserPriority" $
- c_setpriority (#const PRIO_USER) (fromIntegral uid) (fromIntegral val)
-
-foreign import ccall unsafe "setpriority"
- c_setpriority :: CInt -> CInt -> CInt -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Forking, execution
-
-#ifdef __GLASGOW_HASKELL__
-{- | '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.
-
-'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.
-
-GHC note: 'forkProcess' is not currently supported when using multiple
-processors (@+RTS -N@), although it is supported with @-threaded@ as
-long as only one processor is being used.
--}
-
-forkProcess :: IO () -> IO ProcessID
-forkProcess action = do
- stable <- newStablePtr (runIO action)
- pid <- throwErrnoIfMinus1 "forkProcess" (forkProcessPrim stable)
- freeStablePtr stable
- return pid
-
-foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid
-#endif /* __GLASGOW_HASKELL__ */
-
-- | @'executeFile' cmd args env@ calls one of the
-- @execv*@ family, depending on whether or not the current
-- PATH is to be searched for the command, and whether or not an
@@ -356,108 +133,3 @@ foreign import ccall unsafe "execv"
foreign import ccall unsafe "execve"
c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
--- -----------------------------------------------------------------------------
--- 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 (Maybe ProcessStatus)
-getProcessStatus block stopped pid =
- alloca $ \wstatp -> do
- pid' <- throwErrnoIfMinus1Retry "getProcessStatus"
- (c_waitpid pid wstatp (waitOptions block stopped))
- case pid' of
- 0 -> return Nothing
- _ -> do ps <- readWaitStatus wstatp
- return (Just ps)
-
--- safe, because this call might block
-foreign import ccall safe "waitpid"
- c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
-
--- | @'getGroupProcessStatus' blk stopped pgid@ calls @waitpid@,
--- returning @'Just' (pid, tc)@, the 'ProcessID' and
--- 'ProcessStatus' for any process in group @pgid@ if one 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.
-getGroupProcessStatus :: Bool
- -> Bool
- -> ProcessGroupID
- -> IO (Maybe (ProcessID, ProcessStatus))
-getGroupProcessStatus block stopped pgid =
- alloca $ \wstatp -> do
- pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus"
- (c_waitpid (-pgid) wstatp (waitOptions block stopped))
- case pid of
- 0 -> return Nothing
- _ -> do ps <- readWaitStatus wstatp
- return (Just (pid, ps))
--- | @'getAnyProcessStatus' blk stopped@ calls @waitpid@, returning
--- @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus' for any
--- child process if one 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.
-getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
-getAnyProcessStatus block stopped = getGroupProcessStatus block stopped 1
-
-waitOptions :: Bool -> Bool -> CInt
--- block stopped
-waitOptions False False = (#const WNOHANG)
-waitOptions False True = (#const (WNOHANG|WUNTRACED))
-waitOptions True False = 0
-waitOptions True True = (#const WUNTRACED)
-
--- Turn a (ptr to a) wait status into a ProcessStatus
-
-readWaitStatus :: Ptr CInt -> IO ProcessStatus
-readWaitStatus wstatp = do
- wstat <- peek wstatp
- decipherWaitStatus wstat
-
--- -----------------------------------------------------------------------------
--- Exiting
-
--- | @'exitImmediately' status@ calls @_exit@ to terminate the process
--- with the indicated exit @status@.
--- The operation never returns.
-exitImmediately :: ExitCode -> IO ()
-exitImmediately exitcode = c_exit (exitcode2Int exitcode)
- where
- exitcode2Int ExitSuccess = 0
- exitcode2Int (ExitFailure n) = fromIntegral n
-
-foreign import ccall unsafe "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." #-}
--- | @'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 -> IO ProcessGroupID
-createProcessGroup pid = do
- throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid pid 0)
- return 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' 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 ()
-setProcessGroupID pid pgid =
- throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid pid pgid)
-
--- -----------------------------------------------------------------------------