1#if __GLASGOW_HASKELL__ >= 709
2{-# LANGUAGE Safe #-}
3#else
4{-# LANGUAGE Trustworthy #-}
5#endif
6-----------------------------------------------------------------------------
7-- |
8-- Module      :  System.Posix.Process
9-- Copyright   :  (c) The University of Glasgow 2002
10-- License     :  BSD-style (see the file libraries/base/LICENSE)
11--
12-- Maintainer  :  libraries@haskell.org
13-- Stability   :  provisional
14-- Portability :  non-portable (requires POSIX)
15--
16-- POSIX process support.  See also the System.Cmd and System.Process
17-- modules in the process package.
18--
19-----------------------------------------------------------------------------
20
21module System.Posix.Process (
22    -- * Processes
23
24    -- ** Forking and executing
25    forkProcess,
26    forkProcessWithUnmask,
27    executeFile,
28
29    -- ** Exiting
30    exitImmediately,
31
32    -- ** Process environment
33    getProcessID,
34    getParentProcessID,
35
36    -- ** Process groups
37    getProcessGroupID,
38    getProcessGroupIDOf,
39    createProcessGroupFor,
40    joinProcessGroup,
41    setProcessGroupIDOf,
42
43    -- ** Sessions
44    createSession,
45
46    -- ** Process times
47    ProcessTimes(..),
48    getProcessTimes,
49
50    -- ** Scheduling priority
51    nice,
52    getProcessPriority,
53    getProcessGroupPriority,
54    getUserPriority,
55    setProcessPriority,
56    setProcessGroupPriority,
57    setUserPriority,
58
59    -- ** Process status
60    ProcessStatus(..),
61    getProcessStatus,
62    getAnyProcessStatus,
63    getGroupProcessStatus,
64
65    -- ** Deprecated
66    createProcessGroup,
67    setProcessGroupID,
68
69 ) where
70
71#include "HsUnix.h"
72
73import Foreign
74import Foreign.C
75import System.Posix.Process.Internals
76import System.Posix.Process.Common
77import System.Posix.Internals ( withFilePath )
78
79-- | @'executeFile' cmd args env@ calls one of the
80--   @execv*@ family, depending on whether or not the current
81--   PATH is to be searched for the command, and whether or not an
82--   environment is provided to supersede the process's current
83--   environment.  The basename (leading directory names suppressed) of
84--   the command is passed to @execv*@ as @arg[0]@;
85--   the argument list passed to 'executeFile' therefore
86--   begins with @arg[1]@.
87executeFile :: FilePath                     -- ^ Command
88            -> Bool                         -- ^ Search PATH?
89            -> [String]                     -- ^ Arguments
90            -> Maybe [(String, String)]     -- ^ Environment
91            -> IO a
92executeFile path search args Nothing = do
93  withFilePath path $ \s ->
94    withMany withFilePath (path:args) $ \cstrs ->
95      withArray0 nullPtr cstrs $ \arr -> do
96        pPrPr_disableITimers
97        if search
98           then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr)
99           else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr)
100        return undefined -- never reached
101
102executeFile path search args (Just env) = do
103  withFilePath path $ \s ->
104    withMany withFilePath (path:args) $ \cstrs ->
105      withArray0 nullPtr cstrs $ \arg_arr ->
106    let env' = map (\ (name, val) -> name ++ ('=' : val)) env in
107    withMany withFilePath env' $ \cenv ->
108      withArray0 nullPtr cenv $ \env_arr -> do
109        pPrPr_disableITimers
110        if search
111           then throwErrnoPathIfMinus1_ "executeFile" path
112                   (c_execvpe s arg_arr env_arr)
113           else throwErrnoPathIfMinus1_ "executeFile" path
114                   (c_execve s arg_arr env_arr)
115        return undefined -- never reached
116
117foreign import ccall unsafe "execvp"
118  c_execvp :: CString -> Ptr CString -> IO CInt
119
120foreign import ccall unsafe "execv"
121  c_execv :: CString -> Ptr CString -> IO CInt
122
123foreign import ccall unsafe "execve"
124  c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
125
126