1 {-# OPTIONS_GHC -cpp -fffi #-}
2 -----------------------------------------------------------------------------
4 -- Module : System.Process.Internals
5 -- Copyright : (c) The University of Glasgow 2004
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
12 -- Operations for creating and interacting with sub-processes.
14 -----------------------------------------------------------------------------
17 module System.Process.Internals (
18 ProcessHandle(..), PHANDLE,
19 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
20 pPrPr_disableITimers, c_execvpe,
21 # ifdef __GLASGOW_HASKELL__
24 ignoreSignal, defaultSignal,
26 # ifdef __GLASGOW_HASKELL__
27 runProcessWin32, translate,
31 withFilePathException, withCEnvironment
34 import Prelude -- necessary to get dependencies right
36 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
37 import System.Posix.Types ( CPid )
38 import System.IO ( Handle )
40 import Data.Word ( Word32 )
43 import Data.Maybe ( fromMaybe )
44 # ifdef __GLASGOW_HASKELL__
45 import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) )
46 import GHC.Handle ( stdin, stdout, stderr, withHandle_ )
48 import Hugs.Exception ( Exception(..), IOException(..) )
51 import Control.Exception ( handle, throwIO )
56 {-# CFILES cbits/execvpe.c #-}
59 #include "HsBaseConfig.h"
61 -- ----------------------------------------------------------------------------
64 {- | A handle to a process, which can be used to wait for termination
65 of the process using 'waitForProcess'.
67 None of the process-creation functions in this library wait for
68 termination: they all return a 'ProcessHandle' which may be used
69 to wait for the process later.
71 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
77 newtype ProcessHandle = ProcessHandle PHANDLE
79 -- ----------------------------------------------------------------------------
81 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
83 -- this function disables the itimer, which would otherwise cause confusing
84 -- signals to be sent to the new process.
85 foreign import ccall unsafe "pPrPr_disableITimers"
86 pPrPr_disableITimers :: IO ()
88 foreign import ccall unsafe "execvpe"
89 c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
93 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
95 #ifdef __GLASGOW_HASKELL__
96 -- -----------------------------------------------------------------------------
97 -- POSIX runProcess with signal handling in the child
101 -> FilePath -- ^ Filename of the executable
102 -> [String] -- ^ Arguments to pass to the executable
103 -> Maybe FilePath -- ^ Optional path to the working directory
104 -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)
105 -> Maybe Handle -- ^ Handle to use for @stdin@
106 -> Maybe Handle -- ^ Handle to use for @stdout@
107 -> Maybe Handle -- ^ Handle to use for @stderr@
108 -> Maybe CLong -- handler for SIGINT
109 -> Maybe CLong -- handler for SIGQUIT
112 runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
114 = withFilePathException cmd $
115 withHandle_ fun (fromMaybe stdin mb_stdin) $ \hndStdInput ->
116 withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
117 withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
118 maybeWith withCEnvironment mb_env $ \pEnv ->
119 maybeWith withCString mb_cwd $ \pWorkDir ->
120 withMany withCString (cmd:args) $ \cstrs ->
121 let (set_int, inthand)
124 Just hand -> (1, hand)
128 Just hand -> (1, hand)
130 withArray0 nullPtr cstrs $ \pargs -> do
131 ph <- throwErrnoIfMinus1 fun $
132 c_runProcess pargs pWorkDir pEnv
136 set_int inthand set_quit quithand
137 return (ProcessHandle ph)
139 foreign import ccall unsafe "runProcess"
141 :: Ptr CString -- args
142 -> CString -- working directory (or NULL)
143 -> Ptr CString -- env (or NULL)
147 -> CInt -- non-zero: set child's SIGINT handler
148 -> CLong -- SIGINT handler
149 -> CInt -- non-zero: set child's SIGQUIT handler
150 -> CLong -- SIGQUIT handler
153 #endif /* __GLASGOW_HASKELL__ */
155 ignoreSignal = CONST_SIG_IGN :: CLong
156 defaultSignal = CONST_SIG_DFL :: CLong
160 #ifdef __GLASGOW_HASKELL__
162 runProcessWin32 fun cmd args mb_cwd mb_env
163 mb_stdin mb_stdout mb_stderr extra_cmdline
164 = withFilePathException cmd $
165 withHandle_ fun (fromMaybe stdin mb_stdin) $ \hndStdInput ->
166 withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
167 withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
168 maybeWith withCEnvironment mb_env $ \pEnv -> do
169 maybeWith withCString mb_cwd $ \pWorkDir -> do
170 let cmdline = translate cmd ++
171 concat (map ((' ':) . translate) args) ++
172 (if null extra_cmdline then "" else ' ':extra_cmdline)
173 withCString cmdline $ \pcmdline -> do
174 proc_handle <- throwErrnoIfMinus1 fun
175 (c_runProcess pcmdline pWorkDir pEnv
179 return (ProcessHandle proc_handle)
181 foreign import ccall unsafe "runProcess"
191 -- ------------------------------------------------------------------------
192 -- Passing commands to the OS on Windows
195 On Windows this is tricky. We use CreateProcess, passing a single
196 command-line string (lpCommandLine) as its argument. (CreateProcess
197 is well documented on http://msdn.microsoft/com.)
199 - It parses the beginning of the string to find the command. If the
200 file name has embedded spaces, it must be quoted, using double
202 "foo\this that\cmd" arg1 arg2
204 - The invoked command can in turn access the entire lpCommandLine string,
205 and the C runtime does indeed do so, parsing it to generate the
206 traditional argument vector argv[0], argv[1], etc. It does this
207 using a complex and arcane set of rules which are described here:
209 http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
211 (if this URL stops working, you might be able to find it by
212 searching for "Parsing C Command-Line Arguments" on MSDN. Also,
213 the code in the Microsoft C runtime that does this translation
214 is shipped with VC++).
216 Our goal in runProcess is to take a command filename and list of
217 arguments, and construct a string which inverts the translatsions
218 described above, such that the program at the other end sees exactly
219 the same arguments in its argv[] that we passed to rawSystem.
221 This inverse translation is implemented by 'translate' below.
223 Here are some pages that give informations on Windows-related
224 limitations and deviations from Unix conventions:
226 http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
227 Command lines and environment variables effectively limited to 8191
228 characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
230 http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
231 Command-line substitution under Windows XP. IIRC these facilities (or at
232 least a large subset of them) are available on Win NT and 2000. Some
233 might be available on Win 9x.
235 http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
236 How CMD.EXE processes command lines.
239 Note: CreateProcess does have a separate argument (lpApplicationName)
240 with which you can specify the command, but we have to slap the
241 command into lpCommandLine anyway, so that argv[0] is what a C program
242 expects (namely the application name). So it seems simpler to just
243 use lpCommandLine alone, which CreateProcess supports.
246 -- Translate command-line arguments for passing to CreateProcess().
247 translate :: String -> String
248 translate str = '"' : snd (foldr escape (True,"\"") str)
249 where escape '"' (b, str) = (True, '\\' : '"' : str)
250 escape '\\' (True, str) = (True, '\\' : '\\' : str)
251 escape '\\' (False, str) = (False, '\\' : str)
252 escape c (b, str) = (False, c : str)
253 -- See long comment above for what this function is trying to do.
255 -- The Bool passed back along the string is True iff the
256 -- rest of the string is a sequence of backslashes followed by
259 #endif /* __GLASGOW_HASKELL__ */
263 -- ----------------------------------------------------------------------------
266 {- | Turns a shell command into a raw command. Usually this involves
267 wrapping it in an invocation of the shell.
269 There's a difference in the signature of commandToProcess between
270 the Windows and Unix versions. On Unix, exec takes a list of strings,
271 and we want to pass our command to /bin/sh as a single argument.
273 On Windows, CreateProcess takes a single string for the command,
274 which is later decomposed by cmd.exe. In this case, we just want
275 to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line. The
276 command-line translation that we normally do for arguments on
277 Windows isn't required (or desirable) here.
280 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
284 -> IO (FilePath,[String])
285 commandToProcess string = return ("/bin/sh", ["-c", string])
291 -> IO (FilePath,String)
292 commandToProcess string = do
293 sysDir <- allocaBytes 1024 (\pdir -> c_getSystemDirectory pdir 1024 >> peekCString pdir)
294 return (sysDir ++ "\\CMD.EXE", "/c " ++ string)
295 -- We don't want to put the cmd into a single
296 -- argument, because cmd.exe will not try to split it up. Instead,
297 -- we just tack the command on the end of the cmd.exe command line,
298 -- which partly works. There seem to be some quoting issues, but
299 -- I don't have the energy to find+fix them right now (ToDo). --SDM
301 foreign import stdcall unsafe "GetSystemDirectoryA"
309 -- ----------------------------------------------------------------------------
312 withFilePathException :: FilePath -> IO a -> IO a
313 withFilePathException fpath act = handle mapEx act
315 mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))
318 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
319 withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a
320 withCEnvironment env act =
321 let env' = map (\(name, val) -> name ++ ('=':val)) env
322 in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
324 withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
325 withCEnvironment env act =
326 let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env
327 in withCString env' (act . castPtr)