process 1.0.1.5 → 1.1.0.0
raw patch · 5 files changed
+793/−727 lines, 5 filesdep +Win32
Dependencies added: Win32
Files
- System/Process.hs +64/−25
- System/Process/Internals.hs +107/−95
- cbits/runProcess.c +538/−528
- include/runProcess.h +77/−75
- process.cabal +7/−4
System/Process.hs view
@@ -1,4 +1,8 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-}+#if __GLASGOW_HASKELL__ >= 701+-- not available prior to 7.1+{-# LANGUAGE InterruptibleFFI #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : System.Process@@ -49,12 +53,14 @@ #endif system, rawSystem,+ showCommandForUser, #ifndef __HUGS__ -- * Process completion waitForProcess, getProcessExitCode, terminateProcess,+ interruptProcessGroupOf, #endif ) where @@ -80,7 +86,10 @@ #else import GHC.IOBase ( ioException, IOErrorType(..) ) #endif-#if !defined(mingw32_HOST_OS)+#if defined(mingw32_HOST_OS)+import System.Win32.Process (getProcessId)+import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT)+#else import System.Posix.Signals #endif #endif@@ -167,7 +176,8 @@ std_in = Inherit, std_out = Inherit, std_err = Inherit,- close_fds = False}+ close_fds = False,+ create_group = False} -- | Construct a 'CreateProcess' record for passing to 'createProcess', -- representing a command to be passed to the shell.@@ -178,8 +188,9 @@ std_in = Inherit, std_out = Inherit, std_err = Inherit,- close_fds = False}- + close_fds = False,+ create_group = False}+ {- | This is the most general way to spawn an external process. The process can be a command line to be executed by a shell or a raw command@@ -309,7 +320,7 @@ -- (XXX but there's a small race window here during which another -- thread could close the handle or call waitForProcess) alloca $ \pret -> do- throwErrnoIfMinus1_ "waitForProcess" (c_waitForProcess h pret)+ throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret) withProcessHandle ph $ \p_' -> case p_' of ClosedHandle e -> return (p_',e)@@ -492,31 +503,23 @@ rawSystem :: String -> [String] -> IO ExitCode #ifdef __GLASGOW_HASKELL__ rawSystem cmd args = syncProcess "rawSystem" (proc cmd args)- #elif !mingw32_HOST_OS -- crude fallback implementation: could do much better than this under Unix-rawSystem cmd args = system (unwords (map translate (cmd:args)))--translate :: String -> String-translate str = '\'' : foldr escape "'" str- where escape '\'' = showString "'\\''"- escape c = showChar c+rawSystem cmd args = system (showCommandForUser cmd args) #else /* mingw32_HOST_OS && ! __GLASGOW_HASKELL__ */ # if __HUGS__-rawSystem cmd args = system (unwords (cmd : map translate args))+rawSystem cmd args = system (cmd ++ showCommandForUser "" args) # else-rawSystem cmd args = system (unwords (map translate (cmd:args)))+rawSystem cmd args = system (showCommandForUser cmd args) #endif---- copied from System.Process (qv)-translate :: String -> String-translate str = '"' : snd (foldr escape (True,"\"") str)- where escape '"' (b, str) = (True, '\\' : '"' : str)- escape '\\' (True, str) = (True, '\\' : '\\' : str)- escape '\\' (False, str) = (False, '\\' : str)- escape c (b, str) = (False, c : str) #endif +-- | Given a program @p@ and arguments @args@,+-- @showCommandForUser p args@ returns a string suitable for pasting+-- into sh (on POSIX OSs) or cmd.exe (on Windows).+showCommandForUser :: FilePath -> [String] -> String+showCommandForUser cmd args = unwords (map translate (cmd : args))+ #ifndef __HUGS__ -- ---------------------------------------------------------------------------- -- terminateProcess@@ -542,12 +545,43 @@ case p_ of ClosedHandle _ -> return p_ OpenHandle h -> do- throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h+ throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h return p_ -- does not close the handle, we might want to try terminating it -- again, or get its exit code. -- ----------------------------------------------------------------------------+-- interruptProcessGroupOf++-- | Sends an interrupt signal to the process group of the given process.+--+-- On Unix systems, it sends the group the SIGINT signal.+--+-- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for+-- processes created using 'createProcess' and setting the 'create_group' flag++interruptProcessGroupOf+ :: ProcessHandle -- ^ Lead process in the process group+ -> IO ()+interruptProcessGroupOf ph = do+#if mingw32_HOST_OS+ withProcessHandle_ ph $ \p_ -> do+ case p_ of+ ClosedHandle _ -> return p_+ OpenHandle h -> do+ pid <- getProcessId h+ generateConsoleCtrlEvent cTRL_BREAK_EVENT pid+ return p_+#else+ withProcessHandle_ ph $ \p_ -> do+ case p_ of+ ClosedHandle _ -> return p_+ OpenHandle h -> do+ signalProcessGroup sigINT h+ return p_+#endif++-- ---------------------------------------------------------------------------- -- getProcessExitCode {- | @@ -562,7 +596,7 @@ ClosedHandle e -> return (p_, Just e) OpenHandle h -> alloca $ \pExitCode -> do- res <- throwErrnoIfMinus1 "getProcessExitCode" $+ res <- throwErrnoIfMinus1Retry "getProcessExitCode" $ c_getProcessExitCode h pExitCode code <- peek pExitCode if res == 0@@ -587,7 +621,12 @@ -> Ptr CInt -> IO CInt -foreign import ccall safe "waitForProcess" -- NB. safe - can block+#if __GLASGOW_HASKELL__ < 701+-- not available prior to 7.1+#define interruptible safe+#endif++foreign import ccall interruptible "waitForProcess" -- NB. safe - can block c_waitForProcess :: PHANDLE -> Ptr CInt
System/Process/Internals.hs view
@@ -31,13 +31,10 @@ #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) pPrPr_disableITimers, c_execvpe, ignoreSignal, defaultSignal,-#else-# ifdef __GLASGOW_HASKELL__- translate,-# endif #endif #endif withFilePathException, withCEnvironment,+ translate, #ifndef __HUGS__ fdToHandle,@@ -78,6 +75,7 @@ import Data.Typeable #if defined(mingw32_HOST_OS) import GHC.IO.IOMode+import System.Win32.DebugApi (PHANDLE) #endif #else import GHC.IOBase ( haFD, FD, IOException(..) )@@ -107,6 +105,7 @@ #endif #include "HsProcessConfig.h"+#include "processFlags.h" #ifndef __HUGS__ -- ----------------------------------------------------------------------------@@ -138,6 +137,9 @@ type PHANDLE = CPid +throwErrnoIfBadPHandle :: String -> IO PHANDLE -> IO PHANDLE +throwErrnoIfBadPHandle = throwErrnoIfMinus1+ mkProcessHandle :: PHANDLE -> IO ProcessHandle mkProcessHandle p = do m <- newMVar (OpenHandle p)@@ -148,7 +150,8 @@ #else -type PHANDLE = Word32+throwErrnoIfBadPHandle :: String -> IO PHANDLE -> IO PHANDLE +throwErrnoIfBadPHandle = throwErrnoIfNull -- On Windows, we have to close this HANDLE when it is no longer required, -- hence we add a finalizer to it, using an IORef as the box on which to@@ -179,13 +182,14 @@ -- ---------------------------------------------------------------------------- data CreateProcess = CreateProcess{- cmdspec :: CmdSpec, -- ^ Executable & arguments, or shell command- cwd :: Maybe FilePath, -- ^ Optional path to the working directory for the new process- env :: Maybe [(String,String)], -- ^ Optional environment (otherwise inherit from the current process)- std_in :: StdStream, -- ^ How to determine stdin- std_out :: StdStream, -- ^ How to determine stdout- std_err :: StdStream, -- ^ How to determine stderr- close_fds :: Bool -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit)+ cmdspec :: CmdSpec, -- ^ Executable & arguments, or shell command+ cwd :: Maybe FilePath, -- ^ Optional path to the working directory for the new process+ env :: Maybe [(String,String)], -- ^ Optional environment (otherwise inherit from the current process)+ std_in :: StdStream, -- ^ How to determine stdin+ std_out :: StdStream, -- ^ How to determine stdout+ std_err :: StdStream, -- ^ How to determine stderr+ close_fds :: Bool, -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit)+ create_group :: Bool -- ^ Create a new process group } data CmdSpec @@ -222,7 +226,8 @@ std_in = mb_stdin, std_out = mb_stdout, std_err = mb_stderr,- close_fds = mb_close_fds }+ close_fds = mb_close_fds,+ create_group = mb_create_group } mb_sigint mb_sigquit = do let (cmd,args) = commandToProcess cmdsp@@ -231,8 +236,8 @@ alloca $ \ pfdStdOutput -> alloca $ \ pfdStdError -> maybeWith withCEnvironment mb_env $ \pEnv ->- maybeWith withCString mb_cwd $ \pWorkDir ->- withMany withCString (cmd:args) $ \cstrs ->+ maybeWith withFilePath mb_cwd $ \pWorkDir ->+ withMany withFilePath (cmd:args) $ \cstrs -> withArray0 nullPtr cstrs $ \pargs -> do fdin <- mbFd fun fd_stdin mb_stdin@@ -258,7 +263,8 @@ fdin fdout fderr pfdStdInput pfdStdOutput pfdStdError set_int inthand set_quit quithand- (if mb_close_fds then 1 else 0)+ ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)+ .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)) hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode@@ -286,7 +292,7 @@ -> CLong -- SIGINT handler -> CInt -- non-zero: set child's SIGQUIT handler -> CLong -- SIGQUIT handler- -> CInt -- close_fds+ -> CInt -- flags -> IO PHANDLE #endif /* __GLASGOW_HASKELL__ */@@ -305,7 +311,8 @@ std_in = mb_stdin, std_out = mb_stdout, std_err = mb_stderr,- close_fds = mb_close_fds }+ close_fds = mb_close_fds,+ create_group = mb_create_group } _ignored_mb_sigint _ignored_mb_sigquit = do (cmd, cmdline) <- commandToProcess cmdsp@@ -332,11 +339,12 @@ -- the C code. Also the MVar will be cheaper when not running -- the threaded RTS. proc_handle <- withMVar runInteractiveProcess_lock $ \_ ->- throwErrnoIfMinus1 fun $+ throwErrnoIfBadPHandle fun $ c_runInteractiveProcess pcmdline pWorkDir pEnv fdin fdout fderr pfdStdInput pfdStdOutput pfdStdError- (if mb_close_fds then 1 else 0)+ ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)+ .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)) hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode@@ -349,92 +357,23 @@ runInteractiveProcess_lock :: MVar () runInteractiveProcess_lock = unsafePerformIO $ newMVar () -foreign import ccall unsafe "runInteractiveProcess" +foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: CWString -> CWString- -> Ptr ()+ -> Ptr CWString -> FD -> FD -> FD -> Ptr FD -> Ptr FD -> Ptr FD- -> CInt -- close_fds+ -> CInt -- flags -> IO PHANDLE---- --------------------------------------------------------------------------- Passing commands to the OS on Windows--{--On Windows this is tricky. We use CreateProcess, passing a single-command-line string (lpCommandLine) as its argument. (CreateProcess-is well documented on http://msdn.microsoft.com.)-- - It parses the beginning of the string to find the command. If the- file name has embedded spaces, it must be quoted, using double- quotes thus - "foo\this that\cmd" arg1 arg2-- - The invoked command can in turn access the entire lpCommandLine string,- and the C runtime does indeed do so, parsing it to generate the - traditional argument vector argv[0], argv[1], etc. It does this- using a complex and arcane set of rules which are described here:- - http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp-- (if this URL stops working, you might be able to find it by- searching for "Parsing C Command-Line Arguments" on MSDN. Also,- the code in the Microsoft C runtime that does this translation- is shipped with VC++).--Our goal in runProcess is to take a command filename and list of-arguments, and construct a string which inverts the translatsions-described above, such that the program at the other end sees exactly-the same arguments in its argv[] that we passed to rawSystem.--This inverse translation is implemented by 'translate' below.--Here are some pages that give informations on Windows-related -limitations and deviations from Unix conventions:-- http://support.microsoft.com/default.aspx?scid=kb;en-us;830473- Command lines and environment variables effectively limited to 8191 - characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):-- http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp- Command-line substitution under Windows XP. IIRC these facilities (or at - least a large subset of them) are available on Win NT and 2000. Some - might be available on Win 9x.-- http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp- How CMD.EXE processes command lines.---Note: CreateProcess does have a separate argument (lpApplicationName)-with which you can specify the command, but we have to slap the-command into lpCommandLine anyway, so that argv[0] is what a C program-expects (namely the application name). So it seems simpler to just-use lpCommandLine alone, which CreateProcess supports.--}---- Translate command-line arguments for passing to CreateProcess().-translate :: String -> String-translate str = '"' : snd (foldr escape (True,"\"") str)- where escape '"' (b, str) = (True, '\\' : '"' : str)- escape '\\' (True, str) = (True, '\\' : '\\' : str)- escape '\\' (False, str) = (False, '\\' : str)- escape c (b, str) = (False, c : str)- -- See long comment above for what this function is trying to do.- --- -- The Bool passed back along the string is True iff the- -- rest of the string is a sequence of backslashes followed by- -- a double quote.+#endif #endif /* __GLASGOW_HASKELL__ */ -#endif- fd_stdin, fd_stdout, fd_stderr :: FD fd_stdin = 0 fd_stdout = 1@@ -571,6 +510,79 @@ #endif /* __HUGS__ */ +-- ------------------------------------------------------------------------+-- Escaping commands for shells++{-+On Windows we also use this for running commands. We use CreateProcess,+passing a single command-line string (lpCommandLine) as its argument.+(CreateProcess is well documented on http://msdn.microsoft.com.)++ - It parses the beginning of the string to find the command. If the+ file name has embedded spaces, it must be quoted, using double+ quotes thus+ "foo\this that\cmd" arg1 arg2++ - The invoked command can in turn access the entire lpCommandLine string,+ and the C runtime does indeed do so, parsing it to generate the+ traditional argument vector argv[0], argv[1], etc. It does this+ using a complex and arcane set of rules which are described here:++ http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp++ (if this URL stops working, you might be able to find it by+ searching for "Parsing C Command-Line Arguments" on MSDN. Also,+ the code in the Microsoft C runtime that does this translation+ is shipped with VC++).++Our goal in runProcess is to take a command filename and list of+arguments, and construct a string which inverts the translatsions+described above, such that the program at the other end sees exactly+the same arguments in its argv[] that we passed to rawSystem.++This inverse translation is implemented by 'translate' below.++Here are some pages that give informations on Windows-related+limitations and deviations from Unix conventions:++ http://support.microsoft.com/default.aspx?scid=kb;en-us;830473+ Command lines and environment variables effectively limited to 8191+ characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):++ http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp+ Command-line substitution under Windows XP. IIRC these facilities (or at+ least a large subset of them) are available on Win NT and 2000. Some+ might be available on Win 9x.++ http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp+ How CMD.EXE processes command lines.+++Note: CreateProcess does have a separate argument (lpApplicationName)+with which you can specify the command, but we have to slap the+command into lpCommandLine anyway, so that argv[0] is what a C program+expects (namely the application name). So it seems simpler to just+use lpCommandLine alone, which CreateProcess supports.+-}++translate :: String -> String+#if mingw32_HOST_OS+translate str = '"' : snd (foldr escape (True,"\"") str)+ where escape '"' (b, str) = (True, '\\' : '"' : str)+ escape '\\' (True, str) = (True, '\\' : '\\' : str)+ escape '\\' (False, str) = (False, '\\' : str)+ escape c (b, str) = (False, c : str)+ -- See long comment above for what this function is trying to do.+ --+ -- The Bool passed back along the string is True iff the+ -- rest of the string is a sequence of backslashes followed by+ -- a double quote.+#else+translate str = '\'' : foldr escape "'" str+ where escape '\'' = showString "'\\''"+ escape c = showChar c+#endif+ -- ---------------------------------------------------------------------------- -- Utils @@ -589,9 +601,9 @@ let env' = map (\(name, val) -> name ++ ('=':val)) envir in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act) #else-withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a+withCEnvironment :: [(String,String)] -> (Ptr CWString -> IO a) -> IO a withCEnvironment envir act = let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" envir- in withCString env' (act . castPtr)+ in withCWString env' (act . castPtr) #endif
cbits/runProcess.c view
@@ -1,528 +1,538 @@-/* ----------------------------------------------------------------------------- (c) The University of Glasgow 2004- - Support for System.Process- ------------------------------------------------------------------------- */--#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)-#define UNICODE-#endif--/* XXX This is a nasty hack; should put everything necessary in this package */-#include "HsBase.h"-#include "Rts.h"--#include "runProcess.h"--#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))--#include "execvpe.h"--/* ----------------------------------------------------------------------------- UNIX versions- ------------------------------------------------------------------------- */--static long max_fd = 0;--// Rts internal API, not exposed in a public header file:-extern void blockUserSignals(void);-extern void unblockUserSignals(void);--ProcHandle-runInteractiveProcess (char *const args[], - char *workingDirectory, char **environment,- int fdStdIn, int fdStdOut, int fdStdErr,- int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,- int set_inthandler, long inthandler, - int set_quithandler, long quithandler,- int close_fds)-{- int pid;- int fdStdInput[2], fdStdOutput[2], fdStdError[2];- int r;- struct sigaction dfl;-- // Ordering matters here, see below [Note #431].- if (fdStdIn == -1) {- r = pipe(fdStdInput);- if (r == -1) { - sysErrorBelch("runInteractiveProcess: pipe");- return -1;- }- - }- if (fdStdOut == -1) {- r = pipe(fdStdOutput);- if (r == -1) { - sysErrorBelch("runInteractiveProcess: pipe");- return -1;- }- }- if (fdStdErr == -1) {- r = pipe(fdStdError);- if (r == -1) { - sysErrorBelch("runInteractiveProcess: pipe");- return -1;- }- }-- // Block signals with Haskell handlers. The danger here is that- // with the threaded RTS, a signal arrives in the child process,- // the RTS writes the signal information into the pipe (which is- // shared between parent and child), and the parent behaves as if- // the signal had been raised.- blockUserSignals();-- // See #4074. Sometimes fork() gets interrupted by the timer- // signal and keeps restarting indefinitely.- stopTimer();-- switch(pid = fork())- {- case -1:- unblockUserSignals();-#if __GLASGOW_HASKELL__ > 612- startTimer();-#endif- if (fdStdIn == -1) {- close(fdStdInput[0]);- close(fdStdInput[1]);- }- if (fdStdOut == -1) {- close(fdStdOutput[0]);- close(fdStdOutput[1]);- }- if (fdStdErr == -1) {- close(fdStdError[0]);- close(fdStdError[1]);- }- return -1;- - case 0:- {- // WARNING! we are now in the child of vfork(), so any memory- // we modify below will also be seen in the parent process.-- unblockUserSignals();-- if (workingDirectory) {- if (chdir (workingDirectory) < 0) {- // See #1593. The convention for the exit code when- // exec() fails seems to be 127 (gleened from C's- // system()), but there's no equivalent convention for- // chdir(), so I'm picking 126 --SimonM.- _exit(126);- }- }- - // [Note #431]: Ordering matters here. If any of the FDs- // 0,1,2 were initially closed, then our pipes may have used- // these FDs. So when we dup2 the pipe FDs down to 0,1,2, we- // must do it in that order, otherwise we could overwrite an- // FD that we need later.-- if (fdStdIn == -1) {- if (fdStdInput[0] != STDIN_FILENO) {- dup2 (fdStdInput[0], STDIN_FILENO);- close(fdStdInput[0]);- }- close(fdStdInput[1]);- } else {- dup2(fdStdIn, STDIN_FILENO);- }-- if (fdStdOut == -1) {- if (fdStdOutput[1] != STDOUT_FILENO) {- dup2 (fdStdOutput[1], STDOUT_FILENO);- close(fdStdOutput[1]);- }- close(fdStdOutput[0]);- } else {- dup2(fdStdOut, STDOUT_FILENO);- }-- if (fdStdErr == -1) {- if (fdStdError[1] != STDERR_FILENO) {- dup2 (fdStdError[1], STDERR_FILENO);- close(fdStdError[1]);- }- close(fdStdError[0]);- } else {- dup2(fdStdErr, STDERR_FILENO);- }- - if (close_fds) {- int i;- if (max_fd == 0) {-#if HAVE_SYSCONF- max_fd = sysconf(_SC_OPEN_MAX);- if (max_fd == -1) {- max_fd = 256;- }-#else- max_fd = 256;-#endif- }- for (i = 3; i < max_fd; i++) {- close(i);- }- }-- /* Set the SIGINT/SIGQUIT signal handlers in the child, if requested - */- (void)sigemptyset(&dfl.sa_mask);- dfl.sa_flags = 0;- if (set_inthandler) {- dfl.sa_handler = (void *)inthandler;- (void)sigaction(SIGINT, &dfl, NULL);- }- if (set_quithandler) {- dfl.sa_handler = (void *)quithandler;- (void)sigaction(SIGQUIT, &dfl, NULL);- }-- /* the child */- if (environment) {- execvpe(args[0], args, environment);- } else {- execvp(args[0], args);- }- }- _exit(127);- - default:- if (fdStdIn == -1) {- close(fdStdInput[0]);- fcntl(fdStdInput[1], F_SETFD, FD_CLOEXEC);- *pfdStdInput = fdStdInput[1];- }- if (fdStdOut == -1) {- close(fdStdOutput[1]);- fcntl(fdStdOutput[0], F_SETFD, FD_CLOEXEC);- *pfdStdOutput = fdStdOutput[0];- }- if (fdStdErr == -1) {- close(fdStdError[1]);- fcntl(fdStdError[0], F_SETFD, FD_CLOEXEC);- *pfdStdError = fdStdError[0];- }- break;- }- unblockUserSignals();- startTimer();- - return pid;-}--int-terminateProcess (ProcHandle handle)-{- return (kill(handle, SIGTERM) == 0);-}--int-getProcessExitCode (ProcHandle handle, int *pExitCode)-{- int wstat, res;- - *pExitCode = 0;- - if ((res = waitpid(handle, &wstat, WNOHANG)) > 0)- {- if (WIFEXITED(wstat))- {- *pExitCode = WEXITSTATUS(wstat);- return 1;- }- else- if (WIFSIGNALED(wstat))- {- errno = EINTR;- return -1;- }- else- {- /* This should never happen */- }- }- - if (res == 0) return 0;-- if (errno == ECHILD) - {- *pExitCode = 0;- return 1;- }-- return -1;-}--int waitForProcess (ProcHandle handle, int *pret)-{- int wstat;- - while (waitpid(handle, &wstat, 0) < 0)- {- if (errno != EINTR)- {- return -1;- }- }- - if (WIFEXITED(wstat)) {- *pret = WEXITSTATUS(wstat);- return 0;- }- else- if (WIFSIGNALED(wstat))- {- *pret = wstat;- return 0;- }- else- {- /* This should never happen */- }- - return -1;-}--#else-/* ----------------------------------------------------------------------------- Win32 versions- ------------------------------------------------------------------------- */--/* -------------------- WINDOWS VERSION --------------------- */--/*- * Function: mkAnonPipe- *- * Purpose: create an anonymous pipe with read and write ends being- * optionally (non-)inheritable.- */-static BOOL-mkAnonPipe (HANDLE* pHandleIn, BOOL isInheritableIn, - HANDLE* pHandleOut, BOOL isInheritableOut)-{- HANDLE hTemporaryIn = NULL;- HANDLE hTemporaryOut = NULL;-- /* Create the anon pipe with both ends inheritable */- if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, NULL, 0))- {- maperrno();- *pHandleIn = NULL;- *pHandleOut = NULL;- return FALSE;- }-- if (isInheritableIn) {- // SetHandleInformation requires at least Win2k- if (!SetHandleInformation(hTemporaryIn,- HANDLE_FLAG_INHERIT, - HANDLE_FLAG_INHERIT))- {- maperrno();- *pHandleIn = NULL;- *pHandleOut = NULL;- CloseHandle(hTemporaryIn);- CloseHandle(hTemporaryOut);- return FALSE;- }- }- *pHandleIn = hTemporaryIn;-- if (isInheritableOut) {- if (!SetHandleInformation(hTemporaryOut,- HANDLE_FLAG_INHERIT, - HANDLE_FLAG_INHERIT))- {- maperrno();- *pHandleIn = NULL;- *pHandleOut = NULL;- CloseHandle(hTemporaryIn);- CloseHandle(hTemporaryOut);- return FALSE;- }- }- *pHandleOut = hTemporaryOut;- - return TRUE;-}--ProcHandle-runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory, - void *environment,- int fdStdIn, int fdStdOut, int fdStdErr,- int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,- int close_fds)-{- STARTUPINFO sInfo;- PROCESS_INFORMATION pInfo;- HANDLE hStdInputRead = INVALID_HANDLE_VALUE;- HANDLE hStdInputWrite = INVALID_HANDLE_VALUE;- HANDLE hStdOutputRead = INVALID_HANDLE_VALUE;- HANDLE hStdOutputWrite = INVALID_HANDLE_VALUE;- HANDLE hStdErrorRead = INVALID_HANDLE_VALUE;- HANDLE hStdErrorWrite = INVALID_HANDLE_VALUE;- DWORD flags;- BOOL status;- BOOL inherit;-- ZeroMemory(&sInfo, sizeof(sInfo));- sInfo.cb = sizeof(sInfo);- sInfo.dwFlags = STARTF_USESTDHANDLES;-- if (fdStdIn == -1) {- if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE))- goto cleanup_err;- sInfo.hStdInput = hStdInputRead;- } else if (fdStdIn == 0) {- // Don't duplicate stdin, as console handles cannot be- // duplicated and inherited. urg.- sInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE);- } else {- // The handle might not be inheritable, so duplicate it- status = DuplicateHandle(GetCurrentProcess(), - (HANDLE) _get_osfhandle(fdStdIn),- GetCurrentProcess(), &hStdInputRead,- 0,- TRUE, /* inheritable */- DUPLICATE_SAME_ACCESS);- if (!status) goto cleanup_err;- sInfo.hStdInput = hStdInputRead;- }-- if (fdStdOut == -1) {- if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE))- goto cleanup_err;- sInfo.hStdOutput = hStdOutputWrite;- } else if (fdStdOut == 1) {- // Don't duplicate stdout, as console handles cannot be- // duplicated and inherited. urg.- sInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);- } else {- // The handle might not be inheritable, so duplicate it- status = DuplicateHandle(GetCurrentProcess(), - (HANDLE) _get_osfhandle(fdStdOut),- GetCurrentProcess(), &hStdOutputWrite,- 0,- TRUE, /* inheritable */- DUPLICATE_SAME_ACCESS);- if (!status) goto cleanup_err;- sInfo.hStdOutput = hStdOutputWrite;- }-- if (fdStdErr == -1) {- if (!mkAnonPipe(&hStdErrorRead, TRUE, &hStdErrorWrite, TRUE))- goto cleanup_err;- sInfo.hStdError = hStdErrorWrite;- } else if (fdStdErr == 2) {- // Don't duplicate stderr, as console handles cannot be- // duplicated and inherited. urg.- sInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE);- } else {- /* The handle might not be inheritable, so duplicate it */- status = DuplicateHandle(GetCurrentProcess(), - (HANDLE) _get_osfhandle(fdStdErr),- GetCurrentProcess(), &hStdErrorWrite,- 0,- TRUE, /* inheritable */- DUPLICATE_SAME_ACCESS);- if (!status) goto cleanup_err;- sInfo.hStdError = hStdErrorWrite;- }-- if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) &&- sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) &&- sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE))- flags = CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected- else- flags = 0;-- // See #3231- if (close_fds && fdStdIn == 0 && fdStdOut == 1 && fdStdErr == 2) {- inherit = FALSE;- } else {- inherit = TRUE;- }-- if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, flags, environment, workingDirectory, &sInfo, &pInfo))- {- goto cleanup_err;- }- CloseHandle(pInfo.hThread);-- // Close the ends of the pipes that were inherited by the- // child process. This is important, otherwise we won't see- // EOF on these pipes when the child process exits.- if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead);- if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite);- if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite);-- *pfdStdInput = _open_osfhandle((intptr_t) hStdInputWrite, _O_WRONLY);- *pfdStdOutput = _open_osfhandle((intptr_t) hStdOutputRead, _O_RDONLY);- *pfdStdError = _open_osfhandle((intptr_t) hStdErrorRead, _O_RDONLY);-- return (int) pInfo.hProcess;--cleanup_err:- if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead);- if (hStdInputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdInputWrite);- if (hStdOutputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputRead);- if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite);- if (hStdErrorRead != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorRead);- if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite);- maperrno();- return -1;-}--int-terminateProcess (ProcHandle handle)-{- if (!TerminateProcess((HANDLE) handle, 1)) {- maperrno();- return -1;- }- return 0;-}--int-getProcessExitCode (ProcHandle handle, int *pExitCode)-{- *pExitCode = 0;-- if (WaitForSingleObject((HANDLE) handle, 1) == WAIT_OBJECT_0)- {- if (GetExitCodeProcess((HANDLE) handle, (DWORD *) pExitCode) == 0)- {- maperrno();- return -1;- }- return 1;- }- - return 0;-}--int-waitForProcess (ProcHandle handle, int *pret)-{- DWORD retCode;-- if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0)- {- if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0)- {- maperrno();- return -1;- }- *pret = retCode;- return 0;- }- - maperrno();- return -1;-}--#endif /* Win32 */+/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2004 + + Support for System.Process + ------------------------------------------------------------------------- */ + +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) +#define UNICODE +#endif + +/* XXX This is a nasty hack; should put everything necessary in this package */ +#include "HsBase.h" +#include "Rts.h" + +#include "runProcess.h" + +#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) + +#include "execvpe.h" + +/* ---------------------------------------------------------------------------- + UNIX versions + ------------------------------------------------------------------------- */ + +static long max_fd = 0; + +// Rts internal API, not exposed in a public header file: +extern void blockUserSignals(void); +extern void unblockUserSignals(void); + +ProcHandle +runInteractiveProcess (char *const args[], + char *workingDirectory, char **environment, + int fdStdIn, int fdStdOut, int fdStdErr, + int *pfdStdInput, int *pfdStdOutput, int *pfdStdError, + int set_inthandler, long inthandler, + int set_quithandler, long quithandler, + int flags) +{ + int close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0); + int pid; + int fdStdInput[2], fdStdOutput[2], fdStdError[2]; + int r; + struct sigaction dfl; + + // Ordering matters here, see below [Note #431]. + if (fdStdIn == -1) { + r = pipe(fdStdInput); + if (r == -1) { + sysErrorBelch("runInteractiveProcess: pipe"); + return -1; + } + + } + if (fdStdOut == -1) { + r = pipe(fdStdOutput); + if (r == -1) { + sysErrorBelch("runInteractiveProcess: pipe"); + return -1; + } + } + if (fdStdErr == -1) { + r = pipe(fdStdError); + if (r == -1) { + sysErrorBelch("runInteractiveProcess: pipe"); + return -1; + } + } + + // Block signals with Haskell handlers. The danger here is that + // with the threaded RTS, a signal arrives in the child process, + // the RTS writes the signal information into the pipe (which is + // shared between parent and child), and the parent behaves as if + // the signal had been raised. + blockUserSignals(); + + // See #4074. Sometimes fork() gets interrupted by the timer + // signal and keeps restarting indefinitely. + stopTimer(); + + switch(pid = fork()) + { + case -1: + unblockUserSignals(); +#if __GLASGOW_HASKELL__ > 612 + startTimer(); +#endif + if (fdStdIn == -1) { + close(fdStdInput[0]); + close(fdStdInput[1]); + } + if (fdStdOut == -1) { + close(fdStdOutput[0]); + close(fdStdOutput[1]); + } + if (fdStdErr == -1) { + close(fdStdError[0]); + close(fdStdError[1]); + } + return -1; + + case 0: + { + // WARNING! we are now in the child of vfork(), so any memory + // we modify below will also be seen in the parent process. + + if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { + setpgid(0, 0); + } + + unblockUserSignals(); + + if (workingDirectory) { + if (chdir (workingDirectory) < 0) { + // See #1593. The convention for the exit code when + // exec() fails seems to be 127 (gleened from C's + // system()), but there's no equivalent convention for + // chdir(), so I'm picking 126 --SimonM. + _exit(126); + } + } + + // [Note #431]: Ordering matters here. If any of the FDs + // 0,1,2 were initially closed, then our pipes may have used + // these FDs. So when we dup2 the pipe FDs down to 0,1,2, we + // must do it in that order, otherwise we could overwrite an + // FD that we need later. + + if (fdStdIn == -1) { + if (fdStdInput[0] != STDIN_FILENO) { + dup2 (fdStdInput[0], STDIN_FILENO); + close(fdStdInput[0]); + } + close(fdStdInput[1]); + } else { + dup2(fdStdIn, STDIN_FILENO); + } + + if (fdStdOut == -1) { + if (fdStdOutput[1] != STDOUT_FILENO) { + dup2 (fdStdOutput[1], STDOUT_FILENO); + close(fdStdOutput[1]); + } + close(fdStdOutput[0]); + } else { + dup2(fdStdOut, STDOUT_FILENO); + } + + if (fdStdErr == -1) { + if (fdStdError[1] != STDERR_FILENO) { + dup2 (fdStdError[1], STDERR_FILENO); + close(fdStdError[1]); + } + close(fdStdError[0]); + } else { + dup2(fdStdErr, STDERR_FILENO); + } + + if (close_fds) { + int i; + if (max_fd == 0) { +#if HAVE_SYSCONF + max_fd = sysconf(_SC_OPEN_MAX); + if (max_fd == -1) { + max_fd = 256; + } +#else + max_fd = 256; +#endif + } + for (i = 3; i < max_fd; i++) { + close(i); + } + } + + /* Set the SIGINT/SIGQUIT signal handlers in the child, if requested + */ + (void)sigemptyset(&dfl.sa_mask); + dfl.sa_flags = 0; + if (set_inthandler) { + dfl.sa_handler = (void *)inthandler; + (void)sigaction(SIGINT, &dfl, NULL); + } + if (set_quithandler) { + dfl.sa_handler = (void *)quithandler; + (void)sigaction(SIGQUIT, &dfl, NULL); + } + + /* the child */ + if (environment) { + execvpe(args[0], args, environment); + } else { + execvp(args[0], args); + } + } + _exit(127); + + default: + if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { + setpgid(pid, pid); + } + if (fdStdIn == -1) { + close(fdStdInput[0]); + fcntl(fdStdInput[1], F_SETFD, FD_CLOEXEC); + *pfdStdInput = fdStdInput[1]; + } + if (fdStdOut == -1) { + close(fdStdOutput[1]); + fcntl(fdStdOutput[0], F_SETFD, FD_CLOEXEC); + *pfdStdOutput = fdStdOutput[0]; + } + if (fdStdErr == -1) { + close(fdStdError[1]); + fcntl(fdStdError[0], F_SETFD, FD_CLOEXEC); + *pfdStdError = fdStdError[0]; + } + break; + } + unblockUserSignals(); + startTimer(); + + return pid; +} + +int +terminateProcess (ProcHandle handle) +{ + return (kill(handle, SIGTERM) == 0); +} + +int +getProcessExitCode (ProcHandle handle, int *pExitCode) +{ + int wstat, res; + + *pExitCode = 0; + + if ((res = waitpid(handle, &wstat, WNOHANG)) > 0) + { + if (WIFEXITED(wstat)) + { + *pExitCode = WEXITSTATUS(wstat); + return 1; + } + else + if (WIFSIGNALED(wstat)) + { + errno = EINTR; + return -1; + } + else + { + /* This should never happen */ + } + } + + if (res == 0) return 0; + + if (errno == ECHILD) + { + *pExitCode = 0; + return 1; + } + + return -1; +} + +int waitForProcess (ProcHandle handle, int *pret) +{ + int wstat; + + if (waitpid(handle, &wstat, 0) < 0) + { + return -1; + } + + if (WIFEXITED(wstat)) { + *pret = WEXITSTATUS(wstat); + return 0; + } + else + if (WIFSIGNALED(wstat)) + { + *pret = wstat; + return 0; + } + else + { + /* This should never happen */ + } + + return -1; +} + +#else +/* ---------------------------------------------------------------------------- + Win32 versions + ------------------------------------------------------------------------- */ + +/* -------------------- WINDOWS VERSION --------------------- */ + +/* + * Function: mkAnonPipe + * + * Purpose: create an anonymous pipe with read and write ends being + * optionally (non-)inheritable. + */ +static BOOL +mkAnonPipe (HANDLE* pHandleIn, BOOL isInheritableIn, + HANDLE* pHandleOut, BOOL isInheritableOut) +{ + HANDLE hTemporaryIn = NULL; + HANDLE hTemporaryOut = NULL; + + /* Create the anon pipe with both ends inheritable */ + if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, NULL, 0)) + { + maperrno(); + *pHandleIn = NULL; + *pHandleOut = NULL; + return FALSE; + } + + if (isInheritableIn) { + // SetHandleInformation requires at least Win2k + if (!SetHandleInformation(hTemporaryIn, + HANDLE_FLAG_INHERIT, + HANDLE_FLAG_INHERIT)) + { + maperrno(); + *pHandleIn = NULL; + *pHandleOut = NULL; + CloseHandle(hTemporaryIn); + CloseHandle(hTemporaryOut); + return FALSE; + } + } + *pHandleIn = hTemporaryIn; + + if (isInheritableOut) { + if (!SetHandleInformation(hTemporaryOut, + HANDLE_FLAG_INHERIT, + HANDLE_FLAG_INHERIT)) + { + maperrno(); + *pHandleIn = NULL; + *pHandleOut = NULL; + CloseHandle(hTemporaryIn); + CloseHandle(hTemporaryOut); + return FALSE; + } + } + *pHandleOut = hTemporaryOut; + + return TRUE; +} + +ProcHandle +runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory, + wchar_t *environment, + int fdStdIn, int fdStdOut, int fdStdErr, + int *pfdStdInput, int *pfdStdOutput, int *pfdStdError, + int flags) +{ + STARTUPINFO sInfo; + PROCESS_INFORMATION pInfo; + HANDLE hStdInputRead = INVALID_HANDLE_VALUE; + HANDLE hStdInputWrite = INVALID_HANDLE_VALUE; + HANDLE hStdOutputRead = INVALID_HANDLE_VALUE; + HANDLE hStdOutputWrite = INVALID_HANDLE_VALUE; + HANDLE hStdErrorRead = INVALID_HANDLE_VALUE; + HANDLE hStdErrorWrite = INVALID_HANDLE_VALUE; + BOOL close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0); + // We always pass a wide environment block, so we MUST set this flag + DWORD dwFlags = CREATE_UNICODE_ENVIRONMENT; + BOOL status; + BOOL inherit; + + ZeroMemory(&sInfo, sizeof(sInfo)); + sInfo.cb = sizeof(sInfo); + sInfo.dwFlags = STARTF_USESTDHANDLES; + + if (fdStdIn == -1) { + if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE)) + goto cleanup_err; + sInfo.hStdInput = hStdInputRead; + } else if (fdStdIn == 0) { + // Don't duplicate stdin, as console handles cannot be + // duplicated and inherited. urg. + sInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + } else { + // The handle might not be inheritable, so duplicate it + status = DuplicateHandle(GetCurrentProcess(), + (HANDLE) _get_osfhandle(fdStdIn), + GetCurrentProcess(), &hStdInputRead, + 0, + TRUE, /* inheritable */ + DUPLICATE_SAME_ACCESS); + if (!status) goto cleanup_err; + sInfo.hStdInput = hStdInputRead; + } + + if (fdStdOut == -1) { + if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE)) + goto cleanup_err; + sInfo.hStdOutput = hStdOutputWrite; + } else if (fdStdOut == 1) { + // Don't duplicate stdout, as console handles cannot be + // duplicated and inherited. urg. + sInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + } else { + // The handle might not be inheritable, so duplicate it + status = DuplicateHandle(GetCurrentProcess(), + (HANDLE) _get_osfhandle(fdStdOut), + GetCurrentProcess(), &hStdOutputWrite, + 0, + TRUE, /* inheritable */ + DUPLICATE_SAME_ACCESS); + if (!status) goto cleanup_err; + sInfo.hStdOutput = hStdOutputWrite; + } + + if (fdStdErr == -1) { + if (!mkAnonPipe(&hStdErrorRead, TRUE, &hStdErrorWrite, TRUE)) + goto cleanup_err; + sInfo.hStdError = hStdErrorWrite; + } else if (fdStdErr == 2) { + // Don't duplicate stderr, as console handles cannot be + // duplicated and inherited. urg. + sInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + } else { + /* The handle might not be inheritable, so duplicate it */ + status = DuplicateHandle(GetCurrentProcess(), + (HANDLE) _get_osfhandle(fdStdErr), + GetCurrentProcess(), &hStdErrorWrite, + 0, + TRUE, /* inheritable */ + DUPLICATE_SAME_ACCESS); + if (!status) goto cleanup_err; + sInfo.hStdError = hStdErrorWrite; + } + + if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) && + sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) && + sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE) && + (flags & RUN_PROCESS_IN_NEW_GROUP) == 0) + dwFlags |= CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected + + // See #3231 + if (close_fds && fdStdIn == 0 && fdStdOut == 1 && fdStdErr == 2) { + inherit = FALSE; + } else { + inherit = TRUE; + } + + if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { + dwFlags |= CREATE_NEW_PROCESS_GROUP; + } + + if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo)) + { + goto cleanup_err; + } + CloseHandle(pInfo.hThread); + + // Close the ends of the pipes that were inherited by the + // child process. This is important, otherwise we won't see + // EOF on these pipes when the child process exits. + if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead); + if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite); + if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite); + + *pfdStdInput = _open_osfhandle((intptr_t) hStdInputWrite, _O_WRONLY); + *pfdStdOutput = _open_osfhandle((intptr_t) hStdOutputRead, _O_RDONLY); + *pfdStdError = _open_osfhandle((intptr_t) hStdErrorRead, _O_RDONLY); + + return pInfo.hProcess; + +cleanup_err: + if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead); + if (hStdInputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdInputWrite); + if (hStdOutputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputRead); + if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite); + if (hStdErrorRead != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorRead); + if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite); + maperrno(); + return NULL; +} + +int +terminateProcess (ProcHandle handle) +{ + if (!TerminateProcess((HANDLE) handle, 1)) { + maperrno(); + return -1; + } + return 0; +} + +int +getProcessExitCode (ProcHandle handle, int *pExitCode) +{ + *pExitCode = 0; + + if (WaitForSingleObject((HANDLE) handle, 1) == WAIT_OBJECT_0) + { + if (GetExitCodeProcess((HANDLE) handle, (DWORD *) pExitCode) == 0) + { + maperrno(); + return -1; + } + return 1; + } + + return 0; +} + +int +waitForProcess (ProcHandle handle, int *pret) +{ + DWORD retCode; + + if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0) + { + if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0) + { + maperrno(); + return -1; + } + *pret = retCode; + return 0; + } + + maperrno(); + return -1; +} + +#endif /* Win32 */
include/runProcess.h view
@@ -1,75 +1,77 @@-/* ----------------------------------------------------------------------------- (c) The University of Glasgow 2004-- Interface for code in runProcess.c (providing support for System.Process)- ------------------------------------------------------------------------- */--#include "HsProcessConfig.h"-// Otherwise these clash with similar definitions from other packages:-#undef PACKAGE_BUGREPORT-#undef PACKAGE_NAME-#undef PACKAGE_STRING-#undef PACKAGE_TARNAME-#undef PACKAGE_VERSION--#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)-#define UNICODE-#include <windows.h>-#include <stdlib.h>-#endif--#include <unistd.h>-#include <sys/types.h>--#ifdef HAVE_FCNTL_H-#include <fcntl.h>-#endif--#ifdef HAVE_VFORK_H-#include <vfork.h>-#endif--#ifdef HAVE_VFORK-#define fork vfork-#endif--#ifdef HAVE_SIGNAL_H-#include <signal.h>-#endif--#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))-typedef pid_t ProcHandle;-#else-// Should really be intptr_t, but we don't have that type on the Haskell side-typedef long ProcHandle;-#endif--#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))--extern ProcHandle runInteractiveProcess( char *const args[], - char *workingDirectory, - char **environment, - int fdStdIn, int fdStdOut, int fdStdErr,- int *pfdStdInput, - int *pfdStdOutput, - int *pfdStdError,- int set_inthandler, long inthandler, - int set_quithandler, long quithandler,- int close_fds);--#else--extern ProcHandle runInteractiveProcess( wchar_t *cmd,- wchar_t *workingDirectory,- void *environment,- int fdStdIn, int fdStdOut, int fdStdErr,- int *pfdStdInput,- int *pfdStdOutput,- int *pfdStdError,- int close_fds);--#endif--extern int terminateProcess( ProcHandle handle );-extern int getProcessExitCode( ProcHandle handle, int *pExitCode );-extern int waitForProcess( ProcHandle handle, int *ret );+/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2004 + + Interface for code in runProcess.c (providing support for System.Process) + ------------------------------------------------------------------------- */ + +#include "HsProcessConfig.h" +// Otherwise these clash with similar definitions from other packages: +#undef PACKAGE_BUGREPORT +#undef PACKAGE_NAME +#undef PACKAGE_STRING +#undef PACKAGE_TARNAME +#undef PACKAGE_VERSION + +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) +#define UNICODE +#include <windows.h> +#include <stdlib.h> +#endif + +#include <unistd.h> +#include <sys/types.h> + +#ifdef HAVE_FCNTL_H +#include <fcntl.h> +#endif + +#ifdef HAVE_VFORK_H +#include <vfork.h> +#endif + +#ifdef HAVE_VFORK +#define fork vfork +#endif + +#ifdef HAVE_SIGNAL_H +#include <signal.h> +#endif + +#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) +typedef pid_t ProcHandle; +#else +// Should really be intptr_t, but we don't have that type on the Haskell side +typedef PHANDLE ProcHandle; +#endif + +#include "processFlags.h" + +#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) + +extern ProcHandle runInteractiveProcess( char *const args[], + char *workingDirectory, + char **environment, + int fdStdIn, int fdStdOut, int fdStdErr, + int *pfdStdInput, + int *pfdStdOutput, + int *pfdStdError, + int set_inthandler, long inthandler, + int set_quithandler, long quithandler, + int flags); + +#else + +extern ProcHandle runInteractiveProcess( wchar_t *cmd, + wchar_t *workingDirectory, + wchar_t *environment, + int fdStdIn, int fdStdOut, int fdStdErr, + int *pfdStdInput, + int *pfdStdOutput, + int *pfdStdError, + int flags); + +#endif + +extern int terminateProcess( ProcHandle handle ); +extern int getProcessExitCode( ProcHandle handle, int *pExitCode ); +extern int waitForProcess( ProcHandle handle, int *ret );
process.cabal view
@@ -1,5 +1,5 @@ name: process-version: 1.0.1.5+version: 1.1.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -18,8 +18,8 @@ cabal-version: >=1.6 source-repository head- type: darcs- location: http://darcs.haskell.org/packages/process/+ type: git+ location: http://darcs.haskell.org/packages/process.git/ flag base4 @@ -39,7 +39,10 @@ install-includes: runProcess.h HsProcessConfig.h- if !os(windows)+ if os(windows)+ build-depends: Win32 >=2.2.0.0+ extra-libraries: kernel32+ else build-depends: unix }