process 1.6.10.0 → 1.6.11.0
raw patch · 11 files changed
+1358/−983 lines, 11 filesdep ~Win32dep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: Win32, base
API changes (from Hackage documentation)
Files
- System/Process.hs +12/−1
- System/Process/Common.hs +45/−8
- System/Process/Internals.hs +1/−12
- System/Process/Windows.hsc +177/−32
- cbits/posix/runProcess.c +481/−0
- cbits/runProcess.c +0/−923
- cbits/win32/runProcess.c +608/−0
- changelog.md +6/−0
- include/runProcess.h +12/−2
- process.cabal +11/−5
- test/main.hs +5/−0
System/Process.hs view
@@ -200,6 +200,13 @@ instead. All created @Handle@s are initially in text mode; if you need them to be in binary mode then use 'hSetBinaryMode'. +@/ph/@ contains a handle to the running process. On Windows+'use_process_jobs' can be set in CreateProcess in order to create a+Win32 Job object to monitor a process tree's progress. If it is set+then that job is also returned inside @/ph/@. @/ph/@ can be used to+kill all running sub-processes. This feature has been available since+1.5.0.0.+ -} createProcess :: CreateProcess@@ -654,6 +661,10 @@ other threads in the system, you must compile the program with @-threaded@. +Note that it is safe to call @waitForProcess@ for the same process in multiple+threads. When the process ends, threads blocking on this call will wake in+FIFO order.+ (/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@ indicates that the child was terminated by signal @/signum/@. The signal numbers are platform-specific, so to test for a specific signal use@@ -806,7 +817,7 @@ case p_ of ClosedHandle _ -> return () #if defined(WINDOWS)- OpenExtHandle{} -> terminateJob ph 1 >> return ()+ OpenExtHandle{} -> terminateJobUnsafe p_ 1 >> return () #else OpenExtHandle{} -> error "terminateProcess with OpenExtHandle should not happen on POSIX." #endif
System/Process/Common.hs view
@@ -26,6 +26,13 @@ #else , CGid #endif++-- WINIO is only available on GHC 8.12 and up.+#if defined(__IO_MANAGER_WINIO__)+ , HANDLE+ , mbHANDLE+ , mbPipeHANDLE+#endif ) where import Control.Concurrent@@ -39,6 +46,10 @@ import GHC.IO.Encoding import qualified GHC.IO.FD as FD import GHC.IO.Device+#if defined(__IO_MANAGER_WINIO__)+import GHC.IO.Handle.Windows+import GHC.IO.Windows.Handle (fromHANDLE, Io(), NativeHandle())+#endif import GHC.IO.Handle.FD import GHC.IO.Handle.Internals import GHC.IO.Handle.Types hiding (ClosedHandle)@@ -51,6 +62,9 @@ #ifdef WINDOWS import Data.Word (Word32) import System.Win32.DebugApi (PHANDLE)+#if defined(__IO_MANAGER_WINIO__)+import System.Win32.Types (HANDLE)+#endif #else import System.Posix.Types #endif@@ -175,6 +189,15 @@ -- ---------------------------------------------------------------------------- -- ProcessHandle type +data ProcessHandle__ = OpenHandle { phdlProcessHandle :: PHANDLE }+ | OpenExtHandle { phdlProcessHandle :: PHANDLE+ -- ^ the process+ , phdlJobHandle :: PHANDLE+ -- ^ the job containing the process and+ -- its subprocesses+ }+ | ClosedHandle ExitCode+ {- | A handle to a process, which can be used to wait for termination of the process using 'System.Process.waitForProcess'. @@ -186,14 +209,6 @@ completion. This requires two handles. A process job handle and a events handle to monitor. -}-data ProcessHandle__ = OpenHandle { phdlProcessHandle :: PHANDLE }- | OpenExtHandle { phdlProcessHandle :: PHANDLE- -- ^ the process- , phdlJobHandle :: PHANDLE- -- ^ the job containing the process and- -- its subprocesses- }- | ClosedHandle ExitCode data ProcessHandle = ProcessHandle { phandle :: !(MVar ProcessHandle__) , mb_delegate_ctlc :: !Bool@@ -258,3 +273,25 @@ let enc = localeEncoding #endif mkHandleFromFD fD' fd_type filepath mode False {-is_socket-} (Just enc)++#if defined(__IO_MANAGER_WINIO__)+-- It is not completely safe to pass the values -1 and -2 as HANDLE as it's an+-- unsigned type. -1 additionally is also the value for INVALID_HANDLE. However+-- it should be safe in this case since an invalid handle would be an error here+-- anyway and the chances of us getting a handle with a value of -2 is+-- astronomical. However, sometime in the future process should really use a+-- proper structure here.+mbHANDLE :: HANDLE -> StdStream -> IO HANDLE+mbHANDLE _std CreatePipe = return $ intPtrToPtr (-1)+mbHANDLE std Inherit = return std+mbHANDLE _std NoStream = return $ intPtrToPtr (-2)+mbHANDLE _std (UseHandle hdl) = handleToHANDLE hdl++mbPipeHANDLE :: StdStream -> Ptr HANDLE -> IOMode -> IO (Maybe Handle)+mbPipeHANDLE CreatePipe pfd mode =+ do raw_handle <- peek pfd+ let hwnd = fromHANDLE raw_handle :: Io NativeHandle+ ident = "hwnd:" ++ show raw_handle+ Just <$> mkHandleFromHANDLE hwnd Stream ident mode Nothing+mbPipeHANDLE _std _pfd _mode = return Nothing+#endif
System/Process/Internals.hs view
@@ -41,6 +41,7 @@ unwrapHandles, #ifdef WINDOWS terminateJob,+ terminateJobUnsafe, waitForJobCompletion, timeout_Infinite, #else@@ -77,18 +78,6 @@ -- -- * This function takes an extra @String@ argument to be used in creating -- error messages.------ * 'use_process_jobs' can be set in CreateProcess since 1.5.0.0 in order to create--- an I/O completion port to monitor a process tree's progress on Windows.------ The function also returns two new handles:--- * an I/O Completion Port handle on which events--- will be signaled.--- * a Job handle which can be used to kill all running--- processes.------ On POSIX platforms these two new handles will always be Nothing--- -- -- This function has been available from the "System.Process.Internals" module -- for some time, and is part of the "System.Process" module since version
System/Process/Windows.hsc view
@@ -14,6 +14,7 @@ , createPipeInternalFd , interruptProcessGroupOfInternal , terminateJob+ , terminateJobUnsafe , waitForJobCompletion , timeout_Infinite ) where@@ -30,6 +31,11 @@ import System.Posix.Internals import GHC.IO.Exception+##if defined(__IO_MANAGER_WINIO__)+import GHC.IO.SubSystem+import Graphics.Win32.Misc+import qualified GHC.Event.Windows as Mgr+##endif import GHC.IO.Handle.FD import GHC.IO.Handle.Types hiding (ClosedHandle) import System.IO.Error@@ -91,19 +97,77 @@ -> CreateProcess -> IO ProcRetHandles -createProcess_Internal fun CreateProcess{ cmdspec = cmdsp,- cwd = mb_cwd,- env = mb_env,- std_in = mb_stdin,- std_out = mb_stdout,- std_err = mb_stderr,- close_fds = mb_close_fds,- create_group = mb_create_group,- delegate_ctlc = _ignored,- detach_console = mb_detach_console,- create_new_console = mb_create_new_console,- new_session = mb_new_session,- use_process_jobs = use_job }+##if defined(__IO_MANAGER_WINIO__)+createProcess_Internal = createProcess_Internal_mio <!> createProcess_Internal_winio+##else+createProcess_Internal = createProcess_Internal_mio+##endif++createProcess_Internal_mio+ :: String -- ^ function name (for error messages)+ -> CreateProcess+ -> IO ProcRetHandles++createProcess_Internal_mio fun def@CreateProcess{+ std_in = mb_stdin,+ std_out = mb_stdout,+ std_err = mb_stderr,+ close_fds = mb_close_fds,+ create_group = mb_create_group,+ delegate_ctlc = _ignored,+ detach_console = mb_detach_console,+ create_new_console = mb_create_new_console,+ new_session = mb_new_session,+ use_process_jobs = use_job }+ = createProcess_Internal_wrapper fun def $+ \pfdStdInput pfdStdOutput pfdStdError hJob pEnv pWorkDir pcmdline -> do+ fdin <- mbFd fun fd_stdin mb_stdin+ fdout <- mbFd fun fd_stdout mb_stdout+ fderr <- mbFd fun fd_stderr mb_stderr++ -- #2650: we must ensure mutual exclusion of c_runInteractiveProcess,+ -- because otherwise there is a race condition whereby one thread+ -- has created some pipes, and another thread spawns a process which+ -- accidentally inherits some of the pipe handles that the first+ -- thread has created.+ --+ -- An MVar in Haskell is the best way to do this, because there+ -- is no way to do one-time thread-safe initialisation of a mutex+ -- the C code. Also the MVar will be cheaper when not running+ -- the threaded RTS.+ proc_handle <- withMVar runInteractiveProcess_lock $ \_ ->+ throwErrnoIfBadPHandle fun $+ c_runInteractiveProcess pcmdline pWorkDir pEnv+ fdin fdout fderr+ pfdStdInput pfdStdOutput pfdStdError+ ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)+ .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)+ .|.(if mb_detach_console then RUN_PROCESS_DETACHED else 0)+ .|.(if mb_create_new_console then RUN_PROCESS_NEW_CONSOLE else 0)+ .|.(if mb_new_session then RUN_PROCESS_NEW_SESSION else 0))+ use_job+ hJob++ hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode+ hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode+ hndStdError <- mbPipe mb_stderr pfdStdError ReadMode++ return (proc_handle, hndStdInput, hndStdOutput, hndStdError)+++createProcess_Internal_wrapper+ :: Storable a => String -- ^ function name (for error messages)+ -> CreateProcess+ -> (Ptr a -> Ptr a -> Ptr a -> Ptr PHANDLE -> Ptr CWString -> CWString+ -> CWString -> IO (PHANDLE, Maybe Handle, Maybe Handle, Maybe Handle))+ -> IO ProcRetHandles++createProcess_Internal_wrapper _fun CreateProcess{+ cmdspec = cmdsp,+ cwd = mb_cwd,+ env = mb_env,+ delegate_ctlc = _ignored }+ action = do let lenPtr = sizeOf (undefined :: WordPtr) (cmd, cmdline) <- commandToProcess cmdsp@@ -116,10 +180,44 @@ maybeWith withCWString mb_cwd $ \pWorkDir -> do withCWString cmdline $ \pcmdline -> do - fdin <- mbFd fun fd_stdin mb_stdin- fdout <- mbFd fun fd_stdout mb_stdout- fderr <- mbFd fun fd_stderr mb_stderr+ (proc_handle, hndStdInput, hndStdOutput, hndStdError)+ <- action pfdStdInput pfdStdOutput pfdStdError hJob pEnv pWorkDir pcmdline + phJob <- peek hJob+ ph <- mkProcessHandle proc_handle phJob+ return ProcRetHandles { hStdInput = hndStdInput+ , hStdOutput = hndStdOutput+ , hStdError = hndStdError+ , procHandle = ph+ }++##if defined(__IO_MANAGER_WINIO__)+createProcess_Internal_winio+ :: String -- ^ function name (for error messages)+ -> CreateProcess+ -> IO ProcRetHandles++createProcess_Internal_winio fun def@CreateProcess{+ std_in = mb_stdin,+ std_out = mb_stdout,+ std_err = mb_stderr,+ close_fds = mb_close_fds,+ create_group = mb_create_group,+ delegate_ctlc = _ignored,+ detach_console = mb_detach_console,+ create_new_console = mb_create_new_console,+ new_session = mb_new_session,+ use_process_jobs = use_job }+ = createProcess_Internal_wrapper fun def $+ \pfdStdInput pfdStdOutput pfdStdError hJob pEnv pWorkDir pcmdline -> do++ _stdin <- getStdHandle sTD_INPUT_HANDLE+ _stdout <- getStdHandle sTD_OUTPUT_HANDLE+ _stderr <- getStdHandle sTD_ERROR_HANDLE+ hwnd_in <- mbHANDLE _stdin mb_stdin+ hwnd_out <- mbHANDLE _stdout mb_stdout+ hwnd_err <- mbHANDLE _stderr mb_stderr+ -- #2650: we must ensure mutual exclusion of c_runInteractiveProcess, -- because otherwise there is a race condition whereby one thread -- has created some pipes, and another thread spawns a process which@@ -132,8 +230,8 @@ -- the threaded RTS. proc_handle <- withMVar runInteractiveProcess_lock $ \_ -> throwErrnoIfBadPHandle fun $- c_runInteractiveProcess pcmdline pWorkDir pEnv- fdin fdout fderr+ c_runInteractiveProcessHANDLE pcmdline pWorkDir pEnv+ hwnd_in hwnd_out hwnd_err pfdStdInput pfdStdOutput pfdStdError ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0) .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)@@ -143,18 +241,21 @@ use_job hJob - hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode- hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode- hndStdError <- mbPipe mb_stderr pfdStdError ReadMode+ -- Attach the handle to the I/O manager's CompletionPort. This allows the+ -- I/O manager to service requests for this Handle.+ Mgr.associateHandle' =<< peek pfdStdInput+ Mgr.associateHandle' =<< peek pfdStdOutput+ Mgr.associateHandle' =<< peek pfdStdError - phJob <- peek hJob- ph <- mkProcessHandle proc_handle phJob- return ProcRetHandles { hStdInput = hndStdInput- , hStdOutput = hndStdOutput- , hStdError = hndStdError- , procHandle = ph- }+ -- Create the haskell mode handles as files.+ hndStdInput <- mbPipeHANDLE mb_stdin pfdStdInput WriteMode+ hndStdOutput <- mbPipeHANDLE mb_stdout pfdStdOutput ReadMode+ hndStdError <- mbPipeHANDLE mb_stderr pfdStdError ReadMode + return (proc_handle, hndStdInput, hndStdOutput, hndStdError)++##endif+ {-# NOINLINE runInteractiveProcess_lock #-} runInteractiveProcess_lock :: MVar () runInteractiveProcess_lock = unsafePerformIO $ newMVar ()@@ -178,14 +279,18 @@ -- ---------------------------------------------------------------------------- -- Interface to C I/O CP bits -terminateJob :: ProcessHandle -> CUInt -> IO Bool-terminateJob jh ecode =- withProcessHandle jh $ \p_ -> do+-- | Variant of terminateJob that is not thread-safe+terminateJobUnsafe :: ProcessHandle__ -> CUInt -> IO Bool+terminateJobUnsafe p_ ecode = do case p_ of ClosedHandle _ -> return False OpenHandle _ -> return False OpenExtHandle _ job -> c_terminateJobObject job ecode +terminateJob :: ProcessHandle -> CUInt -> IO Bool+terminateJob jh ecode =+ withProcessHandle jh $ \p_ -> terminateJobUnsafe p_ ecode+ timeout_Infinite :: CUInt timeout_Infinite = 0xFFFFFFFF @@ -224,6 +329,24 @@ -> Ptr PHANDLE -- Handle to Job -> IO PHANDLE +##if defined(__IO_MANAGER_WINIO__)+foreign import ccall unsafe "runInteractiveProcessHANDLE"+ c_runInteractiveProcessHANDLE+ :: CWString+ -> CWString+ -> Ptr CWString+ -> HANDLE+ -> HANDLE+ -> HANDLE+ -> Ptr HANDLE+ -> Ptr HANDLE+ -> Ptr HANDLE+ -> CInt -- flags+ -> Bool -- useJobObject+ -> Ptr PHANDLE -- Handle to Job+ -> IO PHANDLE+##endif+ commandToProcess :: CmdSpec -> IO (FilePath, String)@@ -299,7 +422,14 @@ isDefaultSignal = const False createPipeInternal :: IO (Handle, Handle)-createPipeInternal = do+##if defined(__IO_MANAGER_WINIO__)+createPipeInternal = createPipeInternalPosix <!> createPipeInternalHANDLE+##else+createPipeInternal = createPipeInternalPosix+##endif++createPipeInternalPosix :: IO (Handle, Handle)+createPipeInternalPosix = do (readfd, writefd) <- createPipeInternalFd (do readh <- fdToHandle readfd writeh <- fdToHandle writefd@@ -313,6 +443,21 @@ writefd <- peekElemOff pfds 1 return (readfd, writefd) +##if defined(__IO_MANAGER_WINIO__)+createPipeInternalHANDLE :: IO (Handle, Handle)+createPipeInternalHANDLE =+ alloca $ \ pfdStdInput ->+ alloca $ \ pfdStdOutput -> do+ throwErrnoIf_ (==False) "c_mkNamedPipe" $+ c_mkNamedPipe pfdStdInput True pfdStdOutput True+ Just hndStdInput <- mbPipeHANDLE CreatePipe pfdStdInput WriteMode+ Just hndStdOutput <- mbPipeHANDLE CreatePipe pfdStdOutput ReadMode+ return (hndStdInput, hndStdOutput)+++foreign import ccall "mkNamedPipe" c_mkNamedPipe ::+ Ptr HANDLE -> Bool -> Ptr HANDLE -> Bool -> IO Bool+##endif close' :: CInt -> IO () close' = throwErrnoIfMinus1_ "_close" . c__close
+ cbits/posix/runProcess.c view
@@ -0,0 +1,481 @@+/* ----------------------------------------------------------------------------+ (c) The University of Glasgow 2004-2020++ Support for System.Process+ ------------------------------------------------------------------------- */++/* XXX This is a nasty hack; should put everything necessary in this package */+#include "HsBase.h"+#include "Rts.h"++#include "runProcess.h"++#include "execvpe.h"++/* ----------------------------------------------------------------------------+ UNIX versions+ ------------------------------------------------------------------------- */++// If a process was terminated by a signal, the exit status we return+// via the System.Process API is (-signum). This encoding avoids collision with+// normal process termination status codes. See also #7229.+#define TERMSIG_EXITSTATUS(s) (-(WTERMSIG(s)))++static long max_fd = 0;++// Rts internal API, not exposed in a public header file:+extern void blockUserSignals(void);+extern void unblockUserSignals(void);++// These are arbitrarily chosen -- JP+#define forkSetgidFailed 124+#define forkSetuidFailed 125++// 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.+#define forkChdirFailed 126+#define forkExecFailed 127++#define forkGetpwuidFailed 128+#define forkInitgroupsFailed 129++__attribute__((__noreturn__))+static void childFailed(int pipe, int failCode) {+ int err;+ ssize_t unused __attribute__((unused));++ err = errno;+ unused = write(pipe, &failCode, sizeof(failCode));+ unused = write(pipe, &err, sizeof(err));+ // As a fallback, exit with the failCode+ _exit(failCode);+}++ProcHandle+runInteractiveProcess (char *const args[],+ char *workingDirectory, char **environment,+ int fdStdIn, int fdStdOut, int fdStdErr,+ int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,+ gid_t *childGroup, uid_t *childUser,+ int reset_int_quit_handlers,+ int flags,+ char **failed_doing)+{+ int close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0);+ int pid;+ int fdStdInput[2], fdStdOutput[2], fdStdError[2];+ int forkCommunicationFds[2];+ int r;+ int failCode, err;++ // Ordering matters here, see below [Note #431].+ if (fdStdIn == -1) {+ r = pipe(fdStdInput);+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: pipe";+ return -1;+ }+ }+ if (fdStdOut == -1) {+ r = pipe(fdStdOutput);+ if (r == -1) {+ if (fdStdIn == -1) {+ close(fdStdInput[0]);+ close(fdStdInput[1]);+ }+ *failed_doing = "runInteractiveProcess: pipe";+ return -1;+ }+ }+ if (fdStdErr == -1) {+ r = pipe(fdStdError);+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: pipe";+ if (fdStdIn == -1) {+ close(fdStdInput[0]);+ close(fdStdInput[1]);+ }+ if (fdStdOut == -1) {+ close(fdStdOutput[0]);+ close(fdStdOutput[1]);+ }+ return -1;+ }+ }++ r = pipe(forkCommunicationFds);+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: pipe";+ 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;+ }++ // 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 = myfork())+ {+ case -1:+ unblockUserSignals();+ startTimer();+ 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]);+ }+ close(forkCommunicationFds[0]);+ close(forkCommunicationFds[1]);+ *failed_doing = "fork";+ return -1;++ case 0:+ // WARNING! We may now be in the child of vfork(), and any+ // memory we modify below may also be seen in the parent+ // process.++ close(forkCommunicationFds[0]);+ fcntl(forkCommunicationFds[1], F_SETFD, FD_CLOEXEC);++ if ((flags & RUN_PROCESS_NEW_SESSION) != 0) {+ setsid();+ }+ if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {+ setpgid(0, 0);+ }++ if ( childGroup) {+ if ( setgid( *childGroup) != 0) {+ // ERROR+ childFailed(forkCommunicationFds[1], forkSetgidFailed);+ }+ }++ if ( childUser) {+ // Using setuid properly first requires that we initgroups.+ // However, to do this we must know the username of the user we are+ // switching to.+ struct passwd pw;+ struct passwd *res = NULL;+ int buf_len = sysconf(_SC_GETPW_R_SIZE_MAX);+ char *buf = malloc(buf_len);+ gid_t suppl_gid = childGroup ? *childGroup : getgid();+ if ( getpwuid_r(*childUser, &pw, buf, buf_len, &res) != 0) {+ childFailed(forkCommunicationFds[1], forkGetpwuidFailed);+ }+ if ( res == NULL ) {+ childFailed(forkCommunicationFds[1], forkGetpwuidFailed);+ }+ if ( initgroups(res->pw_name, suppl_gid) != 0) {+ childFailed(forkCommunicationFds[1], forkInitgroupsFailed);+ }+ if ( setuid( *childUser) != 0) {+ // ERROR+ childFailed(forkCommunicationFds[1], forkSetuidFailed);+ }+ }++ unblockUserSignals();++ if (workingDirectory) {+ if (chdir (workingDirectory) < 0) {+ childFailed(forkCommunicationFds[1], forkChdirFailed);+ }+ }++ // [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 if (fdStdIn == -2) {+ close(STDIN_FILENO);+ } 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 if (fdStdOut == -2) {+ close(STDOUT_FILENO);+ } 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 if (fdStdErr == -2) {+ close(STDERR_FILENO);+ } 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+ }+ // XXX Not the pipe+ for (i = 3; i < max_fd; i++) {+ if (i != forkCommunicationFds[1]) {+ close(i);+ }+ }+ }++ /* Reset the SIGINT/SIGQUIT signal handlers in the child, if requested+ */+ if (reset_int_quit_handlers) {+ struct sigaction dfl;+ (void)sigemptyset(&dfl.sa_mask);+ dfl.sa_flags = 0;+ dfl.sa_handler = SIG_DFL;+ (void)sigaction(SIGINT, &dfl, NULL);+ (void)sigaction(SIGQUIT, &dfl, NULL);+ }++ /* the child */+ if (environment) {+ // XXX Check result+ execvpe(args[0], args, environment);+ } else {+ // XXX Check result+ execvp(args[0], args);+ }++ childFailed(forkCommunicationFds[1], forkExecFailed);++ 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];+ }+ close(forkCommunicationFds[1]);+ fcntl(forkCommunicationFds[0], F_SETFD, FD_CLOEXEC);++ break;+ }++ // If the child process had a problem, then it will tell us via the+ // forkCommunicationFds pipe. First we try to read what the problem+ // was. Note that if none of these conditionals match then we fall+ // through and just return pid.+ r = read(forkCommunicationFds[0], &failCode, sizeof(failCode));+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: read pipe";+ pid = -1;+ }+ else if (r == sizeof(failCode)) {+ // This is the case where we successfully managed to read+ // the problem+ switch (failCode) {+ case forkChdirFailed:+ *failed_doing = "runInteractiveProcess: chdir";+ break;+ case forkExecFailed:+ *failed_doing = "runInteractiveProcess: exec";+ break;+ case forkSetgidFailed:+ *failed_doing = "runInteractiveProcess: setgid";+ break;+ case forkSetuidFailed:+ *failed_doing = "runInteractiveProcess: setuid";+ break;+ case forkGetpwuidFailed:+ *failed_doing = "runInteractiveProcess: getpwuid";+ break;+ case forkInitgroupsFailed:+ *failed_doing = "runInteractiveProcess: initgroups";+ break;+ default:+ *failed_doing = "runInteractiveProcess: unknown";+ break;+ }+ // Now we try to get the errno from the child+ r = read(forkCommunicationFds[0], &err, sizeof(err));+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: read pipe";+ }+ else if (r != sizeof(failCode)) {+ *failed_doing = "runInteractiveProcess: read pipe bad length";+ }+ else {+ // If we succeed then we set errno. It'll be saved and+ // restored again below. Note that in any other case we'll+ // get the errno of whatever else went wrong instead.+ errno = err;+ }++ // We forked the child, but the child had a problem and stopped so it's+ // our responsibility to reap here as nobody else can.+ waitpid(pid, NULL, 0);++ if (fdStdIn == -1) {+ // Already closed fdStdInput[0] above+ close(fdStdInput[1]);+ }+ if (fdStdOut == -1) {+ close(fdStdOutput[0]);+ // Already closed fdStdOutput[1] above+ }+ if (fdStdErr == -1) {+ close(fdStdError[0]);+ // Already closed fdStdError[1] above+ }++ pid = -1;+ }+ else if (r != 0) {+ *failed_doing = "runInteractiveProcess: read pipe bad length";+ pid = -1;+ }++ if (pid == -1) {+ err = errno;+ }++ close(forkCommunicationFds[0]);++ unblockUserSignals();+ startTimer();++ if (pid == -1) {+ errno = err;+ }++ 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))+ {+ *pExitCode = TERMSIG_EXITSTATUS(wstat);+ 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 = TERMSIG_EXITSTATUS(wstat);+ return 0;+ }+ else+ {+ /* This should never happen */+ }+ }++ return -1;+}
− cbits/runProcess.c
@@ -1,923 +0,0 @@-/* ----------------------------------------------------------------------------- (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- ------------------------------------------------------------------------- */--// If a process was terminated by a signal, the exit status we return-// via the System.Process API is (-signum). This encoding avoids collision with-// normal process termination status codes. See also #7229.-#define TERMSIG_EXITSTATUS(s) (-(WTERMSIG(s)))--static long max_fd = 0;--// Rts internal API, not exposed in a public header file:-extern void blockUserSignals(void);-extern void unblockUserSignals(void);--// These are arbitrarily chosen -- JP-#define forkSetgidFailed 124-#define forkSetuidFailed 125--// 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.-#define forkChdirFailed 126-#define forkExecFailed 127--#define forkGetpwuidFailed 128-#define forkInitgroupsFailed 129--__attribute__((__noreturn__))-static void childFailed(int pipe, int failCode) {- int err;- ssize_t unused __attribute__((unused));-- err = errno;- unused = write(pipe, &failCode, sizeof(failCode));- unused = write(pipe, &err, sizeof(err));- // As a fallback, exit with the failCode- _exit(failCode);-}--ProcHandle-runInteractiveProcess (char *const args[],- char *workingDirectory, char **environment,- int fdStdIn, int fdStdOut, int fdStdErr,- int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,- gid_t *childGroup, uid_t *childUser,- int reset_int_quit_handlers,- int flags,- char **failed_doing)-{- int close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0);- int pid;- int fdStdInput[2], fdStdOutput[2], fdStdError[2];- int forkCommunicationFds[2];- int r;- int failCode, err;-- // Ordering matters here, see below [Note #431].- if (fdStdIn == -1) {- r = pipe(fdStdInput);- if (r == -1) {- *failed_doing = "runInteractiveProcess: pipe";- return -1;- }- }- if (fdStdOut == -1) {- r = pipe(fdStdOutput);- if (r == -1) {- if (fdStdIn == -1) {- close(fdStdInput[0]);- close(fdStdInput[1]);- }- *failed_doing = "runInteractiveProcess: pipe";- return -1;- }- }- if (fdStdErr == -1) {- r = pipe(fdStdError);- if (r == -1) {- *failed_doing = "runInteractiveProcess: pipe";- if (fdStdIn == -1) {- close(fdStdInput[0]);- close(fdStdInput[1]);- }- if (fdStdOut == -1) {- close(fdStdOutput[0]);- close(fdStdOutput[1]);- }- return -1;- }- }-- r = pipe(forkCommunicationFds);- if (r == -1) {- *failed_doing = "runInteractiveProcess: pipe";- 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;- }-- // 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 = myfork())- {- case -1:- unblockUserSignals();- startTimer();- 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]);- }- close(forkCommunicationFds[0]);- close(forkCommunicationFds[1]);- *failed_doing = "fork";- return -1;-- case 0:- // WARNING! We may now be in the child of vfork(), and any- // memory we modify below may also be seen in the parent- // process.-- close(forkCommunicationFds[0]);- fcntl(forkCommunicationFds[1], F_SETFD, FD_CLOEXEC);-- if ((flags & RUN_PROCESS_NEW_SESSION) != 0) {- setsid();- }- if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {- setpgid(0, 0);- }-- if ( childGroup) {- if ( setgid( *childGroup) != 0) {- // ERROR- childFailed(forkCommunicationFds[1], forkSetgidFailed);- }- }-- if ( childUser) {- // Using setuid properly first requires that we initgroups.- // However, to do this we must know the username of the user we are- // switching to.- struct passwd pw;- struct passwd *res = NULL;- int buf_len = sysconf(_SC_GETPW_R_SIZE_MAX);- char *buf = malloc(buf_len);- gid_t suppl_gid = childGroup ? *childGroup : getgid();- if ( getpwuid_r(*childUser, &pw, buf, buf_len, &res) != 0) {- childFailed(forkCommunicationFds[1], forkGetpwuidFailed);- }- if ( res == NULL ) {- childFailed(forkCommunicationFds[1], forkGetpwuidFailed);- }- if ( initgroups(res->pw_name, suppl_gid) != 0) {- childFailed(forkCommunicationFds[1], forkInitgroupsFailed);- }- if ( setuid( *childUser) != 0) {- // ERROR- childFailed(forkCommunicationFds[1], forkSetuidFailed);- }- }-- unblockUserSignals();-- if (workingDirectory) {- if (chdir (workingDirectory) < 0) {- childFailed(forkCommunicationFds[1], forkChdirFailed);- }- }-- // [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 if (fdStdIn == -2) {- close(STDIN_FILENO);- } 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 if (fdStdOut == -2) {- close(STDOUT_FILENO);- } 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 if (fdStdErr == -2) {- close(STDERR_FILENO);- } 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- }- // XXX Not the pipe- for (i = 3; i < max_fd; i++) {- if (i != forkCommunicationFds[1]) {- close(i);- }- }- }-- /* Reset the SIGINT/SIGQUIT signal handlers in the child, if requested- */- if (reset_int_quit_handlers) {- struct sigaction dfl;- (void)sigemptyset(&dfl.sa_mask);- dfl.sa_flags = 0;- dfl.sa_handler = SIG_DFL;- (void)sigaction(SIGINT, &dfl, NULL);- (void)sigaction(SIGQUIT, &dfl, NULL);- }-- /* the child */- if (environment) {- // XXX Check result- execvpe(args[0], args, environment);- } else {- // XXX Check result- execvp(args[0], args);- }-- childFailed(forkCommunicationFds[1], forkExecFailed);-- 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];- }- close(forkCommunicationFds[1]);- fcntl(forkCommunicationFds[0], F_SETFD, FD_CLOEXEC);-- break;- }-- // If the child process had a problem, then it will tell us via the- // forkCommunicationFds pipe. First we try to read what the problem- // was. Note that if none of these conditionals match then we fall- // through and just return pid.- r = read(forkCommunicationFds[0], &failCode, sizeof(failCode));- if (r == -1) {- *failed_doing = "runInteractiveProcess: read pipe";- pid = -1;- }- else if (r == sizeof(failCode)) {- // This is the case where we successfully managed to read- // the problem- switch (failCode) {- case forkChdirFailed:- *failed_doing = "runInteractiveProcess: chdir";- break;- case forkExecFailed:- *failed_doing = "runInteractiveProcess: exec";- break;- case forkSetgidFailed:- *failed_doing = "runInteractiveProcess: setgid";- break;- case forkSetuidFailed:- *failed_doing = "runInteractiveProcess: setuid";- break;- case forkGetpwuidFailed:- *failed_doing = "runInteractiveProcess: getpwuid";- break;- case forkInitgroupsFailed:- *failed_doing = "runInteractiveProcess: initgroups";- break;- default:- *failed_doing = "runInteractiveProcess: unknown";- break;- }- // Now we try to get the errno from the child- r = read(forkCommunicationFds[0], &err, sizeof(err));- if (r == -1) {- *failed_doing = "runInteractiveProcess: read pipe";- }- else if (r != sizeof(failCode)) {- *failed_doing = "runInteractiveProcess: read pipe bad length";- }- else {- // If we succeed then we set errno. It'll be saved and- // restored again below. Note that in any other case we'll- // get the errno of whatever else went wrong instead.- errno = err;- }-- // We forked the child, but the child had a problem and stopped so it's- // our responsibility to reap here as nobody else can.- waitpid(pid, NULL, 0);-- if (fdStdIn == -1) {- // Already closed fdStdInput[0] above- close(fdStdInput[1]);- }- if (fdStdOut == -1) {- close(fdStdOutput[0]);- // Already closed fdStdOutput[1] above- }- if (fdStdErr == -1) {- close(fdStdError[0]);- // Already closed fdStdError[1] above- }-- pid = -1;- }- else if (r != 0) {- *failed_doing = "runInteractiveProcess: read pipe bad length";- pid = -1;- }-- if (pid == -1) {- err = errno;- }-- close(forkCommunicationFds[0]);-- unblockUserSignals();- startTimer();-- if (pid == -1) {- errno = err;- }-- 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))- {- *pExitCode = TERMSIG_EXITSTATUS(wstat);- 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 = TERMSIG_EXITSTATUS(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;-}--static HANDLE-createJob ()-{- HANDLE hJob = CreateJobObject (NULL, NULL);- JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli;- ZeroMemory(&jeli, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION));- // Configure all child processes associated with the job to terminate when the- // Last process in the job terminates. This prevent half dead processes.- jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;-- if (SetInformationJobObject (hJob, JobObjectExtendedLimitInformation,- &jeli, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION)))- {- return hJob;- }-- maperrno();- return NULL;-}--/* Note [Windows exec interaction]-- The basic issue that process jobs tried to solve is this:-- Say you have two programs A and B. Now A calls B. There are two ways to do this. - - 1) You can use the normal CreateProcess API, which is what normal Windows code do. - Using this approach, the current waitForProcess works absolutely fine. - 2) You can call the emulated POSIX function _exec, which of course is supposed to - allow the child process to replace the parent. - - With approach 2) waitForProcess falls apart because the Win32's process model does - not allow this the same way as linux. _exec is emulated by first making a call to - CreateProcess to spawn B and then immediately exiting from A. So you have two - different processes. - - waitForProcess is waiting on the termination of A. Because A is immediately killed, - waitForProcess will return even though B is still running. This is why for instance - the GHC testsuite on Windows had lots of file locked errors. - - This approach creates a new Job and assigned A to the job, but also all future - processes spawned by A. This allows us to listen in on events, such as, when all - processes in the job are finished, but also allows us to propagate exit codes from - _exec calls. - - The only reason we need this at all is because we don't interact with just actual- native code on Windows, and instead have a lot of ported POSIX code.-- The Job handle is returned to the user because Jobs have additional benefits as well,- such as allowing you to specify resource limits on the to be spawned process.- */--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, bool useJobObject, HANDLE *hJob)-{- 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;- ZeroMemory(&pInfo, sizeof(pInfo));-- if (fdStdIn == -1) {- if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE))- goto cleanup_err;- sInfo.hStdInput = hStdInputRead;- } else if (fdStdIn == -2) {- sInfo.hStdInput = NULL;- } 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 == -2) {- sInfo.hStdOutput = NULL;- } 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) {- sInfo.hStdError = NULL;- } 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 ((flags & RUN_PROCESS_DETACHED) != 0) {- dwFlags |= DETACHED_PROCESS;- }- if ((flags & RUN_PROCESS_NEW_CONSOLE) != 0) {- dwFlags |= CREATE_NEW_CONSOLE;- }-- /* If we're going to use a job object, then we have to create- the thread suspended.- See Note [Windows exec interaction]. */- if (useJobObject)- {- dwFlags |= CREATE_SUSPENDED;- *hJob = createJob();- if (!*hJob)- {- goto cleanup_err;- }- } else {- *hJob = NULL;- }-- if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo))- {- goto cleanup_err;- }-- if (useJobObject && hJob && *hJob)- {- // Then associate the process and the job;- if (!AssignProcessToJobObject (*hJob, pInfo.hProcess))- {- goto cleanup_err;- }-- // And now that we've associated the new process with the job- // we can actively resume it.- ResumeThread (pInfo.hThread);- }-- 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);- if (useJobObject && hJob && *hJob ) CloseHandle(*hJob);-- maperrno();- return NULL;-}--int-terminateProcess (ProcHandle handle)-{- if (!TerminateProcess ((HANDLE) handle, 1)) {- DWORD e = GetLastError();- DWORD exitCode;- /*- This is a crude workaround that is taken from libuv. For some reason- TerminateProcess() can fail with ERROR_ACCESS_DENIED if the process- already terminated. This situation can be detected by using- GetExitCodeProcess() to check if the exit code is availble. Unfortunately- this function succeeds and gives exit code 259 (STILL_ACTIVE) if the- process is still running. So there is no way to ditinguish a process- that exited with 259 and a process that did not exit because we had- insufficient access to terminate it.- One would expect WaitForSingleObject() to be the solid solution. But this- function does return WAIT_TIMEOUT in that situation. Even if called- after GetExitCodeProcess().- */- if (e == ERROR_ACCESS_DENIED && GetExitCodeProcess((HANDLE) handle, &exitCode) && exitCode != STILL_ACTIVE)- return 0;-- SetLastError(e);- maperrno();- return -1;- }- return 0;-}--int-terminateJob (ProcHandle handle)-{- if (!TerminateJobObject ((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;-}--// Returns true on success.-int-waitForJobCompletion ( HANDLE hJob )-{- int process_count = 16;- JOBOBJECT_BASIC_PROCESS_ID_LIST *pid_list = NULL;-- while (true) {- size_t pid_list_size = sizeof(JOBOBJECT_BASIC_PROCESS_ID_LIST) + sizeof(ULONG_PTR) * (process_count - 1);-- if (pid_list == NULL) {- pid_list = malloc(pid_list_size);- pid_list->NumberOfAssignedProcesses = process_count;- }-- // Find a process in the job...- bool success = QueryInformationJobObject(- hJob,- JobObjectBasicProcessIdList,- pid_list,- pid_list_size,- NULL);-- if (!success && GetLastError() == ERROR_MORE_DATA) {- process_count *= 2;- free(pid_list);- pid_list = NULL;- continue;- } else if (!success) {- free(pid_list);- maperrno();- return false;- }- if (pid_list->NumberOfProcessIdsInList == 0) {- // We're done- free(pid_list);- return true;- }-- HANDLE pHwnd = OpenProcess(SYNCHRONIZE, TRUE, pid_list->ProcessIdList[0]);- if (pHwnd == NULL) {- switch (GetLastError()) {- case ERROR_INVALID_PARAMETER:- case ERROR_INVALID_HANDLE:- // Presumably the process terminated; try again.- continue;- default:- free(pid_list);- maperrno();- return false;- }- }-- // Wait for it to finish...- if (WaitForSingleObject(pHwnd, INFINITE) != WAIT_OBJECT_0) {- free(pid_list);- maperrno();- CloseHandle(pHwnd);- return false;- }-- // The process signalled, loop again to try the next process.- CloseHandle(pHwnd);- }-}--#endif /* Win32 */
+ cbits/win32/runProcess.c view
@@ -0,0 +1,608 @@+/* ----------------------------------------------------------------------------+ (c) The University of Glasgow 2004-2022++ Support for System.Process+ ------------------------------------------------------------------------- */++#define UNICODE++/* XXX This is a nasty hack; should put everything necessary in this package */+#include "HsBase.h"+#include "Rts.h"++#include "runProcess.h"++#include <assert.h>+#include <windows.h>+#include <io.h>+#include <objbase.h>+#include <wchar.h>++/* ----------------------------------------------------------------------------+ 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;+}++/*+ * Function: mkNamedPipe+ *+ * Purpose: create an named pipe with read and write ends being+ * optionally (non-)inheritable. Named pipes can be read+ * asynchronously while anonymous pipes require blocking calls.+ */+BOOL+mkNamedPipe (HANDLE* pHandleIn, BOOL isInheritableIn,+ HANDLE* pHandleOut, BOOL isInheritableOut)+{+ HANDLE hTemporaryIn = INVALID_HANDLE_VALUE;+ HANDLE hTemporaryOut = INVALID_HANDLE_VALUE;+ RPC_WSTR guidStr = NULL;+ GUID guid;++ /* First we create a new GUID to make the name of the pipe unique. Since+ GUID are guaranteed to be unique system wide we don't need to retry. */+ ZeroMemory (&guid, sizeof (guid));+ if (CoCreateGuid (&guid) != S_OK)+ goto fail;++ if (UuidToStringW ((UUID*)&guid, &guidStr) != S_OK)+ goto fail;++ /* Now we create the pipe name. */+ wchar_t pipeName[MAX_PATH];+ if (-1 == swprintf_s (&pipeName[0], MAX_PATH, L"\\\\.\\pipe\\haskell:process:%ls\n", guidStr))+ goto fail;++ const int buffer_size = 8 * 1024;++ RpcStringFreeW (&guidStr);++ SECURITY_ATTRIBUTES secAttr;+ ZeroMemory (&secAttr, sizeof(secAttr));+ secAttr.nLength = sizeof(SECURITY_ATTRIBUTES);+ secAttr.lpSecurityDescriptor = NULL;+ secAttr.bInheritHandle = isInheritableIn;++ /* Create one end of the pipe. Named pipes are a bit less secure than+ anonymous pipes. Because of this we restrict the pipe's access to only+ one client and also only the local host. This means after we create the+ other end of the pipe it should be as secure as an anonymous pipe. */+ hTemporaryIn+ = CreateNamedPipeW (&pipeName[0],+ PIPE_ACCESS_INBOUND | FILE_FLAG_OVERLAPPED | FILE_FLAG_FIRST_PIPE_INSTANCE,+ PIPE_TYPE_MESSAGE | PIPE_REJECT_REMOTE_CLIENTS,+ 1, buffer_size, buffer_size,+ 0,+ &secAttr);+ if (hTemporaryIn == INVALID_HANDLE_VALUE)+ goto fail;++ /* And now create the other end using the inverse access permissions. This+ will give us the read and write ends of the pipe. */+ secAttr.bInheritHandle = isInheritableOut;+ hTemporaryOut+ = CreateFileW (&pipeName[0],+ GENERIC_WRITE,+ FILE_SHARE_WRITE,+ &secAttr,+ OPEN_EXISTING,+ FILE_FLAG_OVERLAPPED,+ NULL);+ if (hTemporaryOut == INVALID_HANDLE_VALUE)+ goto fail;++ /* Set some optimization flags to make the I/O manager operate more+ efficiently on these handles. These mirrors those in+ `optimizeFileAccess` but we set them here to do so before any data has+ been put in the HANDLEs. However these don't always work for sockets and+ pipes. So we set them, but can't rely on it. */+#if defined(FILE_SKIP_SET_EVENT_ON_HANDLE) && \+ defined(FILE_SKIP_COMPLETION_PORT_ON_SUCCESS)+ UCHAR flags = FILE_SKIP_COMPLETION_PORT_ON_SUCCESS+ | FILE_SKIP_SET_EVENT_ON_HANDLE;+ SetFileCompletionNotificationModes (hTemporaryIn, flags);+ SetFileCompletionNotificationModes (hTemporaryOut, flags);+#endif++ /* Everything has succeeded so now copy the pointers to the results. */+ *pHandleIn = hTemporaryIn;+ *pHandleOut = hTemporaryOut;++ return TRUE;++fail:+ /* We have to save the current error before we do another API call. */+ maperrno();+ RpcStringFreeW (&guidStr);+ if (INVALID_HANDLE_VALUE != hTemporaryIn ) CloseHandle (hTemporaryIn);+ if (INVALID_HANDLE_VALUE != hTemporaryOut) CloseHandle (hTemporaryOut);+ return FALSE;+}++static HANDLE+createJob ()+{+ HANDLE hJob = CreateJobObject (NULL, NULL);+ JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli;+ ZeroMemory(&jeli, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION));+ // Configure all child processes associated with the job to terminate when the+ // Last process in the job terminates. This prevent half dead processes.+ jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;++ if (SetInformationJobObject (hJob, JobObjectExtendedLimitInformation,+ &jeli, sizeof(JOBOBJECT_EXTENDED_LIMIT_INFORMATION)))+ {+ return hJob;+ }++ maperrno();+ return NULL;+}++/* Small helper function that determines how the std handle should be used.+ if _STDHANDLE is:+ -1: A new pipe is created. If ASYNCHRONOUS an asynchronous pipe is created+ with FILE_FLAG_OVERLAPPED set. If not then an anonymouse pipe is+ created without that flag.+ -2: No handle is created, DESTINATION is NULL.+ std: If the handle matches the default std handle for the type (i.e. if the+ handle for input _stdHandle mathed STDIN) then set DESTINATION to that+ handle.+ otherwise: We just duplicate the handle to make it inheritable and pass it+ on. */++static inline bool+setStdHandleInfo (LPHANDLE destination, HANDLE _stdhandle,+ LPHANDLE hStdRead, LPHANDLE hStdWrite, HANDLE defaultStd,+ BOOL isInhertibleIn, BOOL isInhertibleOut, BOOL asynchronous)+{+ BOOL status;+ assert (destination);+ assert (hStdRead);+ assert (hStdWrite);++ LPHANDLE tmpHandle = isInhertibleOut ? hStdWrite : hStdRead;++ if (_stdhandle == (HANDLE)-1) {+ if (!asynchronous+ && !mkAnonPipe(hStdRead, isInhertibleIn, hStdWrite, isInhertibleOut))+ return false;+ if (asynchronous+ && !mkNamedPipe(hStdRead, isInhertibleIn, hStdWrite, isInhertibleOut))+ return false;+ *destination = *tmpHandle;+ } else if (_stdhandle == (HANDLE)-2) {+ *destination = NULL;+ } else if (_stdhandle == defaultStd) {+ // Don't duplicate standard handle, as console handles cannot be+ // duplicated and inherited. urg.+ *destination = defaultStd;+ } else {+ // The handle might not be inheritable, so duplicate it+ status = DuplicateHandle(GetCurrentProcess(),+ _stdhandle,+ GetCurrentProcess(), tmpHandle,+ 0,+ TRUE, /* inheritable */+ DUPLICATE_SAME_ACCESS);+ if (!status) return false;+ *destination = *tmpHandle;+ }++ return true;+}++/* Common functionality between the Posix FD version and native HANDLE version+ of runInteractiveProcess. The main difference lies in the use of+ ASYNCHRONOUS which indicates whether the pipes that are created allow for+ asynchronous access or not. */++static ProcHandle+runInteractiveProcessWrapper (+ wchar_t *cmd, wchar_t *workingDirectory,+ wchar_t *environment,+ HANDLE _stdin, HANDLE _stdout, HANDLE _stderr,+ HANDLE *pStdInput, HANDLE *pStdOutput, HANDLE *pStdError,+ int flags, bool useJobObject, HANDLE *hJob, bool asynchronous)+{+ 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 inherit;++ ZeroMemory(&sInfo, sizeof(sInfo));+ sInfo.cb = sizeof(sInfo);+ sInfo.dwFlags = STARTF_USESTDHANDLES;+ ZeroMemory(&pInfo, sizeof(pInfo));++ HANDLE defaultStdIn = GetStdHandle(STD_INPUT_HANDLE);+ HANDLE defaultStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);+ HANDLE defaultStdError = GetStdHandle(STD_ERROR_HANDLE);++ if (!setStdHandleInfo (&sInfo.hStdInput, _stdin, &hStdInputRead,+ &hStdInputWrite, defaultStdIn, TRUE, FALSE,+ asynchronous))+ goto cleanup_err;++ if (!setStdHandleInfo (&sInfo.hStdOutput, _stdout, &hStdOutputRead,+ &hStdOutputWrite, defaultStdOutput, FALSE, TRUE,+ asynchronous))+ goto cleanup_err;++ if (!setStdHandleInfo (&sInfo.hStdError, _stderr, &hStdErrorRead,+ &hStdErrorWrite, defaultStdError, FALSE, TRUE,+ asynchronous))+ goto cleanup_err;++ if (sInfo.hStdInput != defaultStdIn+ && sInfo.hStdOutput != defaultStdOutput+ && sInfo.hStdError != defaultStdError+ && (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+ && _stdin == defaultStdIn+ && _stdout == defaultStdOutput+ && _stderr == defaultStdError) {+ inherit = FALSE;+ } else {+ inherit = TRUE;+ }++ if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {+ dwFlags |= CREATE_NEW_PROCESS_GROUP;+ }+ if ((flags & RUN_PROCESS_DETACHED) != 0) {+ dwFlags |= DETACHED_PROCESS;+ }+ if ((flags & RUN_PROCESS_NEW_CONSOLE) != 0) {+ dwFlags |= CREATE_NEW_CONSOLE;+ }++ /* If we're going to use a job object, then we have to create+ the thread suspended.+ See Note [Windows exec interaction]. */+ if (useJobObject)+ {+ dwFlags |= CREATE_SUSPENDED;+ *hJob = createJob();+ if (!*hJob)+ {+ goto cleanup_err;+ }+ } else {+ *hJob = NULL;+ }++ if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo))+ {+ goto cleanup_err;+ }++ if (useJobObject && hJob && *hJob)+ {+ // Then associate the process and the job;+ if (!AssignProcessToJobObject (*hJob, pInfo.hProcess))+ {+ goto cleanup_err;+ }++ // And now that we've associated the new process with the job+ // we can actively resume it.+ ResumeThread (pInfo.hThread);+ }++ 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);++ // Return the pointers to the handles we need.+ *pStdInput = hStdInputWrite;+ *pStdOutput = hStdOutputRead;+ *pStdError = hStdErrorRead;++ 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);+ if (useJobObject && hJob && *hJob ) CloseHandle(*hJob);++ maperrno();+ return NULL;+}++/* Note [Windows exec interaction]++ The basic issue that process jobs tried to solve is this:++ Say you have two programs A and B. Now A calls B. There are two ways to do this.++ 1) You can use the normal CreateProcess API, which is what normal Windows code do.+ Using this approach, the current waitForProcess works absolutely fine.+ 2) You can call the emulated POSIX function _exec, which of course is supposed to+ allow the child process to replace the parent.++ With approach 2) waitForProcess falls apart because the Win32's process model does+ not allow this the same way as linux. _exec is emulated by first making a call to+ CreateProcess to spawn B and then immediately exiting from A. So you have two+ different processes.++ waitForProcess is waiting on the termination of A. Because A is immediately killed,+ waitForProcess will return even though B is still running. This is why for instance+ the GHC testsuite on Windows had lots of file locked errors.++ This approach creates a new Job and assigned A to the job, but also all future+ processes spawned by A. This allows us to listen in on events, such as, when all+ processes in the job are finished, but also allows us to propagate exit codes from+ _exec calls.++ The only reason we need this at all is because we don't interact with just actual+ native code on Windows, and instead have a lot of ported POSIX code.++ The Job handle is returned to the user because Jobs have additional benefits as well,+ such as allowing you to specify resource limits on the to be spawned process.+ */+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, bool useJobObject, HANDLE *hJob)+{+ HANDLE pStdInput = INVALID_HANDLE_VALUE;+ HANDLE pStdOutput = INVALID_HANDLE_VALUE;+ HANDLE pStdError = INVALID_HANDLE_VALUE;++ ProcHandle result+ = runInteractiveProcessWrapper (cmd, workingDirectory, environment,+ (HANDLE) (fdStdIn < 0 ? fdStdIn : _get_osfhandle(fdStdIn)),+ (HANDLE) (fdStdOut < 0 ? fdStdOut : _get_osfhandle(fdStdOut)),+ (HANDLE) (fdStdErr < 0 ? fdStdErr : _get_osfhandle(fdStdErr)),+ &pStdInput, &pStdOutput, &pStdError,+ flags, useJobObject, hJob, FALSE);++ if (result) {+ *pfdStdInput = _open_osfhandle((intptr_t) pStdInput, _O_WRONLY);+ *pfdStdOutput = _open_osfhandle((intptr_t) pStdOutput, _O_RDONLY);+ *pfdStdError = _open_osfhandle((intptr_t) pStdError, _O_RDONLY);+ }++ return result;+}++/* This function is the same as runInteractiveProcess except it works directly+ on Windows HANDLE rather than pseudo FDs. This allows us to use the pipes+ returned here asynchronously and also need less system calls while working+ with the new I/O manager. */+ProcHandle+runInteractiveProcessHANDLE (+ wchar_t *cmd, wchar_t *workingDirectory,+ wchar_t *environment,+ HANDLE _stdin, HANDLE _stdout, HANDLE _stderr,+ HANDLE *pStdInput, HANDLE *pStdOutput, HANDLE *pStdError,+ int flags, bool useJobObject, HANDLE *hJob)+{+ return runInteractiveProcessWrapper (cmd, workingDirectory, environment,+ _stdin, _stdout, _stderr,+ pStdInput, pStdOutput, pStdError,+ flags, useJobObject, hJob, TRUE);+}++int+terminateProcess (ProcHandle handle)+{+ if (!TerminateProcess ((HANDLE) handle, 1)) {+ DWORD e = GetLastError();+ DWORD exitCode;+ /*+ This is a crude workaround that is taken from libuv. For some reason+ TerminateProcess() can fail with ERROR_ACCESS_DENIED if the process+ already terminated. This situation can be detected by using+ GetExitCodeProcess() to check if the exit code is availble. Unfortunately+ this function succeeds and gives exit code 259 (STILL_ACTIVE) if the+ process is still running. So there is no way to ditinguish a process+ that exited with 259 and a process that did not exit because we had+ insufficient access to terminate it.+ One would expect WaitForSingleObject() to be the solid solution. But this+ function does return WAIT_TIMEOUT in that situation. Even if called+ after GetExitCodeProcess().+ */+ if (e == ERROR_ACCESS_DENIED && GetExitCodeProcess((HANDLE) handle, &exitCode) && exitCode != STILL_ACTIVE)+ return 0;++ SetLastError(e);+ maperrno();+ return -1;+ }+ return 0;+}++int+terminateJob (ProcHandle handle)+{+ if (!TerminateJobObject ((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;+}++// Returns true on success.+int+waitForJobCompletion ( HANDLE hJob )+{+ int process_count = 16;+ JOBOBJECT_BASIC_PROCESS_ID_LIST *pid_list = NULL;++ while (true) {+ size_t pid_list_size = sizeof(JOBOBJECT_BASIC_PROCESS_ID_LIST) + sizeof(ULONG_PTR) * (process_count - 1);++ if (pid_list == NULL) {+ pid_list = malloc(pid_list_size);+ pid_list->NumberOfAssignedProcesses = process_count;+ }++ // Find a process in the job...+ bool success = QueryInformationJobObject(+ hJob,+ JobObjectBasicProcessIdList,+ pid_list,+ pid_list_size,+ NULL);++ if (!success && GetLastError() == ERROR_MORE_DATA) {+ process_count *= 2;+ free(pid_list);+ pid_list = NULL;+ continue;+ } else if (!success) {+ free(pid_list);+ maperrno();+ return false;+ }+ if (pid_list->NumberOfProcessIdsInList == 0) {+ // We're done+ free(pid_list);+ return true;+ }++ HANDLE pHwnd = OpenProcess(SYNCHRONIZE, TRUE, pid_list->ProcessIdList[0]);+ if (pHwnd == NULL) {+ switch (GetLastError()) {+ case ERROR_INVALID_PARAMETER:+ case ERROR_INVALID_HANDLE:+ // Presumably the process terminated; try again.+ continue;+ default:+ free(pid_list);+ maperrno();+ return false;+ }+ }++ // Wait for it to finish...+ if (WaitForSingleObject(pHwnd, INFINITE) != WAIT_OBJECT_0) {+ free(pid_list);+ maperrno();+ CloseHandle(pHwnd);+ return false;+ }++ // The process signalled, loop again to try the next process.+ CloseHandle(pHwnd);+ }+}
changelog.md view
@@ -1,5 +1,11 @@ # Changelog for [`process` package](http://hackage.haskell.org/package/process) +## 1.6.11.0 *January 2021*++* Windows: Add support for new I/O manager in GHC 8.12[#177](https://github.com/haskell/process/pull/177)+* Deprecate use of `createPipeFd` in favor of `createPipe`+* Fix MVar re-entrant problem on Windows with `terminateProcess` and process jobs. See [#199](https://github.com/haskell/process/pull/199)+ ## 1.6.10.0 *June 2020* * Give a usable buffer to `_pipe` on Windows [#182](https://github.com/haskell/process/pull/182)
include/runProcess.h view
@@ -88,8 +88,18 @@ bool useJobObject, HANDLE *hJob ); -typedef void(*setterDef)(DWORD, HANDLE);-typedef HANDLE(*getterDef)(DWORD);+extern ProcHandle runInteractiveProcessHANDLE ( wchar_t *cmd,+ wchar_t *workingDirectory,+ wchar_t *environment,+ HANDLE _stdin,+ HANDLE _stdout,+ HANDLE _stderr,+ HANDLE *pStdInput,+ HANDLE *pStdOutput,+ HANDLE *pStdError,+ int flags,+ bool useJobObject,+ HANDLE *hJob); extern int terminateJob( ProcHandle handle ); extern int waitForJobCompletion( HANDLE hJob );
process.cabal view
@@ -1,5 +1,5 @@ name: process-version: 1.6.10.0+version: 1.6.11.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -54,16 +54,20 @@ System.Process.Internals other-modules: System.Process.Common if os(windows)+ c-sources:+ cbits/win32/runProcess.c other-modules: System.Process.Windows- build-depends: Win32 >=2.2 && < 2.9- extra-libraries: kernel32+ build-depends: Win32 >=2.2 && < 2.10+ -- ole32 and rpcrt4 are needed to create GUIDs for unique named pipes+ -- for process.+ extra-libraries: kernel32, ole32, rpcrt4 cpp-options: -DWINDOWS else+ c-sources:+ cbits/posix/runProcess.c other-modules: System.Process.Posix build-depends: unix >= 2.5 && < 2.8 - c-sources:- cbits/runProcess.c include-dirs: include includes: runProcess.h@@ -91,3 +95,5 @@ , process ghc-options: -threaded -with-rtsopts "-N"+ if os(windows)+ cpp-options: -DWINDOWS
test/main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} import Control.Exception import Control.Monad (guard, unless, void) import System.Exit@@ -97,7 +98,11 @@ putStrLn "testing getPid" do+#ifdef WINDOWS+ (_, Just out, _, p) <- createProcess $ (proc "sh" ["-c", "z=$$; cat /proc/$z/winpid"]) {std_out = CreatePipe}+#else (_, Just out, _, p) <- createProcess $ (proc "sh" ["-c", "echo $$"]) {std_out = CreatePipe}+#endif pid <- getPid p line <- hGetContents out putStrLn $ " queried PID: " ++ show pid