diff --git a/System/Process.hs b/System/Process.hs --- a/System/Process.hs +++ b/System/Process.hs @@ -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 diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs --- a/System/Process/Internals.hs +++ b/System/Process/Internals.hs @@ -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 diff --git a/cbits/runProcess.c b/cbits/runProcess.c --- a/cbits/runProcess.c +++ b/cbits/runProcess.c @@ -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 */ diff --git a/include/runProcess.h b/include/runProcess.h --- a/include/runProcess.h +++ b/include/runProcess.h @@ -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 -#include -#endif - -#include -#include - -#ifdef HAVE_FCNTL_H -#include -#endif - -#ifdef HAVE_VFORK_H -#include -#endif - -#ifdef HAVE_VFORK -#define fork vfork -#endif - -#ifdef HAVE_SIGNAL_H -#include -#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 +#include +#endif + +#include +#include + +#ifdef HAVE_FCNTL_H +#include +#endif + +#ifdef HAVE_VFORK_H +#include +#endif + +#ifdef HAVE_VFORK +#define fork vfork +#endif + +#ifdef HAVE_SIGNAL_H +#include +#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 ); diff --git a/process.cabal b/process.cabal --- a/process.cabal +++ b/process.cabal @@ -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 }