diff --git a/System/Process.hsc b/System/Process.hsc index 953732b1..14feac66 100644 --- a/System/Process.hsc +++ b/System/Process.hsc @@ -75,14 +75,10 @@ import Prelude hiding (mapM) import System.Process.Internals -import Control.Concurrent import Control.DeepSeq (rnf) -import Control.Exception (SomeException, mask, try, throwIO) import qualified Control.Exception as C import Control.Monad import Data.Maybe -import Foreign -import Foreign.C import System.Exit ( ExitCode(..) ) import System.IO import System.IO.Error (mkIOError, ioeSetErrorString) @@ -94,11 +90,10 @@ import Control.Exception (onException) #else import System.Posix.Process (getProcessGroupIDOf) import qualified System.Posix.IO as Posix -import System.Posix.Types #endif #ifdef __GLASGOW_HASKELL__ -import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) ) +import GHC.IO.Exception ( ioException, IOErrorType(..) ) # if defined(mingw32_HOST_OS) import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT) import System.Win32.Process (getProcessId) @@ -224,43 +219,6 @@ withCreateProcess c action = (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) -} --- wrapper so we can get exceptions with the appropriate function name. -withCreateProcess_ - :: String - -> CreateProcess - -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) - -> IO a -withCreateProcess_ fun c action = - C.bracketOnError (createProcess_ fun c) cleanupProcess - (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) - - -cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) - -> IO () -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 - -- the handle lock and prevent us from closing, leading to deadlock. - maybe (return ()) (ignoreSigPipe . hClose) mb_stdin - maybe (return ()) hClose mb_stdout - maybe (return ()) hClose mb_stderr - -- terminateProcess does not guarantee that it terminates the process. - -- 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. - - -- 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 @@ -324,14 +282,6 @@ callCommand cmd = do ExitSuccess -> return () ExitFailure r -> processFailedException "callCommand" cmd [] r -processFailedException :: String -> String -> [String] -> Int -> IO a -processFailedException fun cmd args exit_code = - ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++ - concatMap ((' ':) . show) args ++ - " (exit " ++ show exit_code ++ ")") - Nothing Nothing) - - -- ---------------------------------------------------------------------------- -- Control-C handling on Unix @@ -532,32 +482,6 @@ readCreateProcessWithExitCode cp input = do return (ex, out, err) --- | Fork a thread while doing something else, but kill it if there's an --- exception. --- --- This is important in the cases above because we want to kill the thread --- that is holding the Handle lock, because when we clean up the process we --- try to close that handle, which could otherwise deadlock. --- -withForkWait :: IO () -> (IO () -> IO a) -> IO a -withForkWait async body = do - waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ())) - mask $ \restore -> do - tid <- forkIO $ try (restore async) >>= putMVar waitVar - let wait = takeMVar waitVar >>= either throwIO return - restore (body wait) `C.onException` killThread tid - -ignoreSigPipe :: IO () -> IO () -#if defined(__GLASGOW_HASKELL__) -ignoreSigPipe = C.handle $ \e -> case e of - IOError { ioe_type = ResourceVanished - , ioe_errno = Just ioe } - | Errno ioe == ePIPE -> return () - _ -> throwIO e -#else -ignoreSigPipe = id -#endif - -- ---------------------------------------------------------------------------- -- showCommandForUser @@ -568,116 +492,6 @@ showCommandForUser :: FilePath -> [String] -> String showCommandForUser cmd args = unwords (map translate (cmd : args)) --- ---------------------------------------------------------------------------- --- waitForProcess - -{- | Waits for the specified process to terminate, and returns its exit code. - -GHC Note: in order to call @waitForProcess@ without blocking all the -other threads in the system, you must compile the program with -@-threaded@. - -(/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 -the constants provided by "System.Posix.Signals" in the @unix@ package. -Note: core dumps are not reported, use "System.Posix.Process" if you need this -detail. - --} -waitForProcess - :: ProcessHandle - -> IO ExitCode -waitForProcess ph@(ProcessHandle _ delegating_ctlc) = do - p_ <- modifyProcessHandle ph $ \p_ -> return (p_,p_) - case p_ of - ClosedHandle e -> return e - OpenHandle h -> do - -- don't hold the MVar while we call c_waitForProcess... - -- (XXX but there's a small race window here during which another - -- thread could close the handle or call waitForProcess) - e <- alloca $ \pret -> do - throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret) - modifyProcessHandle ph $ \p_' -> - case p_' of - ClosedHandle e -> return (p_',e) - OpenHandle ph' -> do - closePHANDLE ph' - code <- peek pret - let e = if (code == 0) - then ExitSuccess - else (ExitFailure (fromIntegral code)) - return (ClosedHandle e, e) - when delegating_ctlc $ - endDelegateControlC e - return e - - --- ---------------------------------------------------------------------------- --- getProcessExitCode - -{- | -This is a non-blocking version of 'waitForProcess'. If the process is -still running, 'Nothing' is returned. If the process has exited, then -@'Just' e@ is returned where @e@ is the exit code of the process. - -On Unix systems, see 'waitForProcess' for the meaning of exit codes -when the process died as the result of a signal. --} - -getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) -getProcessExitCode ph@(ProcessHandle _ delegating_ctlc) = do - (m_e, was_open) <- modifyProcessHandle ph $ \p_ -> - case p_ of - ClosedHandle e -> return (p_, (Just e, False)) - OpenHandle h -> - alloca $ \pExitCode -> do - res <- throwErrnoIfMinus1Retry "getProcessExitCode" $ - c_getProcessExitCode h pExitCode - code <- peek pExitCode - if res == 0 - then return (p_, (Nothing, False)) - else do - closePHANDLE h - let e | code == 0 = ExitSuccess - | otherwise = ExitFailure (fromIntegral code) - return (ClosedHandle e, (Just e, True)) - case m_e of - Just e | was_open && delegating_ctlc -> endDelegateControlC e - _ -> return () - return m_e - - --- ---------------------------------------------------------------------------- --- terminateProcess - --- | Attempts to terminate the specified process. This function should --- not be used under normal circumstances - no guarantees are given regarding --- how cleanly the process is terminated. To check whether the process --- has indeed terminated, use 'getProcessExitCode'. --- --- On Unix systems, 'terminateProcess' sends the process the SIGTERM signal. --- On Windows systems, the Win32 @TerminateProcess@ function is called, passing --- an exit code of 1. --- --- Note: on Windows, if the process was a shell command created by --- 'createProcess' with 'shell', or created by 'runCommand' or --- 'runInteractiveCommand', then 'terminateProcess' will only --- terminate the shell, not the command itself. On Unix systems, both --- processes are in a process group and will be terminated together. - -terminateProcess :: ProcessHandle -> IO () -terminateProcess ph = do - withProcessHandle ph $ \p_ -> - case p_ of - ClosedHandle _ -> return () - OpenHandle h -> do - throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h - return () - -- does not close the handle, we might want to try terminating it - -- again, or get its exit code. - - -- ---------------------------------------------------------------------------- -- interruptProcessGroupOf @@ -709,27 +523,6 @@ interruptProcessGroupOf ph = do return () --- ---------------------------------------------------------------------------- --- Interface to C bits - -foreign import ccall unsafe "terminateProcess" - c_terminateProcess - :: PHANDLE - -> IO CInt - -foreign import ccall unsafe "getProcessExitCode" - c_getProcessExitCode - :: PHANDLE - -> Ptr CInt - -> IO CInt - -foreign import ccall interruptible "waitForProcess" -- NB. safe - can block - c_waitForProcess - :: PHANDLE - -> Ptr CInt - -> IO CInt - - -- ---------------------------------------------------------------------------- -- Old deprecated variants -- ---------------------------------------------------------------------------- diff --git a/System/Process/ByteString.hsc b/System/Process/ByteString.hsc new file mode 100644 index 00000000..191e1dd9 --- /dev/null +++ b/System/Process/ByteString.hsc @@ -0,0 +1,204 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__ >= 709 +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif +{-# LANGUAGE InterruptibleFFI #-} +#endif + +----------------------------------------------------------------------------- +-- | +-- Module : System.Process.ByteString +-- Copyright : (c) The University of Glasgow 2004-2015 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (requires concurrency) +-- +-- Operations for creating and interacting with sub-processes. +-- +----------------------------------------------------------------------------- + +module System.Process.ByteString ( + -- ** Simpler functions for common tasks + readCreateProcess, + readProcess, + readCreateProcessWithExitCode, + readProcessWithExitCode, +) where + +import System.Process (proc) + +import Prelude hiding (mapM) + +import System.Process.Internals + +import Control.Concurrent +import qualified Control.Exception as C +import Control.Monad +import System.Exit ( ExitCode(..) ) +import System.IO + +import qualified Data.ByteString as BS + +-- ----------------------------------------------------------------------------- + +-- | @readProcess@ forks an external process, reads its standard output +-- strictly, blocking until the process terminates, and returns the output +-- 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 +-- 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'. 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 +-- the result of readProcess. +-- +-- > > readProcess "date" [] [] +-- > "Thu Feb 7 10:03:39 PST 2008\n" +-- +-- The arguments are: +-- +-- * The command to run, which must be in the $PATH, or an absolute or relative path +-- +-- * A list of separate command line arguments to the program +-- +-- * A string to pass on standard input to the forked process. +-- +readProcess + :: FilePath -- ^ Filename of the executable (see 'RawCommand' for details) + -> [String] -- ^ any arguments + -> BS.ByteString -- ^ standard input + -> IO BS.ByteString -- ^ stdout +readProcess cmd args = readCreateProcess $ proc cmd args + +-- | @readCreateProcess@ works exactly like 'readProcess' except that it +-- lets you pass 'CreateProcess' giving better flexibility. +-- +-- > > readCreateProcess (shell "pwd" { cwd = "/etc/" }) "" +-- > "/etc\n" +-- +-- Note that @Handle@s provided for @std_in@ or @std_out@ via the CreateProcess +-- record will be ignored. +-- /Since: 1.2.3.0/ + +readCreateProcess + :: CreateProcess + -> BS.ByteString -- ^ standard input + -> IO BS.ByteString -- ^ stdout +readCreateProcess cp input = do + let cp_opts = cp { + std_in = CreatePipe, + std_out = CreatePipe + } + (ex, output) <- withCreateProcess_ "readCreateProcess" cp_opts $ + \(Just inh) (Just outh) _ ph -> do + + -- fork off a thread to start consuming the output + output <- BS.hGetContents outh + withForkWait (C.evaluate output >> return ()) $ \waitOut -> do + + -- now write any input + unless (BS.null input) $ + ignoreSigPipe $ BS.hPutStr inh input + -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE + ignoreSigPipe $ hClose inh + + -- wait on the output + waitOut + hClose outh + + -- wait on the process + ex <- waitForProcess ph + return (ex, output) + + case ex of + ExitSuccess -> return output + ExitFailure r -> processFailedException "readCreateProcess" cmd args r + where + cmd = case cp of + CreateProcess { cmdspec = ShellCommand sc } -> sc + CreateProcess { cmdspec = RawCommand fp _ } -> fp + args = case cp of + CreateProcess { cmdspec = ShellCommand _ } -> [] + CreateProcess { cmdspec = RawCommand _ args' } -> args' + + +-- | @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 + -> BS.ByteString -- ^ standard input + -> IO (ExitCode,BS.ByteString,BS.ByteString) -- ^ exitcode, stdout, stderr +readProcessWithExitCode cmd args = + readCreateProcessWithExitCode $ proc cmd args + +-- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it +-- lets you pass 'CreateProcess' giving better flexibility. +-- +-- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess +-- record will be ignored. +-- +-- /Since: 1.2.3.0/ +readCreateProcessWithExitCode + :: CreateProcess + -> BS.ByteString -- ^ standard input + -> IO (ExitCode,BS.ByteString,BS.ByteString) -- ^ exitcode, stdout, stderr +readCreateProcessWithExitCode cp input = do + let cp_opts = cp { + std_in = CreatePipe, + std_out = CreatePipe, + std_err = CreatePipe + } + withCreateProcess_ "readCreateProcessWithExitCode" cp_opts $ + \(Just inh) (Just outh) (Just errh) ph -> do + + outVar <- newEmptyMVar + errVar <- newEmptyMVar + + -- fork off threads to start consuming stdout & stderr + withForkWait (BS.hGetContents outh >>= putMVar outVar) $ \waitOut -> + withForkWait (BS.hGetContents errh >>= putMVar errVar) $ \waitErr -> do + + -- now write any input + unless (BS.null input) $ + ignoreSigPipe $ BS.hPutStr inh input + -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE + ignoreSigPipe $ hClose inh + + -- wait on the output + waitOut + waitErr + + hClose outh + hClose errh + + -- wait on the process + ex <- waitForProcess ph + + out <- takeMVar outVar + err <- takeMVar errVar + + return (ex, out, err) + diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs index 3e9d156f..80f57774 100644 --- a/System/Process/Internals.hs +++ b/System/Process/Internals.hs @@ -41,6 +41,15 @@ module System.Process.Internals ( withFilePathException, withCEnvironment, translate, fdToHandle, + + withForkWait, + ignoreSigPipe, + withCreateProcess_, + cleanupProcess, + waitForProcess, + getProcessExitCode, + terminateProcess, + processFailedException, ) where import Control.Concurrent @@ -70,7 +79,11 @@ import GHC.IO.Device import GHC.IO.Handle.FD import GHC.IO.Handle.Internals import GHC.IO.Handle.Types hiding (ClosedHandle) +#if MIN_VERSION_base (4,6,0) import System.IO.Error +#else +import System.IO.Error hiding (try) +#endif import Data.Typeable # if defined(mingw32_HOST_OS) import GHC.IO.IOMode @@ -86,6 +99,8 @@ import System.Environment ( getEnv ) import System.FilePath #endif +import qualified Control.Exception as C + #include "HsProcessConfig.h" #include "processFlags.h" @@ -718,6 +733,206 @@ withCEnvironment envir act = in withCWString env' (act . castPtr) #endif +-- | Fork a thread while doing something else, but kill it if there's an +-- exception. +-- +-- This is important in the cases above because we want to kill the thread +-- that is holding the Handle lock, because when we clean up the process we +-- try to close that handle, which could otherwise deadlock. +-- +withForkWait :: IO () -> (IO () -> IO a) -> IO a +withForkWait async body = do + waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ())) + mask $ \restore -> do + tid <- forkIO $ try (restore async) >>= putMVar waitVar + let wait = takeMVar waitVar >>= either throwIO return + restore (body wait) `C.onException` killThread tid + +ignoreSigPipe :: IO () -> IO () +#if defined(__GLASGOW_HASKELL__) +ignoreSigPipe = C.handle $ \e -> case e of + IOError { ioe_type = ResourceVanished + , ioe_errno = Just ioe } + | Errno ioe == ePIPE -> return () + _ -> throwIO e +#else +ignoreSigPipe = id +#endif + +-- wrapper so we can get exceptions with the appropriate function name. +withCreateProcess_ + :: String + -> CreateProcess + -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) + -> IO a +withCreateProcess_ fun c action = + C.bracketOnError (createProcess_ fun c) cleanupProcess + (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) + +cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) + -> IO () +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 + -- the handle lock and prevent us from closing, leading to deadlock. + maybe (return ()) (ignoreSigPipe . hClose) mb_stdin + maybe (return ()) hClose mb_stdout + maybe (return ()) hClose mb_stderr + -- terminateProcess does not guarantee that it terminates the process. + -- 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. + + -- 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 + +-- ---------------------------------------------------------------------------- +-- Interface to C bits + +foreign import ccall unsafe "terminateProcess" + c_terminateProcess + :: PHANDLE + -> IO CInt + +foreign import ccall unsafe "getProcessExitCode" + c_getProcessExitCode + :: PHANDLE + -> Ptr CInt + -> IO CInt + +foreign import ccall interruptible "waitForProcess" -- NB. safe - can block + c_waitForProcess + :: PHANDLE + -> Ptr CInt + -> IO CInt + +-- ---------------------------------------------------------------------------- +-- waitForProcess + +{- | Waits for the specified process to terminate, and returns its exit code. + +GHC Note: in order to call @waitForProcess@ without blocking all the +other threads in the system, you must compile the program with +@-threaded@. + +(/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 +the constants provided by "System.Posix.Signals" in the @unix@ package. +Note: core dumps are not reported, use "System.Posix.Process" if you need this +detail. + +-} +waitForProcess + :: ProcessHandle + -> IO ExitCode +waitForProcess ph@(ProcessHandle _ delegating_ctlc) = do + p_ <- modifyProcessHandle ph $ \p_ -> return (p_,p_) + case p_ of + ClosedHandle e -> return e + OpenHandle h -> do + -- don't hold the MVar while we call c_waitForProcess... + -- (XXX but there's a small race window here during which another + -- thread could close the handle or call waitForProcess) + e <- alloca $ \pret -> do + throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret) + modifyProcessHandle ph $ \p_' -> + case p_' of + ClosedHandle e -> return (p_',e) + OpenHandle ph' -> do + closePHANDLE ph' + code <- peek pret + let e = if (code == 0) + then ExitSuccess + else (ExitFailure (fromIntegral code)) + return (ClosedHandle e, e) + when delegating_ctlc $ + endDelegateControlC e + return e + + +-- ---------------------------------------------------------------------------- +-- getProcessExitCode + +{- | +This is a non-blocking version of 'waitForProcess'. If the process is +still running, 'Nothing' is returned. If the process has exited, then +@'Just' e@ is returned where @e@ is the exit code of the process. + +On Unix systems, see 'waitForProcess' for the meaning of exit codes +when the process died as the result of a signal. +-} + +getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) +getProcessExitCode ph@(ProcessHandle _ delegating_ctlc) = do + (m_e, was_open) <- modifyProcessHandle ph $ \p_ -> + case p_ of + ClosedHandle e -> return (p_, (Just e, False)) + OpenHandle h -> + alloca $ \pExitCode -> do + res <- throwErrnoIfMinus1Retry "getProcessExitCode" $ + c_getProcessExitCode h pExitCode + code <- peek pExitCode + if res == 0 + then return (p_, (Nothing, False)) + else do + closePHANDLE h + let e | code == 0 = ExitSuccess + | otherwise = ExitFailure (fromIntegral code) + return (ClosedHandle e, (Just e, True)) + case m_e of + Just e | was_open && delegating_ctlc -> endDelegateControlC e + _ -> return () + return m_e + + + +-- ---------------------------------------------------------------------------- +-- terminateProcess + +-- | Attempts to terminate the specified process. This function should +-- not be used under normal circumstances - no guarantees are given regarding +-- how cleanly the process is terminated. To check whether the process +-- has indeed terminated, use 'getProcessExitCode'. +-- +-- On Unix systems, 'terminateProcess' sends the process the SIGTERM signal. +-- On Windows systems, the Win32 @TerminateProcess@ function is called, passing +-- an exit code of 1. +-- +-- Note: on Windows, if the process was a shell command created by +-- 'createProcess' with 'shell', or created by 'runCommand' or +-- 'runInteractiveCommand', then 'terminateProcess' will only +-- terminate the shell, not the command itself. On Unix systems, both +-- processes are in a process group and will be terminated together. + +terminateProcess :: ProcessHandle -> IO () +terminateProcess ph = do + withProcessHandle ph $ \p_ -> + case p_ of + ClosedHandle _ -> return () + OpenHandle h -> do + throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h + return () + -- does not close the handle, we might want to try terminating it + -- again, or get its exit code. + +processFailedException :: String -> String -> [String] -> Int -> IO a +processFailedException fun cmd args exit_code = + ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++ + concatMap ((' ':) . show) args ++ + " (exit " ++ show exit_code ++ ")") + Nothing Nothing) + + -- ---------------------------------------------------------------------------- -- Deprecated / compat diff --git a/process.cabal b/process.cabal index 82b4d1cf..f0252490 100644 --- a/process.cabal +++ b/process.cabal @@ -44,6 +44,7 @@ library exposed-modules: System.Cmd System.Process + System.Process.ByteString if impl(ghc) exposed-modules: System.Process.Internals @@ -62,7 +63,8 @@ library build-depends: base >= 4.4 && < 4.9, directory >= 1.1 && < 1.3, filepath >= 1.2 && < 1.5, - deepseq >= 1.1 && < 1.5 + deepseq >= 1.1 && < 1.5, + bytestring >= 0.9 && < 1.0 if os(windows) build-depends: Win32 >=2.2 && < 2.4 extra-libraries: kernel32