diff --git a/System/Process/Common.hs b/System/Process/Common.hs index 917c40f8a68fed83f03694cb998759f989a1cafe..fe3cebc4cf75a4bb066bf81fcb731a471632ade1 100644 --- a/System/Process/Common.hs +++ b/System/Process/Common.hs @@ -26,6 +26,13 @@ module System.Process.Common #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.Exception 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 @@ import System.IO (IOMode) #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 @@ -258,3 +272,25 @@ pfdToHandle pfd mode = do 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 diff --git a/System/Process/Windows.hsc b/System/Process/Windows.hsc index 2b7678ced82fb38376326f58ed34d1289329a221..757940a7076081df63c13eeca72891ddb23454b2 100644 --- a/System/Process/Windows.hsc +++ b/System/Process/Windows.hsc @@ -30,6 +30,11 @@ import System.IO.Unsafe 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 +96,77 @@ createProcess_Internal -> 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,9 +179,43 @@ createProcess_Internal fun CreateProcess{ cmdspec = cmdsp, 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 @@ -132,8 +229,8 @@ createProcess_Internal fun CreateProcess{ cmdspec = cmdsp, -- 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,17 +240,20 @@ createProcess_Internal fun CreateProcess{ cmdspec = cmdsp, 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 () @@ -224,6 +324,24 @@ foreign import ccall unsafe "runInteractiveProcess" -> 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 +417,14 @@ isDefaultSignal :: CLong -> Bool 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 +438,21 @@ createPipeInternalFd = do 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 diff --git a/cbits/posix/runProcess.c b/cbits/posix/runProcess.c new file mode 100644 index 0000000000000000000000000000000000000000..61eb7884224cc37314e75249aab3519052860beb --- /dev/null +++ b/cbits/posix/runProcess.c @@ -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; +} diff --git a/cbits/runProcess.c b/cbits/runProcess.c deleted file mode 100644 index a6d80bde3eca8aebe06c5f9385feb77f889febe5..0000000000000000000000000000000000000000 --- a/cbits/runProcess.c +++ /dev/null @@ -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 */ diff --git a/cbits/win32/runProcess.c b/cbits/win32/runProcess.c new file mode 100644 index 0000000000000000000000000000000000000000..e11c47c68a89d28dd558bc6d3e499b6719ded801 --- /dev/null +++ b/cbits/win32/runProcess.c @@ -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); + } +} diff --git a/changelog.md b/changelog.md index 0f74ecc77bed527e3319176f8230a9b10fc15045..793e25b80a241506452a45d7a4c348695ff4547d 100644 --- a/changelog.md +++ b/changelog.md @@ -2,6 +2,9 @@ ## Unreleased changes +* 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` + ## 1.6.10.0 *June 2020* * Give a usable buffer to `_pipe` on Windows [#182](https://github.com/haskell/process/pull/182) diff --git a/include/runProcess.h b/include/runProcess.h index c88187edde793c5807d69f60235dd9a3fba2023a..d1fb95c087d73ae994e970aa3856eeddabe457e6 100644 --- a/include/runProcess.h +++ b/include/runProcess.h @@ -88,8 +88,18 @@ extern ProcHandle runInteractiveProcess( wchar_t *cmd, 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 ); diff --git a/process.cabal b/process.cabal index cb41ba15516f237d39acf8d2e3229ede19e9dc91..b0b1bf38d903362e86b90fe7e36ee1cefa157b9e 100644 --- a/process.cabal +++ b/process.cabal @@ -54,16 +54,20 @@ library 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 + -- 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