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