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 )
55 #if defined(mingw32_HOST_OS)
56 import Control.Monad ( when )
57 import System.Directory ( doesFileExist )
58 import Control.Exception ( catchJust, ioErrors )
59 import System.IO.Error ( isDoesNotExistError, doesNotExistErrorType,
61 import System.Environment ( getEnv )
62 import System.Directory.Internals ( parseSearchPath, joinFileName )
66 {-# CFILES cbits/execvpe.c #-}
69 #include "HsBaseConfig.h"
71 -- ----------------------------------------------------------------------------
74 {- | A handle to a process, which can be used to wait for termination
75 of the process using 'waitForProcess'.
77 None of the process-creation functions in this library wait for
78 termination: they all return a 'ProcessHandle' which may be used
79 to wait for the process later.
81 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
87 newtype ProcessHandle = ProcessHandle PHANDLE
89 -- ----------------------------------------------------------------------------
91 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
93 -- this function disables the itimer, which would otherwise cause confusing
94 -- signals to be sent to the new process.
95 foreign import ccall unsafe "pPrPr_disableITimers"
96 pPrPr_disableITimers :: IO ()
98 foreign import ccall unsafe "execvpe"
99 c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
103 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
105 #ifdef __GLASGOW_HASKELL__
106 -- -----------------------------------------------------------------------------
107 -- POSIX runProcess with signal handling in the child
111 -> FilePath -- ^ Filename of the executable
112 -> [String] -- ^ Arguments to pass to the executable
113 -> Maybe FilePath -- ^ Optional path to the working directory
114 -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)
115 -> Maybe Handle -- ^ Handle to use for @stdin@
116 -> Maybe Handle -- ^ Handle to use for @stdout@
117 -> Maybe Handle -- ^ Handle to use for @stderr@
118 -> Maybe CLong -- handler for SIGINT
119 -> Maybe CLong -- handler for SIGQUIT
122 runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
124 = withFilePathException cmd $
125 withHandle_ fun (fromMaybe stdin mb_stdin) $ \hndStdInput ->
126 withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
127 withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
128 maybeWith withCEnvironment mb_env $ \pEnv ->
129 maybeWith withCString mb_cwd $ \pWorkDir ->
130 withMany withCString (cmd:args) $ \cstrs ->
131 let (set_int, inthand)
134 Just hand -> (1, hand)
138 Just hand -> (1, hand)
140 withArray0 nullPtr cstrs $ \pargs -> do
141 ph <- throwErrnoIfMinus1 fun $
142 c_runProcess pargs pWorkDir pEnv
146 set_int inthand set_quit quithand
147 return (ProcessHandle ph)
149 foreign import ccall unsafe "runProcess"
151 :: Ptr CString -- args
152 -> CString -- working directory (or NULL)
153 -> Ptr CString -- env (or NULL)
157 -> CInt -- non-zero: set child's SIGINT handler
158 -> CLong -- SIGINT handler
159 -> CInt -- non-zero: set child's SIGQUIT handler
160 -> CLong -- SIGQUIT handler
163 #endif /* __GLASGOW_HASKELL__ */
165 ignoreSignal = CONST_SIG_IGN :: CLong
166 defaultSignal = CONST_SIG_DFL :: CLong
170 #ifdef __GLASGOW_HASKELL__
172 runProcessWin32 fun cmd args mb_cwd mb_env
173 mb_stdin mb_stdout mb_stderr extra_cmdline
174 = withFilePathException cmd $
175 withHandle_ fun (fromMaybe stdin mb_stdin) $ \hndStdInput ->
176 withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
177 withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
178 maybeWith withCEnvironment mb_env $ \pEnv -> do
179 maybeWith withCString mb_cwd $ \pWorkDir -> do
180 let cmdline = translate cmd ++
181 concat (map ((' ':) . translate) args) ++
182 (if null extra_cmdline then "" else ' ':extra_cmdline)
183 withCString cmdline $ \pcmdline -> do
184 proc_handle <- throwErrnoIfMinus1 fun
185 (c_runProcess pcmdline pWorkDir pEnv
189 return (ProcessHandle proc_handle)
191 foreign import ccall unsafe "runProcess"
201 -- ------------------------------------------------------------------------
202 -- Passing commands to the OS on Windows
205 On Windows this is tricky. We use CreateProcess, passing a single
206 command-line string (lpCommandLine) as its argument. (CreateProcess
207 is well documented on http://msdn.microsoft/com.)
209 - It parses the beginning of the string to find the command. If the
210 file name has embedded spaces, it must be quoted, using double
212 "foo\this that\cmd" arg1 arg2
214 - The invoked command can in turn access the entire lpCommandLine string,
215 and the C runtime does indeed do so, parsing it to generate the
216 traditional argument vector argv[0], argv[1], etc. It does this
217 using a complex and arcane set of rules which are described here:
219 http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
221 (if this URL stops working, you might be able to find it by
222 searching for "Parsing C Command-Line Arguments" on MSDN. Also,
223 the code in the Microsoft C runtime that does this translation
224 is shipped with VC++).
226 Our goal in runProcess is to take a command filename and list of
227 arguments, and construct a string which inverts the translatsions
228 described above, such that the program at the other end sees exactly
229 the same arguments in its argv[] that we passed to rawSystem.
231 This inverse translation is implemented by 'translate' below.
233 Here are some pages that give informations on Windows-related
234 limitations and deviations from Unix conventions:
236 http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
237 Command lines and environment variables effectively limited to 8191
238 characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
240 http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
241 Command-line substitution under Windows XP. IIRC these facilities (or at
242 least a large subset of them) are available on Win NT and 2000. Some
243 might be available on Win 9x.
245 http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
246 How CMD.EXE processes command lines.
249 Note: CreateProcess does have a separate argument (lpApplicationName)
250 with which you can specify the command, but we have to slap the
251 command into lpCommandLine anyway, so that argv[0] is what a C program
252 expects (namely the application name). So it seems simpler to just
253 use lpCommandLine alone, which CreateProcess supports.
256 -- Translate command-line arguments for passing to CreateProcess().
257 translate :: String -> String
258 translate str = '"' : snd (foldr escape (True,"\"") str)
259 where escape '"' (b, str) = (True, '\\' : '"' : str)
260 escape '\\' (True, str) = (True, '\\' : '\\' : str)
261 escape '\\' (False, str) = (False, '\\' : str)
262 escape c (b, str) = (False, c : str)
263 -- See long comment above for what this function is trying to do.
265 -- The Bool passed back along the string is True iff the
266 -- rest of the string is a sequence of backslashes followed by
269 #endif /* __GLASGOW_HASKELL__ */
273 -- ----------------------------------------------------------------------------
276 {- | Turns a shell command into a raw command. Usually this involves
277 wrapping it in an invocation of the shell.
279 There's a difference in the signature of commandToProcess between
280 the Windows and Unix versions. On Unix, exec takes a list of strings,
281 and we want to pass our command to /bin/sh as a single argument.
283 On Windows, CreateProcess takes a single string for the command,
284 which is later decomposed by cmd.exe. In this case, we just want
285 to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line. The
286 command-line translation that we normally do for arguments on
287 Windows isn't required (or desirable) here.
290 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
294 -> IO (FilePath,[String])
295 commandToProcess string = return ("/bin/sh", ["-c", string])
301 -> IO (FilePath,String)
302 commandToProcess string = do
303 cmd <- findCommandInterpreter
304 return (cmd, "/c "++string)
305 -- We don't want to put the cmd into a single
306 -- argument, because cmd.exe will not try to split it up. Instead,
307 -- we just tack the command on the end of the cmd.exe command line,
308 -- which partly works. There seem to be some quoting issues, but
309 -- I don't have the energy to find+fix them right now (ToDo). --SDM
310 -- (later) Now I don't know what the above comment means. sigh.
312 -- Find CMD.EXE (or COMMAND.COM on Win98). We use the same algorithm as
313 -- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation).
314 findCommandInterpreter :: IO FilePath
315 findCommandInterpreter = do
317 catchJust ioErrors (getEnv "COMSPEC") $ \e -> do
318 when (not (isDoesNotExistError e)) $ ioError e
320 -- try to find CMD.EXE or COMMAND.COM
322 let filename | osver .&. 0x8000 /= 0 = "command.com"
323 | otherwise = "cmd.exe"
324 path <- getEnv "PATH"
326 -- use our own version of System.Directory.findExecutable, because
327 -- that assumes the .exe suffix.
328 search :: [FilePath] -> IO (Maybe FilePath)
329 search [] = return Nothing
331 let path = d `joinFileName` filename
332 b <- doesFileExist path
333 if b then return (Just path)
336 mb_path <- search (parseSearchPath path)
339 Nothing -> ioError (mkIOError doesNotExistErrorType
340 "findCommandInterpreter" Nothing Nothing)
341 Just cmd -> return cmd
344 foreign import stdcall unsafe "__hscore_get_osver"
345 c_get_osver :: IO CUInt
348 -- ----------------------------------------------------------------------------
351 withFilePathException :: FilePath -> IO a -> IO a
352 withFilePathException fpath act = handle mapEx act
354 mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))
357 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
358 withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a
359 withCEnvironment env act =
360 let env' = map (\(name, val) -> name ++ ('=':val)) env
361 in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
363 withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
364 withCEnvironment env act =
365 let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env
366 in withCString env' (act . castPtr)