process 1.2.1.0 → 1.2.2.0
raw patch · 5 files changed
+50/−33 lines, 5 files
Files
- System/Process.hsc +26/−26
- System/Process/Internals.hs +9/−6
- cbits/runProcess.c +5/−0
- changelog.md +9/−0
- process.cabal +1/−1
System/Process.hsc view
@@ -236,7 +236,8 @@ cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()-cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do+cleanupProcess (mb_stdin, mb_stdout, mb_stderr,+ ph@(ProcessHandle _ delegating_ctlc)) = do terminateProcess ph -- Note, it's important that other threads that might be reading/writing -- these handles also get killed off, since otherwise they might be holding@@ -248,9 +249,16 @@ -- Indeed on Unix it's SIGTERM, which asks nicely but does not guarantee -- that it stops. If it doesn't stop, we don't want to hang, so we wait -- asynchronously using forkIO.- _ <- forkIO (waitForProcess ph >> return ())- return () + -- However we want to end the Ctl-C handling synchronously, so we'll do+ -- that synchronously, and set delegating_ctlc as False for the+ -- waitForProcess (which would otherwise end the Ctl-C delegation itself).+ when delegating_ctlc+ stopDelegateControlC+ _ <- forkIO (waitForProcess (resetCtlcDelegation ph) >> return ())+ return ()+ where+ resetCtlcDelegation (ProcessHandle m _) = ProcessHandle m False -- ---------------------------------------------------------------------------- -- spawnProcess/spawnCommand@@ -372,17 +380,18 @@ -- | @readProcess@ forks an external process, reads its standard output -- strictly, blocking until the process terminates, and returns the output--- string.+-- string. The external process inherits the standard error. -- -- If an asynchronous exception is thrown to the thread executing--- @readProcess@. The forked process will be terminated and @readProcess@ will+-- @readProcess@, the forked process will be terminated and @readProcess@ will -- wait (block) until the process has been terminated. -- -- Output is returned strictly, so this is not suitable for -- interactive applications. -- -- This function throws an 'IOError' if the process 'ExitCode' is--- anything other than 'ExitSuccess'.+-- anything other than 'ExitSuccess'. If instead you want to get the+-- 'ExitCode' then use 'readProcessWithExitCode'. -- -- Users of this function should compile with @-threaded@ if they -- want other Haskell threads to keep running while waiting on@@ -435,26 +444,17 @@ ExitSuccess -> return output ExitFailure r -> processFailedException "readProcess" cmd args r -{- |-@readProcessWithExitCode@ creates an external process, reads its-standard output and standard error strictly, waits until the process-terminates, and then returns the 'ExitCode' of the process,-the standard output, and the standard error.--If an asynchronous exception is thrown to the thread executing-@readProcessWithExitCode@. The forked process will be terminated and-@readProcessWithExitCode@ will wait (block) until the process has been-terminated.--'readProcess' and 'readProcessWithExitCode' are fairly simple wrappers-around 'createProcess'. Constructing variants of these functions is-quite easy: follow the link to the source code to see how-'readProcess' is implemented.--On Unix systems, see 'waitForProcess' for the meaning of exit codes-when the process died as the result of a signal.--}-+-- | @readProcessWithExitCode@ is like @readProcess@ but with two differences:+-- +-- * it returns the 'ExitCode' of the process, and does not throw any+-- exception if the code is not 'ExitSuccess'.+--+-- * it reads and returns the output from process' standard error handle,+-- rather than the process inheriting the standard error handle.+-- +-- On Unix systems, see 'waitForProcess' for the meaning of exit codes+-- when the process died as the result of a signal.+-- readProcessWithExitCode :: FilePath -- ^ Filename of the executable (see 'RawCommand' for details) -> [String] -- ^ any arguments
System/Process/Internals.hs view
@@ -33,6 +33,7 @@ #endif startDelegateControlC, endDelegateControlC,+ stopDelegateControlC, #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) pPrPr_disableITimers, c_execvpe, ignoreSignal, defaultSignal,@@ -293,6 +294,8 @@ when (proc_handle == -1) $ do cFailedDoing <- peek pFailedDoing failedDoing <- peekCString cFailedDoing+ when mb_delegate_ctlc+ stopDelegateControlC throwErrno (fun ++ ": " ++ failedDoing) hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode@@ -332,7 +335,6 @@ modifyMVar_ runInteractiveProcess_delegate_ctlc $ \delegating -> do case delegating of Nothing -> do--- print ("startDelegateControlC", "Nothing") -- We're going to ignore ^C in the parent while there are any -- processes using ^C delegation. --@@ -344,29 +346,30 @@ return (Just (1, old_int, old_quit)) Just (count, old_int, old_quit) -> do--- print ("startDelegateControlC", count) -- If we're already doing it, just increment the count let !count' = count + 1 return (Just (count', old_int, old_quit)) -endDelegateControlC :: ExitCode -> IO ()-endDelegateControlC exitCode = do+stopDelegateControlC :: IO ()+stopDelegateControlC = modifyMVar_ runInteractiveProcess_delegate_ctlc $ \delegating -> do case delegating of Just (1, old_int, old_quit) -> do--- print ("endDelegateControlC", exitCode, 1 :: Int) -- Last process, so restore the old signal handlers _ <- installHandler sigINT old_int Nothing _ <- installHandler sigQUIT old_quit Nothing return Nothing Just (count, old_int, old_quit) -> do--- print ("endDelegateControlC", exitCode, count) -- Not the last, just decrement the count let !count' = count - 1 return (Just (count', old_int, old_quit)) Nothing -> return Nothing -- should be impossible++endDelegateControlC :: ExitCode -> IO ()+endDelegateControlC exitCode = do+ stopDelegateControlC -- And if the process did die due to SIGINT or SIGQUIT then -- we throw our equivalent exception here (synchronously).
cbits/runProcess.c view
@@ -288,6 +288,11 @@ // 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);+ pid = -1; } else if (r != 0) {
changelog.md view
@@ -1,5 +1,14 @@ # Changelog for [`process` package](http://hackage.haskell.org/package/process) +## 1.2.2.0 *Jan 2015*++ * Fix delegated CTRL-C handling in `createProcess` in case of failed+ process creation. See [issue #15](https://github.com/haskell/process/issues/15)+ for more details.++ * `waitpid` on child PID after pre-exec failure in child to prevent zombies.+ See also [issue #14](https://github.com/haskell/process/issues/14).+ ## 1.2.1.0 *Dec 2014* * Add support for `base-4.8.0.0`
process.cabal view
@@ -1,5 +1,5 @@ name: process-version: 1.2.1.0+version: 1.2.2.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE