process 1.1.0.2 → 1.2.0.0
raw patch · 12 files changed
+1735/−1414 lines, 12 filesdep ~Win32dep ~basedep ~directorynew-uploader
Dependency ranges changed: Win32, base, directory, filepath, unix
Files
- System/Cmd.hs +2/−19
- System/Process.hs +553/−346
- System/Process/Internals.hs +215/−147
- cbits/runProcess.c +628/−538
- changelog +15/−0
- configure +185/−153
- configure.ac +1/−1
- include/HsProcessConfig.h +0/−92
- include/HsProcessConfig.h.in +2/−2
- include/runProcess.h +86/−77
- process.buildinfo +1/−0
- process.cabal +47/−39
System/Cmd.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 701+#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} #endif @@ -21,27 +21,10 @@ -- ----------------------------------------------------------------------------- --- later: {-# DEPRECATED "Use System.Process instead" #-}-module System.Cmd+module System.Cmd {-# DEPRECATED "Use \"System.Process\" instead" #-} -- deprecated in 7.8 ( system, -- :: String -> IO ExitCode rawSystem, -- :: FilePath -> [String] -> IO ExitCode ) where -#ifndef __NHC__ import System.Process-#else-import System--rawSystem :: String -> [String] -> IO ExitCode-rawSystem cmd args = system (unwords (map translate (cmd:args)))---- copied from System.Process (qv)-translate :: String -> String-translate str = '"' : snd (foldr escape (True,"\"") str)- where escape '"' (b, str) = (True, '\\' : '"' : str)- escape '\\' (True, str) = (True, '\\' : '\\' : str)- escape '\\' (False, str) = (False, '\\' : str)- escape c (b, str) = (False, c : str)--#endif
System/Process.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}-#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE InterruptibleFFI #-} #endif@@ -44,25 +44,36 @@ StdStream(..), ProcessHandle, - -- ** Specific variants of createProcess- runCommand,- runProcess,- runInteractiveCommand,- runInteractiveProcess,+ -- ** Simpler functions for common tasks+ callProcess,+ callCommand,+ spawnProcess,+ spawnCommand, readProcess, readProcessWithExitCode,-#endif- system,- rawSystem,++ -- ** Related utilities showCommandForUser, -#ifndef __HUGS__+ -- ** Control-C handling on Unix+ -- $ctlc-handling+ -- * Process completion waitForProcess, getProcessExitCode, terminateProcess, interruptProcessGroupOf,++ -- * Old deprecated functions+ -- | These functions pre-date 'createProcess' which is much more+ -- flexible.+ runProcess,+ runCommand,+ runInteractiveProcess,+ runInteractiveCommand, #endif+ system,+ rawSystem, ) where import Prelude hiding (mapM)@@ -70,15 +81,13 @@ #ifndef __HUGS__ import System.Process.Internals -import Control.Exception (SomeException, mask, try, onException, throwIO)+import Control.Exception (SomeException, mask, try, throwIO) import Control.DeepSeq (rnf) import System.IO.Error (mkIOError, ioeSetErrorString) #if !defined(mingw32_HOST_OS) import System.Posix.Types-#if MIN_VERSION_unix(2,5,0) import System.Posix.Process (getProcessGroupIDOf) #endif-#endif import qualified Control.Exception as C import Control.Concurrent import Control.Monad@@ -90,11 +99,7 @@ import System.Exit ( ExitCode(..) ) #ifdef __GLASGOW_HASKELL__-#if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) )-#else-import GHC.IOBase ( ioException, IOErrorType(..) )-#endif #if defined(mingw32_HOST_OS) import System.Win32.Process (getProcessId) import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT)@@ -107,93 +112,34 @@ import Hugs.System #endif -#ifdef __NHC__-import System (system)-#endif - #ifndef __HUGS__--- ------------------------------------------------------------------------------- runCommand -{- | Runs a command using the shell.- -}-runCommand- :: String- -> IO ProcessHandle--runCommand string = do- (_,_,_,ph) <- runGenProcess_ "runCommand" (shell string) Nothing Nothing- return ph- -- ------------------------------------------------------------------------------- runProcess--{- | Runs a raw command, optionally specifying 'Handle's from which to- take the @stdin@, @stdout@ and @stderr@ channels for the new- process (otherwise these handles are inherited from the current- process).-- Any 'Handle's passed to 'runProcess' are placed immediately in the- closed state.-- Note: consider using the more general 'createProcess' instead of- 'runProcess'.--}-runProcess- :: FilePath -- ^ Filename of the executable (see 'proc' for details)- -> [String] -- ^ Arguments to pass to the executable- -> Maybe FilePath -- ^ Optional path to the working directory- -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)- -> Maybe Handle -- ^ Handle to use for @stdin@ (Nothing => use existing @stdin@)- -> Maybe Handle -- ^ Handle to use for @stdout@ (Nothing => use existing @stdout@)- -> Maybe Handle -- ^ Handle to use for @stderr@ (Nothing => use existing @stderr@)- -> IO ProcessHandle--runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do- (_,_,_,ph) <-- runGenProcess_ "runProcess"- (proc cmd args){ cwd = mb_cwd,- env = mb_env,- std_in = mbToStd mb_stdin,- std_out = mbToStd mb_stdout,- std_err = mbToStd mb_stderr }- Nothing Nothing- maybeClose mb_stdin- maybeClose mb_stdout- maybeClose mb_stderr- return ph- where- maybeClose :: Maybe Handle -> IO ()- maybeClose (Just hdl)- | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl- maybeClose _ = return ()-- mbToStd :: Maybe Handle -> StdStream- mbToStd Nothing = Inherit- mbToStd (Just hdl) = UseHandle hdl---- ---------------------------------------------------------------------------- -- createProcess -- | Construct a 'CreateProcess' record for passing to 'createProcess', -- representing a raw command with arguments. ----- The @FilePath@ names the executable, and is interpreted according+-- The 'FilePath' argument names the executable, and is interpreted according -- to the platform's standard policy for searching for -- executables. Specifically: ----- * on Unix systems the @execvp@ semantics is used, where if the--- filename does not contain a slash (@/@) then the @PATH@--- environment variable is searched for the executable.+-- * on Unix systems the+-- <http://pubs.opengroup.org/onlinepubs/9699919799/functions/execvp.html execvp(3)>+-- semantics is used, where if the executable filename does not+-- contain a slash (@/@) then the @PATH@ environment variable is+-- searched for the executable. -- -- * on Windows systems the Win32 @CreateProcess@ semantics is used. -- Briefly: if the filename does not contain a path, then the -- directory containing the parent executable is searched, followed--- by the current directory, then some some standard locations, and+-- by the current directory, then some standard locations, and -- finally the current @PATH@. An @.exe@ extension is added if the -- filename does not already have an extension. For full details--- see the documentation for the Windows @SearchPath@ API.+-- see the+-- <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365527%28v=vs.85%29.aspx documentation>+-- for the Windows @SearchPath@ API. proc :: FilePath -> [String] -> CreateProcess proc cmd args = CreateProcess { cmdspec = RawCommand cmd args,@@ -203,7 +149,8 @@ std_out = Inherit, std_err = Inherit, close_fds = False,- create_group = False}+ create_group = False,+ delegate_ctlc = False} -- | Construct a 'CreateProcess' record for passing to 'createProcess', -- representing a command to be passed to the shell.@@ -215,7 +162,8 @@ std_out = Inherit, std_err = Inherit, close_fds = False,- create_group = False}+ create_group = False,+ delegate_ctlc = False} {- | This is the most general way to spawn an external process. The@@ -230,16 +178,16 @@ fill in the fields with default values which can be overriden as needed. -'createProcess' returns @(mb_stdin_hdl, mb_stdout_hdl, mb_stderr_hdl, p)@,+'createProcess' returns @(/mb_stdin_hdl/, /mb_stdout_hdl/, /mb_stderr_hdl/, /ph/)@, where - * if @std_in == CreatePipe@, then @mb_stdin_hdl@ will be @Just h@,- where @h@ is the write end of the pipe connected to the child+ * if @'std_in' == 'CreatePipe'@, then @/mb_stdin_hdl/@ will be @Just /h/@,+ where @/h/@ is the write end of the pipe connected to the child process's @stdin@. - * otherwise, @mb_stdin_hdl == Nothing@+ * otherwise, @/mb_stdin_hdl/ == Nothing@ -Similarly for @mb_stdout_hdl@ and @mb_stderr_hdl@.+Similarly for @/mb_stdout_hdl/@ and @/mb_stderr_hdl/@. For example, to execute a simple @ls@ command: @@ -261,7 +209,7 @@ :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess cp = do- r <- runGenProcess_ "createProcess" cp Nothing Nothing+ r <- createProcess_ "createProcess" cp maybeCloseStd (std_in cp) maybeCloseStd (std_out cp) maybeCloseStd (std_err cp)@@ -272,94 +220,178 @@ | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl maybeCloseStd _ = return () --- ------------------------------------------------------------------------------- runInteractiveCommand--{- | Runs a command using the shell, and returns 'Handle's that may- be used to communicate with the process via its @stdin@, @stdout@,- and @stderr@ respectively. The 'Handle's are initially in binary- mode; if you need them to be in text mode then use 'hSetBinaryMode'.+{-+-- TODO: decide if we want to expose this to users+-- | A 'C.bracketOnError'-style resource handler for 'createProcess'.+--+-- In normal operation it adds nothing, you are still responsible for waiting+-- for (or forcing) process termination and closing any 'Handle's. It only does+-- automatic cleanup if there is an exception. If there is an exception in the+-- body then it ensures that the process gets terminated and any 'CreatePipe'+-- 'Handle's are closed. In particular this means that if the Haskell thread+-- is killed (e.g. 'killThread'), that the external process is also terminated.+--+-- e.g.+--+-- > withCreateProcess (proc cmd args) { ... } $ \_ _ _ ph -> do+-- > ...+--+withCreateProcess+ :: CreateProcess+ -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)+ -> IO a+withCreateProcess c action =+ C.bracketOnError (createProcess c) cleanupProcess+ (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) -}-runInteractiveCommand++-- wrapper so we can get exceptions with the appropriate function name.+withCreateProcess_ :: String- -> IO (Handle,Handle,Handle,ProcessHandle)+ -> 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) -runInteractiveCommand string =- runInteractiveProcess1 "runInteractiveCommand" (shell string) +cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+ -> IO ()+cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = 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.+ _ <- forkIO (waitForProcess ph >> return ())+ return ()++ -- ------------------------------------------------------------------------------- runInteractiveProcess+-- spawnProcess/spawnCommand -{- | Runs a raw command, and returns 'Handle's that may be used to communicate- with the process via its @stdin@, @stdout@ and @stderr@ respectively.+-- | Creates a new process to run the specified raw command with the given+-- arguments. It does not wait for the program to finish, but returns the+-- 'ProcessHandle'.+--+-- /Since: 1.2.0.0/+spawnProcess :: FilePath -> [String] -> IO ProcessHandle+spawnProcess cmd args = do+ (_,_,_,p) <- createProcess_ "spawnProcess" (proc cmd args)+ return p - For example, to start a process and feed a string to its stdin:+-- | Creates a new process to run the specified shell command.+-- It does not wait for the program to finish, but returns the 'ProcessHandle'.+--+-- /Since: 1.2.0.0/+spawnCommand :: String -> IO ProcessHandle+spawnCommand cmd = do+ (_,_,_,p) <- createProcess_ "spawnCommand" (shell cmd)+ return p -> (inp,out,err,pid) <- runInteractiveProcess "..."-> forkIO (hPutStr inp str) - The 'Handle's are initially in binary mode; if you need them to be- in text mode then use 'hSetBinaryMode'.--}-runInteractiveProcess- :: FilePath -- ^ Filename of the executable (see 'proc' for details)- -> [String] -- ^ Arguments to pass to the executable- -> Maybe FilePath -- ^ Optional path to the working directory- -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)- -> IO (Handle,Handle,Handle,ProcessHandle)+-- ----------------------------------------------------------------------------+-- callProcess/callCommand -runInteractiveProcess cmd args mb_cwd mb_env = do- runInteractiveProcess1 "runInteractiveProcess"- (proc cmd args){ cwd = mb_cwd, env = mb_env }+-- | Creates a new process to run the specified command with the given+-- arguments, and wait for it to finish. If the command returns a non-zero+-- exit code, an exception is raised.+--+-- If an asynchronous exception is thrown to the thread executing+-- @callProcess@. The forked process will be terminated and+-- @callProcess@ will wait (block) until the process has been+-- terminated.+--+-- /Since: 1.2.0.0/+callProcess :: FilePath -> [String] -> IO ()+callProcess cmd args = do+ exit_code <- withCreateProcess_ "callCommand"+ (proc cmd args) { delegate_ctlc = True } $ \_ _ _ p ->+ waitForProcess p+ case exit_code of+ ExitSuccess -> return ()+ ExitFailure r -> processFailedException "callProcess" cmd args r -runInteractiveProcess1- :: String- -> CreateProcess- -> IO (Handle,Handle,Handle,ProcessHandle)-runInteractiveProcess1 fun cmd = do- (mb_in, mb_out, mb_err, p) <-- runGenProcess_ fun- cmd{ std_in = CreatePipe,- std_out = CreatePipe,- std_err = CreatePipe }- Nothing Nothing- return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p)+-- | Creates a new process to run the specified shell command. If the+-- command returns a non-zero exit code, an exception is raised.+--+-- If an asynchronous exception is thrown to the thread executing+-- @callCommand@. The forked process will be terminated and+-- @callCommand@ will wait (block) until the process has been+-- terminated.+--+-- /Since: 1.2.0.0/+callCommand :: String -> IO ()+callCommand cmd = do+ exit_code <- withCreateProcess_ "callCommand"+ (shell cmd) { delegate_ctlc = True } $ \_ _ _ p ->+ waitForProcess p+ case exit_code of+ ExitSuccess -> return ()+ ExitFailure r -> processFailedException "callCommand" cmd [] r --- ------------------------------------------------------------------------------- waitForProcess+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) -{- | 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@.--}-waitForProcess- :: ProcessHandle- -> IO ExitCode-waitForProcess ph = do- p_ <- withProcessHandle 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)- alloca $ \pret -> do- throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret)- withProcessHandle 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)+-- ----------------------------------------------------------------------------+-- Control-C handling on Unix --- -----------------------------------------------------------------------------+-- $ctlc-handling --+-- When running an interactive console process (such as a shell, console-based+-- text editor or ghci), we typically want that process to be allowed to handle+-- Ctl-C keyboard interrupts how it sees fit. For example, while most programs+-- simply quit on a Ctl-C, some handle it specially. To allow this to happen,+-- use the @'delegate_ctlc' = True@ option in the 'CreateProcess' options.+--+-- The gory details:+--+-- By default Ctl-C will generate a @SIGINT@ signal, causing a 'UserInterrupt'+-- exception to be sent to the main Haskell thread of your program, which if+-- not specially handled will terminate the program. Normally, this is exactly+-- what is wanted: an orderly shutdown of the program in response to Ctl-C.+--+-- Of course when running another interactive program in the console then we+-- want to let that program handle Ctl-C. Under Unix however, Ctl-C sends+-- @SIGINT@ to every process using the console. The standard solution is that+-- while running an interactive program, ignore @SIGINT@ in the parent, and let+-- it be handled in the child process. If that process then terminates due to+-- the @SIGINT@ signal, then at that point treat it as if we had recieved the+-- @SIGINT@ ourselves and begin an orderly shutdown.+--+-- This behaviour is implemented by 'createProcess' (and+-- 'waitForProcess' \/ 'getProcessExitCode') when the @'delegate_ctlc' = True@+-- option is set. In particular, the @SIGINT@ signal will be ignored until+-- 'waitForProcess' returns (or 'getProcessExitCode' returns a non-Nothing+-- result), so it becomes especially important to use 'waitForProcess' for every+-- processes created.+--+-- In addition, in 'delegate_ctlc' mode, 'waitForProcess' and+-- 'getProcessExitCode' will throw a 'UserInterrupt' exception if the process+-- terminated with @'ExitFailure' (-SIGINT)@. Typically you will not want to+-- catch this exception, but let it propagate, giving a normal orderly shutdown.+-- One detail to be aware of is that the 'UserInterrupt' exception is thrown+-- /synchronously/ in the thread that calls 'waitForProcess', whereas normally+-- @SIGINT@ causes the exception to be thrown /asynchronously/ to the main+-- thread.+--+-- For even more detail on this topic, see+-- <http://www.cons.org/cracauer/sigint.html "Proper handling of SIGINT/SIGQUIT">.++-- -----------------------------------------------------------------------------+ -- | @readProcess@ forks an external process, reads its standard output -- strictly, blocking until the process terminates, and returns the output -- string.@@ -394,37 +426,36 @@ -> [String] -- ^ any arguments -> String -- ^ standard input -> IO String -- ^ stdout-readProcess cmd args input =- mask $ \restore -> do- (Just inh, Just outh, _, pid) <-- createProcess (proc cmd args){ std_in = CreatePipe,- std_out = CreatePipe,- std_err = Inherit }- flip onException- (do hClose inh; hClose outh;- terminateProcess pid; waitForProcess pid) $ restore $ do+readProcess cmd args input = do+ let cp_opts = (proc cmd args) {+ std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = Inherit+ }+ (ex, output) <- withCreateProcess_ "readProcess" cp_opts $+ \(Just inh) (Just outh) _ ph -> do+ -- fork off a thread to start consuming the output output <- hGetContents outh- waitOut <- forkWait $ C.evaluate $ rnf output+ withForkWait (C.evaluate $ rnf output) $ \waitOut -> do - -- now write and flush any input- when (not (null input)) $ do hPutStr inh input; hFlush inh- hClose inh -- done with stdin+ -- now write any input+ unless (null input) $+ ignoreSigPipe $ 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 output+ waitOut+ hClose outh -- wait on the process- ex <- waitForProcess pid+ ex <- waitForProcess ph+ return (ex, output) - case ex of- ExitSuccess -> return output- ExitFailure r ->- ioError (mkIOError OtherError ("readProcess: " ++ cmd ++- ' ':unwords (map show args) ++- " (exit " ++ show r ++ ")")- Nothing Nothing)+ case ex of+ ExitSuccess -> return output+ ExitFailure r -> processFailedException "readProcess" cmd args r {- | @readProcessWithExitCode@ creates an external process, reads its@@ -441,6 +472,9 @@ 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@@ -448,141 +482,156 @@ -> [String] -- ^ any arguments -> String -- ^ standard input -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input =- mask $ \restore -> do- (Just inh, Just outh, Just errh, pid) <- createProcess (proc cmd args)- { std_in = CreatePipe,- std_out = CreatePipe,- std_err = CreatePipe }- flip onException- (do hClose inh; hClose outh; hClose errh;- terminateProcess pid; waitForProcess pid) $ restore $ do- -- fork off a thread to start consuming stdout- out <- hGetContents outh- waitOut <- forkWait $ C.evaluate $ rnf out+readProcessWithExitCode cmd args input = do+ let cp_opts = (proc cmd args) {+ std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = CreatePipe+ }+ withCreateProcess_ "readProcessWithExitCode" cp_opts $+ \(Just inh) (Just outh) (Just errh) ph -> do - -- fork off a thread to start consuming stderr+ out <- hGetContents outh err <- hGetContents errh- waitErr <- forkWait $ C.evaluate $ rnf err - -- now write and flush any input- let writeInput = do- unless (null input) $ do- hPutStr inh input- hFlush inh- hClose inh+ -- fork off threads to start consuming stdout & stderr+ withForkWait (C.evaluate $ rnf out) $ \waitOut ->+ withForkWait (C.evaluate $ rnf err) $ \waitErr -> do -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 611- C.catch writeInput $ \e -> case e of- IOError { ioe_type = ResourceVanished- , ioe_errno = Just ioe }- | Errno ioe == ePIPE -> return ()- _ -> throwIO e-#else- writeInput-#endif+ -- now write any input+ unless (null input) $+ ignoreSigPipe $ hPutStr inh input+ -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE+ ignoreSigPipe $ hClose inh - -- wait on the output- waitOut- waitErr+ -- wait on the output+ waitOut+ waitErr - hClose outh- hClose errh+ hClose outh+ hClose errh -- wait on the process- ex <- waitForProcess pid+ ex <- waitForProcess ph return (ex, out, err) -forkWait :: IO a -> IO (IO a)-forkWait a = do- res <- newEmptyMVar- _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res- return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)+-- | 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 -#endif /* !__HUGS__ */+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 --- ------------------------------------------------------------------------------ system+-- ----------------------------------------------------------------------------+-- showCommandForUser -{-|-Computation @system cmd@ returns the exit code produced when the-operating system runs the shell command @cmd@.+-- | Given a program @/p/@ and arguments @/args/@,+-- @showCommandForUser /p/ /args/@ returns a string suitable for pasting+-- into @\/bin\/sh@ (on Unix systems) or @CMD.EXE@ (on Windows).+showCommandForUser :: FilePath -> [String] -> String+showCommandForUser cmd args = unwords (map translate (cmd : args)) -This computation may fail with - * @PermissionDenied@: The process has insufficient privileges to- perform the operation.+-- ----------------------------------------------------------------------------+-- waitForProcess - * @ResourceExhausted@: Insufficient resources are available to- perform the operation.+{- | Waits for the specified process to terminate, and returns its exit code. - * @UnsupportedOperation@: The implementation does not support- system calls.+GHC Note: in order to call @waitForProcess@ without blocking all the+other threads in the system, you must compile the program with+@-threaded@. -On Windows, 'system' passes the command to the Windows command-interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks-will not work.+(/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.+ -}-#ifdef __GLASGOW_HASKELL__-system :: String -> IO ExitCode-system "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command")-system str = syncProcess "system" (shell str)+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 -syncProcess :: String -> CreateProcess -> IO ExitCode-#if mingw32_HOST_OS-syncProcess _fun c = do- (_,_,_,p) <- createProcess c- waitForProcess p-#else-syncProcess fun c = do- -- The POSIX version of system needs to do some manipulation of signal- -- handlers. Since we're going to be synchronously waiting for the child,- -- we want to ignore ^C in the parent, but handle it the default way- -- in the child (using SIG_DFL isn't really correct, it should be the- -- original signal handler, but the GHC RTS will have already set up- -- its own handler and we don't want to use that).- old_int <- installHandler sigINT Ignore Nothing- old_quit <- installHandler sigQUIT Ignore Nothing- (_,_,_,p) <- runGenProcess_ fun c- (Just defaultSignal) (Just defaultSignal)- r <- waitForProcess p- _ <- installHandler sigINT old_int Nothing- _ <- installHandler sigQUIT old_quit Nothing- return r-#endif /* mingw32_HOST_OS */-#endif /* __GLASGOW_HASKELL__ */+-- ----------------------------------------------------------------------------+-- getProcessExitCode -{-|-The computation @'rawSystem' cmd args@ runs the operating system command-@cmd@ in such a way that it receives as arguments the @args@ strings-exactly as given, with no funny escaping or shell meta-syntax expansion.-It will therefore behave more portably between operating systems than 'system'.+{- |+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. -The return codes and possible failures are the same as for 'system'.+On Unix systems, see 'waitForProcess' for the meaning of exit codes+when the process died as the result of a signal. -}-rawSystem :: String -> [String] -> IO ExitCode-#ifdef __GLASGOW_HASKELL__-rawSystem cmd args = syncProcess "rawSystem" (proc cmd args)-#elif !mingw32_HOST_OS--- crude fallback implementation: could do much better than this under Unix-rawSystem cmd args = system (showCommandForUser cmd args)-#else /* mingw32_HOST_OS && ! __GLASGOW_HASKELL__ */-# if __HUGS__-rawSystem cmd args = system (cmd ++ showCommandForUser "" args)-# else-rawSystem cmd args = system (showCommandForUser cmd args)-#endif-#endif --- | Given a program @p@ and arguments @args@,--- @showCommandForUser p args@ returns a string suitable for pasting--- into sh (on POSIX OSs) or cmd.exe (on Windows).-showCommandForUser :: FilePath -> [String] -> String-showCommandForUser cmd args = unwords (map translate (cmd : args))+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 -#ifndef __HUGS__+ -- ---------------------------------------------------------------------------- -- terminateProcess @@ -603,15 +652,16 @@ terminateProcess :: ProcessHandle -> IO () terminateProcess ph = do- withProcessHandle_ ph $ \p_ ->+ withProcessHandle ph $ \p_ -> case p_ of- ClosedHandle _ -> return p_+ ClosedHandle _ -> return () OpenHandle h -> do throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h- return p_+ return () -- does not close the handle, we might want to try terminating it -- again, or get its exit code. + -- ---------------------------------------------------------------------------- -- interruptProcessGroupOf @@ -626,55 +676,23 @@ :: ProcessHandle -- ^ A process in the process group -> IO () interruptProcessGroupOf ph = do-#if mingw32_HOST_OS- withProcessHandle_ ph $ \p_ -> do+ withProcessHandle ph $ \p_ -> do case p_ of- ClosedHandle _ -> return p_+ ClosedHandle _ -> return () OpenHandle h -> do+#if mingw32_HOST_OS pid <- getProcessId h generateConsoleCtrlEvent cTRL_BREAK_EVENT pid- return p_+-- We can't use an #elif here, because MIN_VERSION_unix isn't defined+-- on Windows, so on Windows cpp fails:+-- error: missing binary operator before token "(" #else- withProcessHandle_ ph $ \p_ -> do- case p_ of- ClosedHandle _ -> return p_- OpenHandle h -> do-#if MIN_VERSION_unix(2,5,0)- -- getProcessGroupIDOf was added in unix-2.5.0.0 pgid <- getProcessGroupIDOf h signalProcessGroup sigINT pgid-#else- signalProcessGroup sigINT h #endif- return p_-#endif+ return () --- ------------------------------------------------------------------------------- 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.--}-getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)-getProcessExitCode ph = do- withProcessHandle ph $ \p_ ->- case p_ of- ClosedHandle e -> return (p_, Just e)- OpenHandle h ->- alloca $ \pExitCode -> do- res <- throwErrnoIfMinus1Retry "getProcessExitCode" $- c_getProcessExitCode h pExitCode- code <- peek pExitCode- if res == 0- then return (p_, Nothing)- else do- closePHANDLE h- let e | code == 0 = ExitSuccess- | otherwise = ExitFailure (fromIntegral code)- return (ClosedHandle e, Just e)- -- ---------------------------------------------------------------------------- -- Interface to C bits @@ -689,15 +707,204 @@ -> Ptr CInt -> IO CInt -#if __GLASGOW_HASKELL__ < 701--- not available prior to 7.1-#define interruptible safe-#endif- foreign import ccall interruptible "waitForProcess" -- NB. safe - can block c_waitForProcess :: PHANDLE -> Ptr CInt -> IO CInt+++-- ----------------------------------------------------------------------------+-- Old deprecated variants+-- ----------------------------------------------------------------------------++-- TODO: We're not going to mark these functions as DEPRECATED immediately in+-- process-1.2.0.0. That's because some of their replacements have not been+-- around for all that long. But they should eventually be marked with a+-- suitable DEPRECATED pragma after a release or two.+++-- ----------------------------------------------------------------------------+-- runCommand++--TODO: in a later release {-# DEPRECATED runCommand "Use 'spawnCommand' instead" #-}++{- | Runs a command using the shell.+ -}+runCommand+ :: String+ -> IO ProcessHandle++runCommand string = do+ (_,_,_,ph) <- createProcess_ "runCommand" (shell string)+ return ph+++-- ----------------------------------------------------------------------------+-- runProcess++--TODO: in a later release {-# DEPRECATED runProcess "Use 'spawnProcess' or 'createProcess' instead" #-}++{- | Runs a raw command, optionally specifying 'Handle's from which to+ take the @stdin@, @stdout@ and @stderr@ channels for the new+ process (otherwise these handles are inherited from the current+ process).++ Any 'Handle's passed to 'runProcess' are placed immediately in the+ closed state.++ Note: consider using the more general 'createProcess' instead of+ 'runProcess'.+-}+runProcess+ :: FilePath -- ^ Filename of the executable (see 'proc' for details)+ -> [String] -- ^ Arguments to pass to the executable+ -> Maybe FilePath -- ^ Optional path to the working directory+ -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)+ -> Maybe Handle -- ^ Handle to use for @stdin@ (Nothing => use existing @stdin@)+ -> Maybe Handle -- ^ Handle to use for @stdout@ (Nothing => use existing @stdout@)+ -> Maybe Handle -- ^ Handle to use for @stderr@ (Nothing => use existing @stderr@)+ -> IO ProcessHandle++runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do+ (_,_,_,ph) <-+ createProcess_ "runProcess"+ (proc cmd args){ cwd = mb_cwd,+ env = mb_env,+ std_in = mbToStd mb_stdin,+ std_out = mbToStd mb_stdout,+ std_err = mbToStd mb_stderr }+ maybeClose mb_stdin+ maybeClose mb_stdout+ maybeClose mb_stderr+ return ph+ where+ maybeClose :: Maybe Handle -> IO ()+ maybeClose (Just hdl)+ | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl+ maybeClose _ = return ()++ mbToStd :: Maybe Handle -> StdStream+ mbToStd Nothing = Inherit+ mbToStd (Just hdl) = UseHandle hdl+++-- ----------------------------------------------------------------------------+-- runInteractiveCommand++--TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-}++{- | Runs a command using the shell, and returns 'Handle's that may+ be used to communicate with the process via its @stdin@, @stdout@,+ and @stderr@ respectively. The 'Handle's are initially in binary+ mode; if you need them to be in text mode then use 'hSetBinaryMode'.+-}+runInteractiveCommand+ :: String+ -> IO (Handle,Handle,Handle,ProcessHandle)++runInteractiveCommand string =+ runInteractiveProcess1 "runInteractiveCommand" (shell string)+++-- ----------------------------------------------------------------------------+-- runInteractiveProcess++--TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-}++{- | Runs a raw command, and returns 'Handle's that may be used to communicate+ with the process via its @stdin@, @stdout@ and @stderr@ respectively.++ For example, to start a process and feed a string to its stdin:++> (inp,out,err,pid) <- runInteractiveProcess "..."+> forkIO (hPutStr inp str)++ The 'Handle's are initially in binary mode; if you need them to be+ in text mode then use 'hSetBinaryMode'.+-}+runInteractiveProcess+ :: FilePath -- ^ Filename of the executable (see 'proc' for details)+ -> [String] -- ^ Arguments to pass to the executable+ -> Maybe FilePath -- ^ Optional path to the working directory+ -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)+ -> IO (Handle,Handle,Handle,ProcessHandle)++runInteractiveProcess cmd args mb_cwd mb_env = do+ runInteractiveProcess1 "runInteractiveProcess"+ (proc cmd args){ cwd = mb_cwd, env = mb_env }++runInteractiveProcess1+ :: String+ -> CreateProcess+ -> IO (Handle,Handle,Handle,ProcessHandle)+runInteractiveProcess1 fun cmd = do+ (mb_in, mb_out, mb_err, p) <-+ createProcess_ fun+ cmd{ std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = CreatePipe }+ return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p) #endif /* !__HUGS__ */ ++-- ---------------------------------------------------------------------------+-- system & rawSystem++--TODO: in a later release {-# DEPRECATED system "Use 'callCommand' (or 'spawnCommand' and 'waitForProcess') instead" #-}++{-|+Computation @system cmd@ returns the exit code produced when the+operating system runs the shell command @cmd@.++This computation may fail with one of the following+'System.IO.Error.IOErrorType' exceptions:++[@PermissionDenied@]+The process has insufficient privileges to perform the operation.++[@ResourceExhausted@]+Insufficient resources are available to perform the operation.++[@UnsupportedOperation@]+The implementation does not support system calls.++On Windows, 'system' passes the command to the Windows command+interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks+will not work.++On Unix systems, see 'waitForProcess' for the meaning of exit codes+when the process died as the result of a signal.+-}+#ifdef __GLASGOW_HASKELL__+system :: String -> IO ExitCode+system "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command")+system str = do+ (_,_,_,p) <- createProcess_ "system" (shell str) { delegate_ctlc = True }+ waitForProcess p+#endif /* __GLASGOW_HASKELL__ */+++--TODO: in a later release {-# DEPRECATED rawSystem "Use 'callProcess' (or 'spawnProcess' and 'waitForProcess') instead" #-}++{-|+The computation @'rawSystem' /cmd/ /args/@ runs the operating system command+@/cmd/@ in such a way that it receives as arguments the @/args/@ strings+exactly as given, with no funny escaping or shell meta-syntax expansion.+It will therefore behave more portably between operating systems than 'system'.++The return codes and possible failures are the same as for 'system'.+-}+rawSystem :: String -> [String] -> IO ExitCode+#ifdef __GLASGOW_HASKELL__+rawSystem cmd args = do+ (_,_,_,p) <- createProcess_ "rawSystem" (proc cmd args) { delegate_ctlc = True }+ waitForProcess p+#elif !mingw32_HOST_OS+-- crude fallback implementation: could do much better than this under Unix+rawSystem cmd args = system (showCommandForUser cmd args)+#elif __HUGS__+rawSystem cmd args = system (cmd ++ showCommandForUser "" args)+#else+rawSystem cmd args = system (showCommandForUser cmd args)+#endif
System/Process/Internals.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE CPP, ForeignFunctionInterface, RecordWildCards #-}+{-# LANGUAGE CPP, RecordWildCards, BangPatterns #-} {-# OPTIONS_HADDOCK hide #-}-{-# OPTIONS_GHC -w #-}--- XXX We get some warnings on Windows-#if __GLASGOW_HASKELL__ >= 701+#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE InterruptibleFFI #-} #endif -----------------------------------------------------------------------------@@ -11,7 +10,7 @@ -- Module : System.Process.Internals -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable@@ -20,97 +19,82 @@ -- ----------------------------------------------------------------------------- --- #hide module System.Process.Internals (-#ifndef __HUGS__- ProcessHandle(..), ProcessHandle__(..), - PHANDLE, closePHANDLE, mkProcessHandle, - withProcessHandle, withProcessHandle_,+ ProcessHandle(..), ProcessHandle__(..),+ PHANDLE, closePHANDLE, mkProcessHandle,+ modifyProcessHandle, withProcessHandle, #ifdef __GLASGOW_HASKELL__ CreateProcess(..), CmdSpec(..), StdStream(..),- runGenProcess_,+ createProcess_,+ runGenProcess_, --deprecated #endif+ startDelegateControlC,+ endDelegateControlC, #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)- pPrPr_disableITimers, c_execvpe,+ pPrPr_disableITimers, c_execvpe, ignoreSignal, defaultSignal, #endif-#endif withFilePathException, withCEnvironment, translate,--#ifndef __HUGS__ fdToHandle,-#endif ) where -#ifndef __HUGS__ #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Control.Monad+import Data.Char import System.Posix.Types import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe )-import System.IO ( IOMode(..) )-#else-import Data.Word ( Word32 )-import Data.IORef-#endif+import System.IO #endif -import System.IO ( Handle )-import System.Exit ( ExitCode ) import Control.Concurrent import Control.Exception+import Data.Bits import Foreign.C-import Foreign--# ifdef __GLASGOW_HASKELL__+import Foreign.Marshal+import Foreign.Ptr+import Foreign.Storable+import System.IO.Unsafe +#ifdef __GLASGOW_HASKELL__ import System.Posix.Internals-#if __GLASGOW_HASKELL__ >= 611 import GHC.IO.Exception import GHC.IO.Encoding import qualified GHC.IO.FD as FD import GHC.IO.Device-import GHC.IO.Handle import GHC.IO.Handle.FD import GHC.IO.Handle.Internals-import GHC.IO.Handle.Types+import GHC.IO.Handle.Types hiding (ClosedHandle) import System.IO.Error import Data.Typeable #if defined(mingw32_HOST_OS) import GHC.IO.IOMode import System.Win32.DebugApi (PHANDLE)-#endif #else-import GHC.IOBase ( haFD, FD, IOException(..) )-import GHC.Handle+import System.Posix.Signals as Sig #endif--# elif __HUGS__--import Hugs.Exception ( IOException(..) )--# endif--#ifdef base4-import System.IO.Error ( ioeSetFileName ) #endif+ #if defined(mingw32_HOST_OS)-import Control.Monad ( when ) import System.Directory ( doesFileExist )-import System.IO.Error ( isDoesNotExistError, doesNotExistErrorType,- mkIOError ) import System.Environment ( getEnv ) import System.FilePath #endif -#ifdef __HUGS__-{-# CFILES cbits/execvpe.c #-}-#endif- #include "HsProcessConfig.h" #include "processFlags.h" -#ifndef __HUGS__+#ifdef mingw32_HOST_OS+# if defined(i386_HOST_ARCH)+# define WINDOWS_CCONV stdcall+# elif defined(x86_64_HOST_ARCH)+# define WINDOWS_CCONV ccall+# else+# error Unknown mingw32 arch+# endif+#endif+ -- ---------------------------------------------------------------------------- -- ProcessHandle type @@ -122,51 +106,48 @@ to wait for the process later. -} data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode-newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)+data ProcessHandle = ProcessHandle !(MVar ProcessHandle__) !Bool -withProcessHandle- :: ProcessHandle +modifyProcessHandle+ :: ProcessHandle -> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a-withProcessHandle (ProcessHandle m) io = modifyMVar m io+modifyProcessHandle (ProcessHandle m _) io = modifyMVar m io -withProcessHandle_- :: ProcessHandle - -> (ProcessHandle__ -> IO ProcessHandle__)- -> IO ()-withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io+withProcessHandle+ :: ProcessHandle+ -> (ProcessHandle__ -> IO a)+ -> IO a+withProcessHandle (ProcessHandle m _) io = withMVar m io #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) type PHANDLE = CPid -throwErrnoIfBadPHandle :: String -> IO PHANDLE -> IO PHANDLE -throwErrnoIfBadPHandle = throwErrnoIfMinus1--mkProcessHandle :: PHANDLE -> IO ProcessHandle-mkProcessHandle p = do+mkProcessHandle :: PHANDLE -> Bool -> IO ProcessHandle+mkProcessHandle p mb_delegate_ctlc = do m <- newMVar (OpenHandle p)- return (ProcessHandle m)+ return (ProcessHandle m mb_delegate_ctlc) closePHANDLE :: PHANDLE -> IO () closePHANDLE _ = return () #else -throwErrnoIfBadPHandle :: String -> IO PHANDLE -> IO PHANDLE +throwErrnoIfBadPHandle :: String -> IO PHANDLE -> IO PHANDLE throwErrnoIfBadPHandle = throwErrnoIfNull -- On Windows, we have to close this HANDLE when it is no longer required,--- hence we add a finalizer to it, using an IORef as the box on which to--- attach the finalizer.+-- hence we add a finalizer to it mkProcessHandle :: PHANDLE -> IO ProcessHandle mkProcessHandle h = do m <- newMVar (OpenHandle h)- addMVarFinalizer m (processHandleFinaliser m)- return (ProcessHandle m)+ _ <- mkWeakMVar m (processHandleFinaliser m)+ return (ProcessHandle m False) +processHandleFinaliser :: MVar ProcessHandle__ -> IO () processHandleFinaliser m =- modifyMVar_ m $ \p_ -> do + modifyMVar_ m $ \p_ -> do case p_ of OpenHandle ph -> closePHANDLE ph _ -> return ()@@ -175,12 +156,11 @@ closePHANDLE :: PHANDLE -> IO () closePHANDLE ph = c_CloseHandle ph -foreign import stdcall unsafe "CloseHandle"+foreign import WINDOWS_CCONV unsafe "CloseHandle" c_CloseHandle :: PHANDLE -> IO () #endif-#endif /* !__HUGS__ */ -- ---------------------------------------------------------------------------- @@ -192,11 +172,16 @@ std_out :: StdStream, -- ^ How to determine stdout std_err :: StdStream, -- ^ How to determine stderr close_fds :: Bool, -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit)- create_group :: Bool -- ^ Create a new process group+ create_group :: Bool, -- ^ Create a new process group+ delegate_ctlc:: Bool -- ^ Delegate control-C handling. Use this for interactive console processes to let them handle control-C themselves (see below for details).+ --+ -- On Windows this has no effect.+ --+ -- /Since: 1.2.0.0/ } -data CmdSpec - = ShellCommand String +data CmdSpec+ = ShellCommand String -- ^ a command line to execute using the shell | RawCommand FilePath [String] -- ^ the filename of an executable with a list of arguments.@@ -211,11 +196,9 @@ -- and newline translation mode (just -- like @Handle@s created by @openFile@). -runGenProcess_+createProcess_ :: String -- ^ function name (for error messages) -> CreateProcess- -> Maybe CLong -- ^ handler for SIGINT- -> Maybe CLong -- ^ handler for SIGQUIT -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)@@ -225,64 +208,140 @@ -- ----------------------------------------------------------------------------- -- POSIX runProcess with signal handling in the child -runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,+createProcess_ 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 }- mb_sigint mb_sigquit+ create_group = mb_create_group,+ delegate_ctlc = mb_delegate_ctlc } = do let (cmd,args) = commandToProcess cmdsp withFilePathException cmd $ alloca $ \ pfdStdInput -> alloca $ \ pfdStdOutput -> alloca $ \ pfdStdError ->+ alloca $ \ pFailedDoing -> maybeWith withCEnvironment mb_env $ \pEnv -> maybeWith withFilePath mb_cwd $ \pWorkDir -> withMany withFilePath (cmd:args) $ \cstrs -> withArray0 nullPtr cstrs $ \pargs -> do- + fdin <- mbFd fun fd_stdin mb_stdin fdout <- mbFd fun fd_stdout mb_stdout fderr <- mbFd fun fd_stderr mb_stderr - let (set_int, inthand) - = case mb_sigint of- Nothing -> (0, 0)- Just hand -> (1, hand)- (set_quit, quithand) - = case mb_sigquit of- Nothing -> (0, 0)- Just hand -> (1, hand)+ when mb_delegate_ctlc+ startDelegateControlC -- runInteractiveProcess() blocks signals around the fork(). -- Since blocking/unblocking of signals is a global state -- operation, we better ensure mutual exclusion of calls to -- runInteractiveProcess(). proc_handle <- withMVar runInteractiveProcess_lock $ \_ ->- throwErrnoIfMinus1 fun $- c_runInteractiveProcess pargs pWorkDir pEnv + c_runInteractiveProcess pargs pWorkDir pEnv fdin fdout fderr pfdStdInput pfdStdOutput pfdStdError- set_int inthand set_quit quithand+ (if mb_delegate_ctlc then 1 else 0) ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0) .|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0))+ pFailedDoing + when (proc_handle == -1) $ do+ cFailedDoing <- peek pFailedDoing+ failedDoing <- peekCString cFailedDoing+ throwErrno (fun ++ ": " ++ failedDoing)+ hndStdInput <- mbPipe mb_stdin pfdStdInput WriteMode hndStdOutput <- mbPipe mb_stdout pfdStdOutput ReadMode hndStdError <- mbPipe mb_stderr pfdStdError ReadMode - ph <- mkProcessHandle proc_handle+ ph <- mkProcessHandle proc_handle mb_delegate_ctlc return (hndStdInput, hndStdOutput, hndStdError, ph) {-# NOINLINE runInteractiveProcess_lock #-} runInteractiveProcess_lock :: MVar () runInteractiveProcess_lock = unsafePerformIO $ newMVar () -foreign import ccall unsafe "runInteractiveProcess" +-- ----------------------------------------------------------------------------+-- Delegated control-C handling on Unix++-- See ticket https://ghc.haskell.org/trac/ghc/ticket/2301+-- and http://www.cons.org/cracauer/sigint.html+--+-- While running an interactive console process like ghci or a shell, we want+-- to let that process handle Ctl-C keyboard interrupts how it sees fit.+-- So that means we need to ignore the SIGINT/SIGQUIT Unix signals while we're+-- running such programs. And then if/when they do terminate, we need to check+-- if they terminated due to SIGINT/SIGQUIT and if so then we behave as if we+-- got the Ctl-C then, by throwing the UserInterrupt exception.+--+-- If we run multiple programs like this concurrently then we have to be+-- careful to avoid messing up the signal handlers. We keep a count and only+-- restore when the last one has finished.++{-# NOINLINE runInteractiveProcess_delegate_ctlc #-}+runInteractiveProcess_delegate_ctlc :: MVar (Maybe (Int, Sig.Handler, Sig.Handler))+runInteractiveProcess_delegate_ctlc = unsafePerformIO $ newMVar Nothing++startDelegateControlC :: IO ()+startDelegateControlC =+ 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.+ --+ -- If another thread runs another process without using+ -- delegation while we're doing this then it will inherit the+ -- ignore ^C status.+ old_int <- installHandler sigINT Ignore Nothing+ old_quit <- installHandler sigQUIT Ignore Nothing+ 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+ 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++ -- And if the process did die due to SIGINT or SIGQUIT then+ -- we throw our equivalent exception here (synchronously).+ --+ -- An alternative design would be to throw to the main thread, as the+ -- normal signal handler does. But since we can be sync here, we do so.+ -- It allows the code locally to catch it and do something.+ case exitCode of+ ExitFailure n | isSigIntQuit n -> throwIO UserInterrupt+ _ -> return ()+ where+ isSigIntQuit n = sig == sigINT || sig == sigQUIT+ where+ sig = fromIntegral (-n)++foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: Ptr CString -> CString@@ -293,11 +352,9 @@ -> Ptr FD -> Ptr FD -> Ptr FD- -> CInt -- non-zero: set child's SIGINT handler- -> CLong -- SIGINT handler- -> CInt -- non-zero: set child's SIGQUIT handler- -> CLong -- SIGQUIT handler+ -> CInt -- reset child's SIGINT & SIGQUIT handlers -> CInt -- flags+ -> Ptr CString -> IO PHANDLE #endif /* __GLASGOW_HASKELL__ */@@ -310,15 +367,15 @@ #ifdef __GLASGOW_HASKELL__ -runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,+createProcess_ 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 }- _ignored_mb_sigint _ignored_mb_sigquit+ create_group = mb_create_group,+ delegate_ctlc = _ignored } = do (cmd, cmdline) <- commandToProcess cmdsp withFilePathException cmd $@@ -328,7 +385,7 @@ maybeWith withCEnvironment mb_env $ \pEnv -> 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@@ -338,14 +395,14 @@ -- 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 + c_runInteractiveProcess pcmdline pWorkDir pEnv fdin fdout fderr pfdStdInput pfdStdOutput pfdStdError ((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)@@ -362,6 +419,12 @@ runInteractiveProcess_lock :: MVar () runInteractiveProcess_lock = unsafePerformIO $ newMVar () +startDelegateControlC :: IO ()+startDelegateControlC = return ()++endDelegateControlC :: ExitCode -> IO ()+endDelegateControlC _ = return ()+ foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: CWString@@ -387,22 +450,18 @@ mbFd :: String -> FD -> StdStream -> IO FD mbFd _ _std CreatePipe = return (-1) mbFd _fun std Inherit = return std-mbFd fun _std (UseHandle hdl) = -#if __GLASGOW_HASKELL__ < 611- withHandle_ fun hdl $ return . haFD-#else- withHandle fun hdl $ \h@Handle__{haDevice=dev,..} ->+mbFd fun _std (UseHandle hdl) =+ withHandle fun hdl $ \Handle__{haDevice=dev,..} -> case cast dev of Just fd -> do -- clear the O_NONBLOCK flag on this FD, if it is set, since -- we're exposing it externally (see #3316)- fd <- FD.setNonBlockingMode fd False- return (Handle__{haDevice=fd,..}, FD.fdFD fd)+ fd' <- FD.setNonBlockingMode fd False+ return (Handle__{haDevice=fd',..}, FD.fdFD fd') Nothing -> ioError (mkIOError illegalOperationErrorType "createProcess" (Just hdl) Nothing `ioeSetErrorString` "handle is not a file descriptor")-#endif mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle) mbPipe CreatePipe pfd mode = fmap Just (pfdToHandle pfd mode)@@ -412,26 +471,18 @@ pfdToHandle pfd mode = do fd <- peek pfd let filepath = "fd:" ++ show fd-#if __GLASGOW_HASKELL__ >= 611- (fD,fd_type) <- FD.mkFD (fromIntegral fd) mode + (fD,fd_type) <- FD.mkFD (fromIntegral fd) mode (Just (Stream,0,0)) -- avoid calling fstat() False {-is_socket-} False {-non-blocking-}- fD <- FD.setNonBlockingMode fD True -- see #3316+ fD' <- FD.setNonBlockingMode fD True -- see #3316+#if __GLASGOW_HASKELL__ >= 704 enc <- getLocaleEncoding- mkHandleFromFD fD fd_type filepath mode False {-is_socket-} (Just enc) #else- fdToHandle' fd (Just Stream)- False {-Windows: not a socket, Unix: don't set non-blocking-}- filepath mode True {-binary-}-#endif--#if __GLASGOW_HASKELL__ < 703-getLocaleEncoding :: IO TextEncoding-getLocaleEncoding = return localeEncoding+ let enc = localeEncoding #endif+ mkHandleFromFD fD' fd_type filepath mode False {-is_socket-} (Just enc) -#ifndef __HUGS__ -- ---------------------------------------------------------------------------- -- commandToProcess @@ -440,7 +491,7 @@ There's a difference in the signature of commandToProcess between the Windows and Unix versions. On Unix, exec takes a list of strings,- and we want to pass our command to /bin/sh as a single argument. + and we want to pass our command to /bin/sh as a single argument. On Windows, CreateProcess takes a single string for the command, which is later decomposed by cmd.exe. In this case, we just want@@ -477,14 +528,8 @@ findCommandInterpreter :: IO FilePath findCommandInterpreter = do -- try COMSPEC first-#ifdef base3- catchJust (\e -> case e of - IOException e | isDoesNotExistError e -> Just e- _otherwise -> Nothing)-#else catchJust (\e -> if isDoesNotExistError e then Just e else Nothing)-#endif- (getEnv "COMSPEC") $ \e -> do+ (getEnv "COMSPEC") $ \_ -> do -- try to find CMD.EXE or COMMAND.COM {-@@ -513,13 +558,11 @@ mb_path <- search (splitSearchPath path) case mb_path of- Nothing -> ioError (mkIOError doesNotExistErrorType + Nothing -> ioError (mkIOError doesNotExistErrorType "findCommandInterpreter" Nothing Nothing) Just cmd -> return cmd #endif -#endif /* __HUGS__ */- -- ------------------------------------------------------------------------ -- Escaping commands for shells @@ -577,20 +620,27 @@ translate :: String -> String #if mingw32_HOST_OS-translate str = '"' : snd (foldr escape (True,"\"") str)- where escape '"' (b, str) = (True, '\\' : '"' : str)+translate xs = '"' : snd (foldr escape (True,"\"") xs)+ where escape '"' (_, str) = (True, '\\' : '"' : str) escape '\\' (True, str) = (True, '\\' : '\\' : str) escape '\\' (False, str) = (False, '\\' : str)- escape c (b, str) = (False, c : str)+ escape c (_, str) = (False, c : str) -- See long comment above for what this function is trying to do. -- -- The Bool passed back along the string is True iff the -- rest of the string is a sequence of backslashes followed by -- a double quote. #else-translate str = '\'' : foldr escape "'" str+translate "" = "''"+translate str+ -- goodChar is a pessimistic predicate, such that if an argument is+ -- non-empty and only contains goodChars, then there is no need to+ -- do any quoting or escaping+ | all goodChar str = str+ | otherwise = '\'' : foldr escape "'" str where escape '\'' = showString "'\\''" escape c = showChar c+ goodChar c = isAlphaNum c || c `elem` "-_.,/" #endif -- ----------------------------------------------------------------------------@@ -599,16 +649,12 @@ withFilePathException :: FilePath -> IO a -> IO a withFilePathException fpath act = handle mapEx act where-#ifdef base4 mapEx ex = ioError (ioeSetFileName ex fpath)-#else- mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))-#endif #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a withCEnvironment envir act =- let env' = map (\(name, val) -> name ++ ('=':val)) envir + let env' = map (\(name, val) -> name ++ ('=':val)) envir in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act) #else withCEnvironment :: [(String,String)] -> (Ptr CWString -> IO a) -> IO a@@ -617,3 +663,25 @@ in withCWString env' (act . castPtr) #endif ++-- ----------------------------------------------------------------------------+-- Deprecated / compat++#ifdef __GLASGOW_HASKELL__+{-# DEPRECATED runGenProcess_+ "Please do not use this anymore, use the ordinary 'System.Process.createProcess'. If you need the SIGINT handling, use delegate_ctlc = True (runGenProcess_ is now just an imperfectly emulated stub that probably duplicates or overrides your own signal handling)." #-}+runGenProcess_+ :: String -- ^ function name (for error messages)+ -> CreateProcess+ -> Maybe CLong -- ^ handler for SIGINT+ -> Maybe CLong -- ^ handler for SIGQUIT+ -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+runGenProcess_ fun c (Just sig) (Just sig') | sig == defaultSignal && sig == sig'+ = createProcess_ fun c { delegate_ctlc = True }+runGenProcess_ fun c _ _ = createProcess_ fun c+#else+runGenProcess_ fun c _ _ = createProcess_ fun c+#endif++#endif
cbits/runProcess.c view
@@ -1,538 +1,628 @@-/* ---------------------------------------------------------------------------- - (c) The University of Glasgow 2004 - - Support for System.Process - ------------------------------------------------------------------------- */ - -#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) -#define UNICODE -#endif - -/* XXX This is a nasty hack; should put everything necessary in this package */ -#include "HsBase.h" -#include "Rts.h" - -#include "runProcess.h" - -#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) - -#include "execvpe.h" - -/* ---------------------------------------------------------------------------- - UNIX versions - ------------------------------------------------------------------------- */ - -static long max_fd = 0; - -// Rts internal API, not exposed in a public header file: -extern void blockUserSignals(void); -extern void unblockUserSignals(void); - -ProcHandle -runInteractiveProcess (char *const args[], - char *workingDirectory, char **environment, - int fdStdIn, int fdStdOut, int fdStdErr, - int *pfdStdInput, int *pfdStdOutput, int *pfdStdError, - int set_inthandler, long inthandler, - int set_quithandler, long quithandler, - int flags) -{ - int close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0); - int pid; - int fdStdInput[2], fdStdOutput[2], fdStdError[2]; - int r; - struct sigaction dfl; - - // Ordering matters here, see below [Note #431]. - if (fdStdIn == -1) { - r = pipe(fdStdInput); - if (r == -1) { - sysErrorBelch("runInteractiveProcess: pipe"); - return -1; - } - - } - if (fdStdOut == -1) { - r = pipe(fdStdOutput); - if (r == -1) { - sysErrorBelch("runInteractiveProcess: pipe"); - return -1; - } - } - if (fdStdErr == -1) { - r = pipe(fdStdError); - if (r == -1) { - sysErrorBelch("runInteractiveProcess: pipe"); - return -1; - } - } - - // Block signals with Haskell handlers. The danger here is that - // with the threaded RTS, a signal arrives in the child process, - // the RTS writes the signal information into the pipe (which is - // shared between parent and child), and the parent behaves as if - // the signal had been raised. - blockUserSignals(); - - // See #4074. Sometimes fork() gets interrupted by the timer - // signal and keeps restarting indefinitely. - stopTimer(); - - switch(pid = fork()) - { - case -1: - unblockUserSignals(); -#if __GLASGOW_HASKELL__ > 612 - startTimer(); -#endif - if (fdStdIn == -1) { - close(fdStdInput[0]); - close(fdStdInput[1]); - } - if (fdStdOut == -1) { - close(fdStdOutput[0]); - close(fdStdOutput[1]); - } - if (fdStdErr == -1) { - close(fdStdError[0]); - close(fdStdError[1]); - } - return -1; - - case 0: - { - // WARNING! we are now in the child of vfork(), so any memory - // we modify below will also be seen in the parent process. - - if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { - setpgid(0, 0); - } - - unblockUserSignals(); - - if (workingDirectory) { - if (chdir (workingDirectory) < 0) { - // See #1593. The convention for the exit code when - // exec() fails seems to be 127 (gleened from C's - // system()), but there's no equivalent convention for - // chdir(), so I'm picking 126 --SimonM. - _exit(126); - } - } - - // [Note #431]: Ordering matters here. If any of the FDs - // 0,1,2 were initially closed, then our pipes may have used - // these FDs. So when we dup2 the pipe FDs down to 0,1,2, we - // must do it in that order, otherwise we could overwrite an - // FD that we need later. - - if (fdStdIn == -1) { - if (fdStdInput[0] != STDIN_FILENO) { - dup2 (fdStdInput[0], STDIN_FILENO); - close(fdStdInput[0]); - } - close(fdStdInput[1]); - } else { - dup2(fdStdIn, STDIN_FILENO); - } - - if (fdStdOut == -1) { - if (fdStdOutput[1] != STDOUT_FILENO) { - dup2 (fdStdOutput[1], STDOUT_FILENO); - close(fdStdOutput[1]); - } - close(fdStdOutput[0]); - } else { - dup2(fdStdOut, STDOUT_FILENO); - } - - if (fdStdErr == -1) { - if (fdStdError[1] != STDERR_FILENO) { - dup2 (fdStdError[1], STDERR_FILENO); - close(fdStdError[1]); - } - close(fdStdError[0]); - } else { - dup2(fdStdErr, STDERR_FILENO); - } - - if (close_fds) { - int i; - if (max_fd == 0) { -#if HAVE_SYSCONF - max_fd = sysconf(_SC_OPEN_MAX); - if (max_fd == -1) { - max_fd = 256; - } -#else - max_fd = 256; -#endif - } - for (i = 3; i < max_fd; i++) { - close(i); - } - } - - /* Set the SIGINT/SIGQUIT signal handlers in the child, if requested - */ - (void)sigemptyset(&dfl.sa_mask); - dfl.sa_flags = 0; - if (set_inthandler) { - dfl.sa_handler = (void *)inthandler; - (void)sigaction(SIGINT, &dfl, NULL); - } - if (set_quithandler) { - dfl.sa_handler = (void *)quithandler; - (void)sigaction(SIGQUIT, &dfl, NULL); - } - - /* the child */ - if (environment) { - execvpe(args[0], args, environment); - } else { - execvp(args[0], args); - } - } - _exit(127); - - default: - if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { - setpgid(pid, pid); - } - if (fdStdIn == -1) { - close(fdStdInput[0]); - fcntl(fdStdInput[1], F_SETFD, FD_CLOEXEC); - *pfdStdInput = fdStdInput[1]; - } - if (fdStdOut == -1) { - close(fdStdOutput[1]); - fcntl(fdStdOutput[0], F_SETFD, FD_CLOEXEC); - *pfdStdOutput = fdStdOutput[0]; - } - if (fdStdErr == -1) { - close(fdStdError[1]); - fcntl(fdStdError[0], F_SETFD, FD_CLOEXEC); - *pfdStdError = fdStdError[0]; - } - break; - } - unblockUserSignals(); - startTimer(); - - return pid; -} - -int -terminateProcess (ProcHandle handle) -{ - return (kill(handle, SIGTERM) == 0); -} - -int -getProcessExitCode (ProcHandle handle, int *pExitCode) -{ - int wstat, res; - - *pExitCode = 0; - - if ((res = waitpid(handle, &wstat, WNOHANG)) > 0) - { - if (WIFEXITED(wstat)) - { - *pExitCode = WEXITSTATUS(wstat); - return 1; - } - else - if (WIFSIGNALED(wstat)) - { - errno = EINTR; - return -1; - } - else - { - /* This should never happen */ - } - } - - if (res == 0) return 0; - - if (errno == ECHILD) - { - *pExitCode = 0; - return 1; - } - - return -1; -} - -int waitForProcess (ProcHandle handle, int *pret) -{ - int wstat; - - if (waitpid(handle, &wstat, 0) < 0) - { - return -1; - } - - if (WIFEXITED(wstat)) { - *pret = WEXITSTATUS(wstat); - return 0; - } - else - if (WIFSIGNALED(wstat)) - { - *pret = wstat; - return 0; - } - else - { - /* This should never happen */ - } - - return -1; -} - -#else -/* ---------------------------------------------------------------------------- - Win32 versions - ------------------------------------------------------------------------- */ - -/* -------------------- WINDOWS VERSION --------------------- */ - -/* - * Function: mkAnonPipe - * - * Purpose: create an anonymous pipe with read and write ends being - * optionally (non-)inheritable. - */ -static BOOL -mkAnonPipe (HANDLE* pHandleIn, BOOL isInheritableIn, - HANDLE* pHandleOut, BOOL isInheritableOut) -{ - HANDLE hTemporaryIn = NULL; - HANDLE hTemporaryOut = NULL; - - /* Create the anon pipe with both ends inheritable */ - if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, NULL, 0)) - { - maperrno(); - *pHandleIn = NULL; - *pHandleOut = NULL; - return FALSE; - } - - if (isInheritableIn) { - // SetHandleInformation requires at least Win2k - if (!SetHandleInformation(hTemporaryIn, - HANDLE_FLAG_INHERIT, - HANDLE_FLAG_INHERIT)) - { - maperrno(); - *pHandleIn = NULL; - *pHandleOut = NULL; - CloseHandle(hTemporaryIn); - CloseHandle(hTemporaryOut); - return FALSE; - } - } - *pHandleIn = hTemporaryIn; - - if (isInheritableOut) { - if (!SetHandleInformation(hTemporaryOut, - HANDLE_FLAG_INHERIT, - HANDLE_FLAG_INHERIT)) - { - maperrno(); - *pHandleIn = NULL; - *pHandleOut = NULL; - CloseHandle(hTemporaryIn); - CloseHandle(hTemporaryOut); - return FALSE; - } - } - *pHandleOut = hTemporaryOut; - - return TRUE; -} - -ProcHandle -runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory, - wchar_t *environment, - int fdStdIn, int fdStdOut, int fdStdErr, - int *pfdStdInput, int *pfdStdOutput, int *pfdStdError, - int flags) -{ - STARTUPINFO sInfo; - PROCESS_INFORMATION pInfo; - HANDLE hStdInputRead = INVALID_HANDLE_VALUE; - HANDLE hStdInputWrite = INVALID_HANDLE_VALUE; - HANDLE hStdOutputRead = INVALID_HANDLE_VALUE; - HANDLE hStdOutputWrite = INVALID_HANDLE_VALUE; - HANDLE hStdErrorRead = INVALID_HANDLE_VALUE; - HANDLE hStdErrorWrite = INVALID_HANDLE_VALUE; - BOOL close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0); - // We always pass a wide environment block, so we MUST set this flag - DWORD dwFlags = CREATE_UNICODE_ENVIRONMENT; - BOOL status; - BOOL inherit; - - ZeroMemory(&sInfo, sizeof(sInfo)); - sInfo.cb = sizeof(sInfo); - sInfo.dwFlags = STARTF_USESTDHANDLES; - - if (fdStdIn == -1) { - if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE)) - goto cleanup_err; - sInfo.hStdInput = hStdInputRead; - } else if (fdStdIn == 0) { - // Don't duplicate stdin, as console handles cannot be - // duplicated and inherited. urg. - sInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); - } else { - // The handle might not be inheritable, so duplicate it - status = DuplicateHandle(GetCurrentProcess(), - (HANDLE) _get_osfhandle(fdStdIn), - GetCurrentProcess(), &hStdInputRead, - 0, - TRUE, /* inheritable */ - DUPLICATE_SAME_ACCESS); - if (!status) goto cleanup_err; - sInfo.hStdInput = hStdInputRead; - } - - if (fdStdOut == -1) { - if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE)) - goto cleanup_err; - sInfo.hStdOutput = hStdOutputWrite; - } else if (fdStdOut == 1) { - // Don't duplicate stdout, as console handles cannot be - // duplicated and inherited. urg. - sInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); - } else { - // The handle might not be inheritable, so duplicate it - status = DuplicateHandle(GetCurrentProcess(), - (HANDLE) _get_osfhandle(fdStdOut), - GetCurrentProcess(), &hStdOutputWrite, - 0, - TRUE, /* inheritable */ - DUPLICATE_SAME_ACCESS); - if (!status) goto cleanup_err; - sInfo.hStdOutput = hStdOutputWrite; - } - - if (fdStdErr == -1) { - if (!mkAnonPipe(&hStdErrorRead, TRUE, &hStdErrorWrite, TRUE)) - goto cleanup_err; - sInfo.hStdError = hStdErrorWrite; - } else if (fdStdErr == 2) { - // Don't duplicate stderr, as console handles cannot be - // duplicated and inherited. urg. - sInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); - } else { - /* The handle might not be inheritable, so duplicate it */ - status = DuplicateHandle(GetCurrentProcess(), - (HANDLE) _get_osfhandle(fdStdErr), - GetCurrentProcess(), &hStdErrorWrite, - 0, - TRUE, /* inheritable */ - DUPLICATE_SAME_ACCESS); - if (!status) goto cleanup_err; - sInfo.hStdError = hStdErrorWrite; - } - - if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) && - sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) && - sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE) && - (flags & RUN_PROCESS_IN_NEW_GROUP) == 0) - dwFlags |= CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected - - // See #3231 - if (close_fds && fdStdIn == 0 && fdStdOut == 1 && fdStdErr == 2) { - inherit = FALSE; - } else { - inherit = TRUE; - } - - if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) { - dwFlags |= CREATE_NEW_PROCESS_GROUP; - } - - if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo)) - { - goto cleanup_err; - } - CloseHandle(pInfo.hThread); - - // Close the ends of the pipes that were inherited by the - // child process. This is important, otherwise we won't see - // EOF on these pipes when the child process exits. - if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead); - if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite); - if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite); - - *pfdStdInput = _open_osfhandle((intptr_t) hStdInputWrite, _O_WRONLY); - *pfdStdOutput = _open_osfhandle((intptr_t) hStdOutputRead, _O_RDONLY); - *pfdStdError = _open_osfhandle((intptr_t) hStdErrorRead, _O_RDONLY); - - return pInfo.hProcess; - -cleanup_err: - if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead); - if (hStdInputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdInputWrite); - if (hStdOutputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputRead); - if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite); - if (hStdErrorRead != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorRead); - if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite); - maperrno(); - return NULL; -} - -int -terminateProcess (ProcHandle handle) -{ - if (!TerminateProcess((HANDLE) handle, 1)) { - maperrno(); - return -1; - } - return 0; -} - -int -getProcessExitCode (ProcHandle handle, int *pExitCode) -{ - *pExitCode = 0; - - if (WaitForSingleObject((HANDLE) handle, 1) == WAIT_OBJECT_0) - { - if (GetExitCodeProcess((HANDLE) handle, (DWORD *) pExitCode) == 0) - { - maperrno(); - return -1; - } - return 1; - } - - return 0; -} - -int -waitForProcess (ProcHandle handle, int *pret) -{ - DWORD retCode; - - if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0) - { - if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0) - { - maperrno(); - return -1; - } - *pret = retCode; - return 0; - } - - maperrno(); - return -1; -} - -#endif /* Win32 */ +/* ----------------------------------------------------------------------------+ (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);++// 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++__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,+ 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) {+ *failed_doing = "runInteractiveProcess: pipe";+ return -1;+ }+ }+ if (fdStdErr == -1) {+ r = pipe(fdStdError);+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: pipe";+ return -1;+ }+ }++ r = pipe(forkCommunicationFds);+ if (r == -1) {+ *failed_doing = "runInteractiveProcess: pipe";+ return -1;+ }++ // Block signals with Haskell handlers. The danger here is that+ // with the threaded RTS, a signal arrives in the child process,+ // the RTS writes the signal information into the pipe (which is+ // shared between parent and child), and the parent behaves as if+ // the signal had been raised.+ blockUserSignals();++ // See #4074. Sometimes fork() gets interrupted by the timer+ // signal and keeps restarting indefinitely.+ stopTimer();++ switch(pid = 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_IN_NEW_GROUP) != 0) {+ setpgid(0, 0);+ }++ 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 {+ dup2(fdStdIn, STDIN_FILENO);+ }++ if (fdStdOut == -1) {+ if (fdStdOutput[1] != STDOUT_FILENO) {+ dup2 (fdStdOutput[1], STDOUT_FILENO);+ close(fdStdOutput[1]);+ }+ close(fdStdOutput[0]);+ } else {+ dup2(fdStdOut, STDOUT_FILENO);+ }++ if (fdStdErr == -1) {+ if (fdStdError[1] != STDERR_FILENO) {+ dup2 (fdStdError[1], STDERR_FILENO);+ close(fdStdError[1]);+ }+ close(fdStdError[0]);+ } else {+ dup2(fdStdErr, STDERR_FILENO);+ }++ if (close_fds) {+ int i;+ if (max_fd == 0) {+#if HAVE_SYSCONF+ max_fd = sysconf(_SC_OPEN_MAX);+ if (max_fd == -1) {+ max_fd = 256;+ }+#else+ max_fd = 256;+#endif+ }+ // XXX Not the pipe+ for (i = 3; i < max_fd; i++) {+ 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;+ 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;+ }+ 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;+}++ProcHandle+runInteractiveProcess (wchar_t *cmd, wchar_t *workingDirectory,+ wchar_t *environment,+ int fdStdIn, int fdStdOut, int fdStdErr,+ int *pfdStdInput, int *pfdStdOutput, int *pfdStdError,+ int flags)+{+ STARTUPINFO sInfo;+ PROCESS_INFORMATION pInfo;+ HANDLE hStdInputRead = INVALID_HANDLE_VALUE;+ HANDLE hStdInputWrite = INVALID_HANDLE_VALUE;+ HANDLE hStdOutputRead = INVALID_HANDLE_VALUE;+ HANDLE hStdOutputWrite = INVALID_HANDLE_VALUE;+ HANDLE hStdErrorRead = INVALID_HANDLE_VALUE;+ HANDLE hStdErrorWrite = INVALID_HANDLE_VALUE;+ BOOL close_fds = ((flags & RUN_PROCESS_IN_CLOSE_FDS) != 0);+ // We always pass a wide environment block, so we MUST set this flag+ DWORD dwFlags = CREATE_UNICODE_ENVIRONMENT;+ BOOL status;+ BOOL inherit;++ ZeroMemory(&sInfo, sizeof(sInfo));+ sInfo.cb = sizeof(sInfo);+ sInfo.dwFlags = STARTF_USESTDHANDLES;++ if (fdStdIn == -1) {+ if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE))+ goto cleanup_err;+ sInfo.hStdInput = hStdInputRead;+ } else if (fdStdIn == 0) {+ // Don't duplicate stdin, as console handles cannot be+ // duplicated and inherited. urg.+ sInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE);+ } else {+ // The handle might not be inheritable, so duplicate it+ status = DuplicateHandle(GetCurrentProcess(),+ (HANDLE) _get_osfhandle(fdStdIn),+ GetCurrentProcess(), &hStdInputRead,+ 0,+ TRUE, /* inheritable */+ DUPLICATE_SAME_ACCESS);+ if (!status) goto cleanup_err;+ sInfo.hStdInput = hStdInputRead;+ }++ if (fdStdOut == -1) {+ if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE))+ goto cleanup_err;+ sInfo.hStdOutput = hStdOutputWrite;+ } else if (fdStdOut == 1) {+ // Don't duplicate stdout, as console handles cannot be+ // duplicated and inherited. urg.+ sInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);+ } else {+ // The handle might not be inheritable, so duplicate it+ status = DuplicateHandle(GetCurrentProcess(),+ (HANDLE) _get_osfhandle(fdStdOut),+ GetCurrentProcess(), &hStdOutputWrite,+ 0,+ TRUE, /* inheritable */+ DUPLICATE_SAME_ACCESS);+ if (!status) goto cleanup_err;+ sInfo.hStdOutput = hStdOutputWrite;+ }++ if (fdStdErr == -1) {+ if (!mkAnonPipe(&hStdErrorRead, TRUE, &hStdErrorWrite, TRUE))+ goto cleanup_err;+ sInfo.hStdError = hStdErrorWrite;+ } else if (fdStdErr == 2) {+ // Don't duplicate stderr, as console handles cannot be+ // duplicated and inherited. urg.+ sInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE);+ } else {+ /* The handle might not be inheritable, so duplicate it */+ status = DuplicateHandle(GetCurrentProcess(),+ (HANDLE) _get_osfhandle(fdStdErr),+ GetCurrentProcess(), &hStdErrorWrite,+ 0,+ TRUE, /* inheritable */+ DUPLICATE_SAME_ACCESS);+ if (!status) goto cleanup_err;+ sInfo.hStdError = hStdErrorWrite;+ }++ if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) &&+ sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) &&+ sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE) &&+ (flags & RUN_PROCESS_IN_NEW_GROUP) == 0)+ dwFlags |= CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected++ // See #3231+ if (close_fds && fdStdIn == 0 && fdStdOut == 1 && fdStdErr == 2) {+ inherit = FALSE;+ } else {+ inherit = TRUE;+ }++ if ((flags & RUN_PROCESS_IN_NEW_GROUP) != 0) {+ dwFlags |= CREATE_NEW_PROCESS_GROUP;+ }++ if (!CreateProcess(NULL, cmd, NULL, NULL, inherit, dwFlags, environment, workingDirectory, &sInfo, &pInfo))+ {+ goto cleanup_err;+ }+ CloseHandle(pInfo.hThread);++ // Close the ends of the pipes that were inherited by the+ // child process. This is important, otherwise we won't see+ // EOF on these pipes when the child process exits.+ if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead);+ if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite);+ if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite);++ *pfdStdInput = _open_osfhandle((intptr_t) hStdInputWrite, _O_WRONLY);+ *pfdStdOutput = _open_osfhandle((intptr_t) hStdOutputRead, _O_RDONLY);+ *pfdStdError = _open_osfhandle((intptr_t) hStdErrorRead, _O_RDONLY);++ return pInfo.hProcess;++cleanup_err:+ if (hStdInputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdInputRead);+ if (hStdInputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdInputWrite);+ if (hStdOutputRead != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputRead);+ if (hStdOutputWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdOutputWrite);+ if (hStdErrorRead != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorRead);+ if (hStdErrorWrite != INVALID_HANDLE_VALUE) CloseHandle(hStdErrorWrite);+ maperrno();+ return NULL;+}++int+terminateProcess (ProcHandle handle)+{+ if (!TerminateProcess((HANDLE) handle, 1)) {+ maperrno();+ return -1;+ }+ return 0;+}++int+getProcessExitCode (ProcHandle handle, int *pExitCode)+{+ *pExitCode = 0;++ if (WaitForSingleObject((HANDLE) handle, 1) == WAIT_OBJECT_0)+ {+ if (GetExitCodeProcess((HANDLE) handle, (DWORD *) pExitCode) == 0)+ {+ maperrno();+ return -1;+ }+ return 1;+ }++ return 0;+}++int+waitForProcess (ProcHandle handle, int *pret)+{+ DWORD retCode;++ if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0)+ {+ if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0)+ {+ maperrno();+ return -1;+ }+ *pret = retCode;+ return 0;+ }++ maperrno();+ return -1;+}++#endif /* Win32 */
+ changelog view
@@ -0,0 +1,15 @@+1.2.0.0 Dec 2013++ * Update to Cabal 1.10 format+ * Remove NHC specific code+ * Add support for `base-4.7.0.0`+ * Improve `showCommandForUser` to reduce redundant quoting+ * New functions `callProcess`, `callCommand`, `spawnProcess` and `spawnCommand`+ * Implement WCE handling according to http://www.cons.org/cracauer/sigint.html+ * New `delegate_ctlc` field in `CreateProcess` for WCE handling+ * Use `ExitFailure (-signum)` on Unix when a proc is terminated due to+ a signal.+ * Deprecate `module System.Cmd`+ * On non-Windows, the child thread now comunicates any errors back+ to the parent thread via pipes.+ * Fix deadlocks in `readProcess` and `readProcessWithExitCode`
configure view
@@ -1,13 +1,11 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.67 for Haskell process package 1.0.+# Generated by GNU Autoconf 2.69 for Haskell process package 1.0. # # Report bugs to <libraries@haskell.org>. # #-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software-# Foundation, Inc.+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation@@ -91,6 +89,7 @@ IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator.+as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -135,6 +134,31 @@ # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH +# Use a proper internal environment variable to ensure we don't fall+ # into an infinite loop, continuously re-executing ourselves.+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then+ _as_can_reexec=no; export _as_can_reexec;+ # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+ *v*x* | *x*v* ) as_opts=-vx ;;+ *v* ) as_opts=-v ;;+ *x* ) as_opts=-x ;;+ * ) as_opts= ;;+esac+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}+# Admittedly, this is quite paranoid, since all the known shells bail+# out after a failed `exec'.+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2+as_fn_exit 255+ fi+ # We don't want this to propagate to other subprocesses.+ { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh@@ -168,7 +192,8 @@ else exitcode=1; echo positional parameters were not saved. fi-test x\$exitcode = x0 || exit 1"+test x\$exitcode = x0 || exit 1+test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&@@ -213,14 +238,25 @@ if test "x$CONFIG_SHELL" != x; then :- # We cannot yet assume a decent shell, so we have to provide a- # neutralization value for shells without unset; and this also- # works around shells that cannot unset nonexistent variables.- BASH_ENV=/dev/null- ENV=/dev/null- (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV- export CONFIG_SHELL- exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}+ export CONFIG_SHELL+ # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+ *v*x* | *x*v* ) as_opts=-vx ;;+ *v* ) as_opts=-v ;;+ *x* ) as_opts=-x ;;+ * ) as_opts= ;;+esac+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}+# Admittedly, this is quite paranoid, since all the known shells bail+# out after a failed `exec'.+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2+exit 255 fi if test x$as_have_required = xno; then :@@ -323,6 +359,14 @@ } # as_fn_mkdir_p++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+ test -f "$1" && test -x "$1"+} # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take@@ -444,6 +488,10 @@ chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have+ # already done that, so ensure we don't try to do so again and fall+ # in an infinite loop. This has already happened in practice.+ _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this).@@ -478,16 +526,16 @@ # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.- # In both cases, we have to default to `cp -p'.+ # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||- as_ln_s='cp -p'+ as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else- as_ln_s='cp -p'+ as_ln_s='cp -pR' fi else- as_ln_s='cp -p'+ as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null@@ -499,28 +547,8 @@ as_mkdir_p=false fi -if test -x / >/dev/null 2>&1; then- as_test_x='test -x'-else- if ls -dL / >/dev/null 2>&1; then- as_ls_L_option=L- else- as_ls_L_option=- fi- as_test_x='- eval sh -c '\''- if test -d "$1"; then- test -d "$1/.";- else- case $1 in #(- -*)set "./$1";;- esac;- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((- ???[sx]*):;;*)false;;esac;fi- '\'' sh- '-fi-as_executable_p=$as_test_x+as_test_x='test -x'+as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"@@ -1062,7 +1090,7 @@ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2- : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}+ : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac@@ -1113,8 +1141,6 @@ if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe- $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.- If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi@@ -1347,9 +1373,9 @@ if $ac_init_version; then cat <<\_ACEOF Haskell process package configure 1.0-generated by GNU Autoconf 2.67+generated by GNU Autoconf 2.69 -Copyright (C) 2010 Free Software Foundation, Inc.+Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF@@ -1393,7 +1419,7 @@ ac_retval=1 fi- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile@@ -1407,7 +1433,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if eval "test \"\${$3+set}\"" = set; then :+if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=no"@@ -1448,7 +1474,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; }- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_type @@ -1484,7 +1510,7 @@ ac_retval=1 fi- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp@@ -1526,7 +1552,7 @@ ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run@@ -1540,7 +1566,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if eval "test \"\${$3+set}\"" = set; then :+if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -1558,7 +1584,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; }- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile @@ -1570,10 +1596,10 @@ ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- if eval "test \"\${$3+set}\"" = set; then :+ if eval \${$3+:} false; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if eval "test \"\${$3+set}\"" = set; then :+if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 fi eval ac_res=\$$3@@ -1640,7 +1666,7 @@ esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if eval "test \"\${$3+set}\"" = set; then :+if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=\$ac_header_compiler"@@ -1649,7 +1675,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } fi- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_mongrel @@ -1680,7 +1706,7 @@ test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes ||- $as_test_x conftest$ac_exeext+ test -x conftest$ac_exeext }; then : ac_retval=0 else@@ -1694,7 +1720,7 @@ # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link@@ -1707,7 +1733,7 @@ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; }-if eval "test \"\${$3+set}\"" = set; then :+if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -1762,7 +1788,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; }- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func @@ -1783,7 +1809,8 @@ main () { static int test_array [1 - 2 * !(($2) >= 0)];-test_array [0] = 0+test_array [0] = 0;+return test_array [0]; ; return 0;@@ -1799,7 +1826,8 @@ main () { static int test_array [1 - 2 * !(($2) <= $ac_mid)];-test_array [0] = 0+test_array [0] = 0;+return test_array [0]; ; return 0;@@ -1825,7 +1853,8 @@ main () { static int test_array [1 - 2 * !(($2) < 0)];-test_array [0] = 0+test_array [0] = 0;+return test_array [0]; ; return 0;@@ -1841,7 +1870,8 @@ main () { static int test_array [1 - 2 * !(($2) >= $ac_mid)];-test_array [0] = 0+test_array [0] = 0;+return test_array [0]; ; return 0;@@ -1875,7 +1905,8 @@ main () { static int test_array [1 - 2 * !(($2) <= $ac_mid)];-test_array [0] = 0+test_array [0] = 0;+return test_array [0]; ; return 0;@@ -1939,7 +1970,7 @@ rm -f conftest.val fi- eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_compute_int@@ -1948,7 +1979,7 @@ running configure, to aid debugging if configure makes a mistake. It was created by Haskell process package $as_me 1.0, which was-generated by GNU Autoconf 2.67. Invocation command line was+generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -2206,7 +2237,7 @@ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } fi done @@ -2318,7 +2349,7 @@ set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then :+if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then@@ -2330,7 +2361,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2358,7 +2389,7 @@ set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :+if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then@@ -2370,7 +2401,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2411,7 +2442,7 @@ set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then :+if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then@@ -2423,7 +2454,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2451,7 +2482,7 @@ set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then :+if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then@@ -2464,7 +2495,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue@@ -2510,7 +2541,7 @@ set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then :+if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then@@ -2522,7 +2553,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2554,7 +2585,7 @@ set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :+if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then@@ -2566,7 +2597,7 @@ IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2@@ -2609,7 +2640,7 @@ test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5@@ -2724,7 +2755,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; }@@ -2767,7 +2798,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5@@ -2826,7 +2857,7 @@ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'.-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } fi fi fi@@ -2837,7 +2868,7 @@ ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 $as_echo_n "checking for suffix of object files... " >&6; }-if test "${ac_cv_objext+set}" = set; then :+if ${ac_cv_objext+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -2878,7 +2909,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi@@ -2888,7 +2919,7 @@ ac_objext=$OBJEXT { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; }-if test "${ac_cv_c_compiler_gnu+set}" = set; then :+if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -2925,7 +2956,7 @@ ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; }-if test "${ac_cv_prog_cc_g+set}" = set; then :+if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag@@ -3003,7 +3034,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; }-if test "${ac_cv_prog_cc_c89+set}" = set; then :+if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no@@ -3012,8 +3043,7 @@ /* end confdefs.h. */ #include <stdarg.h> #include <stdio.h>-#include <sys/types.h>-#include <sys/stat.h>+struct stat; /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int);@@ -3112,7 +3142,7 @@ CPP= fi if test -z "$CPP"; then- if test "${ac_cv_prog_CPP+set}" = set; then :+ if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded@@ -3228,7 +3258,7 @@ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check-See \`config.log' for more details" "$LINENO" 5 ; }+See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c@@ -3240,7 +3270,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 $as_echo_n "checking for grep that handles long lines and -e... " >&6; }-if test "${ac_cv_path_GREP+set}" = set; then :+if ${ac_cv_path_GREP+:} false; then : $as_echo_n "(cached) " >&6 else if test -z "$GREP"; then@@ -3254,7 +3284,7 @@ for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"- { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue+ as_fn_executable_p "$ac_path_GREP" || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in@@ -3303,7 +3333,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 $as_echo_n "checking for egrep... " >&6; }-if test "${ac_cv_path_EGREP+set}" = set; then :+if ${ac_cv_path_EGREP+:} false; then : $as_echo_n "(cached) " >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1@@ -3320,7 +3350,7 @@ for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"- { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue+ as_fn_executable_p "$ac_path_EGREP" || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in@@ -3370,7 +3400,7 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; }-if test "${ac_cv_header_stdc+set}" = set; then :+if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -3498,7 +3528,7 @@ ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"-if test "x$ac_cv_type_pid_t" = x""yes; then :+if test "x$ac_cv_type_pid_t" = xyes; then : else @@ -3511,7 +3541,7 @@ for ac_header in vfork.h do : ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default"-if test "x$ac_cv_header_vfork_h" = x""yes; then :+if test "x$ac_cv_header_vfork_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_VFORK_H 1 _ACEOF@@ -3535,7 +3565,7 @@ if test "x$ac_cv_func_fork" = xyes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5 $as_echo_n "checking for working fork... " >&6; }-if test "${ac_cv_func_fork_works+set}" = set; then :+if ${ac_cv_func_fork_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then :@@ -3588,7 +3618,7 @@ if test "x$ac_cv_func_vfork" = xyes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5 $as_echo_n "checking for working vfork... " >&6; }-if test "${ac_cv_func_vfork_works+set}" = set; then :+if ${ac_cv_func_vfork_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then :@@ -3737,7 +3767,7 @@ done -for ac_func in setitimer, sysconf+for ac_func in setitimer sysconf do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"@@ -3755,7 +3785,7 @@ as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh` { $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5 $as_echo_n "checking value of $fp_const_name... " >&6; }-if eval "test \"\${$as_fp_Cache+set}\"" = set; then :+if eval \${$as_fp_Cache+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result" "$ac_includes_default"; then :@@ -3841,10 +3871,21 @@ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then- test "x$cache_file" != "x/dev/null" &&+ if test "x$cache_file" != "x/dev/null"; then { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;}- cat confcache >$cache_file+ if test ! -f "$cache_file" || test -h "$cache_file"; then+ cat confcache >"$cache_file"+ else+ case $cache_file in #(+ */* | ?:*)+ mv -f confcache "$cache_file"$$ &&+ mv -f "$cache_file"$$ "$cache_file" ;; #(+ *)+ mv -f confcache "$cache_file" ;;+ esac+ fi+ fi else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}@@ -3876,7 +3917,7 @@ -: ${CONFIG_STATUS=./config.status}+: "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS"@@ -3977,6 +4018,7 @@ IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator.+as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -4172,16 +4214,16 @@ # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.- # In both cases, we have to default to `cp -p'.+ # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||- as_ln_s='cp -p'+ as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else- as_ln_s='cp -p'+ as_ln_s='cp -pR' fi else- as_ln_s='cp -p'+ as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null@@ -4241,29 +4283,17 @@ as_mkdir_p=false fi -if test -x / >/dev/null 2>&1; then- as_test_x='test -x'-else- if ls -dL / >/dev/null 2>&1; then- as_ls_L_option=L- else- as_ls_L_option=- fi- as_test_x='- eval sh -c '\''- if test -d "$1"; then- test -d "$1/.";- else- case $1 in #(- -*)set "./$1";;- esac;- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((- ???[sx]*):;;*)false;;esac;fi- '\'' sh- '-fi-as_executable_p=$as_test_x +# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+ test -f "$1" && test -x "$1"+} # as_fn_executable_p+as_test_x='test -x'+as_executable_p=as_fn_executable_p+ # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -4284,7 +4314,7 @@ # values after options handling. ac_log=" This file was extended by Haskell process package $as_me 1.0, which was-generated by GNU Autoconf 2.67. Invocation command line was+generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS@@ -4337,10 +4367,10 @@ ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ Haskell process package config.status 1.0-configured by $0, generated by GNU Autoconf 2.67,+configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" -Copyright (C) 2010 Free Software Foundation, Inc.+Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -4420,7 +4450,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then- set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL'@@ -4451,7 +4481,7 @@ case $ac_config_target in "include/HsProcessConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsProcessConfig.h" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;;+ *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done @@ -4472,9 +4502,10 @@ # after its creation but before its name has been assigned to `$tmp'. $debug || {- tmp=+ tmp= ac_tmp= trap 'exit_status=$?- { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status+ : "${ac_tmp:=$tmp}"+ { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 }@@ -4482,18 +4513,19 @@ { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&- test -n "$tmp" && test -d "$tmp"+ test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5+ac_tmp=$tmp # Set up the scripts for CONFIG_HEADERS section. # No need to generate them if there are no CONFIG_HEADERS. # This happens for instance with `./config.status Makefile'. if test -n "$CONFIG_HEADERS"; then-cat >"$tmp/defines.awk" <<\_ACAWK ||+cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF @@ -4505,8 +4537,8 @@ # handling of long lines. ac_delim='%!_!# ' for ac_last_try in false false :; do- ac_t=`sed -n "/$ac_delim/p" confdefs.h`- if test -z "$ac_t"; then+ ac_tt=`sed -n "/$ac_delim/p" confdefs.h`+ if test -z "$ac_tt"; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5@@ -4607,7 +4639,7 @@ esac case $ac_mode$ac_tag in :[FHL]*:*);;- :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;;+ :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac@@ -4626,7 +4658,7 @@ for ac_f do case $ac_f in- -) ac_f="$tmp/stdin";;+ -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'.@@ -4635,7 +4667,7 @@ [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac ||- as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;;+ as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'"@@ -4661,8 +4693,8 @@ esac case $ac_tag in- *:-:* | *:-) cat >"$tmp/stdin" \- || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;+ *:-:* | *:-) cat >"$ac_tmp/stdin" \+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac@@ -4735,20 +4767,20 @@ if test x"$ac_file" != x-; then { $as_echo "/* $configure_input */" \- && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs"- } >"$tmp/config.h" \+ && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"+ } >"$ac_tmp/config.h" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5- if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then+ if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 $as_echo "$as_me: $ac_file is unchanged" >&6;} else rm -f "$ac_file"- mv "$tmp/config.h" "$ac_file" \+ mv "$ac_tmp/config.h" "$ac_file" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else $as_echo "/* $configure_input */" \- && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \+ && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ || as_fn_error $? "could not create -" "$LINENO" 5 fi ;;
configure.ac view
@@ -16,7 +16,7 @@ # check for specific header (.h) files that we are interested in AC_CHECK_HEADERS([signal.h sys/wait.h fcntl.h]) -AC_CHECK_FUNCS([setitimer, sysconf])+AC_CHECK_FUNCS([setitimer sysconf]) FP_CHECK_CONSTS([SIG_DFL SIG_IGN])
− include/HsProcessConfig.h
@@ -1,92 +0,0 @@-/* include/HsProcessConfig.h. Generated from HsProcessConfig.h.in by configure. */-/* include/HsProcessConfig.h.in. Generated from configure.ac by autoheader. */--/* The value of SIG_DFL. */-#define CONST_SIG_DFL -1--/* The value of SIG_IGN. */-#define CONST_SIG_IGN -1--/* Define to 1 if you have the <fcntl.h> header file. */-#define HAVE_FCNTL_H 1--/* Define to 1 if you have the `fork' function. */-#define HAVE_FORK 1--/* Define to 1 if you have the <inttypes.h> header file. */-#define HAVE_INTTYPES_H 1--/* Define to 1 if you have the <memory.h> header file. */-#define HAVE_MEMORY_H 1--/* Define to 1 if you have the `setitimer,' function. */-/* #undef HAVE_SETITIMER_ */--/* Define to 1 if you have the <signal.h> header file. */-#define HAVE_SIGNAL_H 1--/* Define to 1 if you have the <stdint.h> header file. */-#define HAVE_STDINT_H 1--/* Define to 1 if you have the <stdlib.h> header file. */-#define HAVE_STDLIB_H 1--/* Define to 1 if you have the <strings.h> header file. */-#define HAVE_STRINGS_H 1--/* Define to 1 if you have the <string.h> header file. */-#define HAVE_STRING_H 1--/* Define to 1 if you have the `sysconf' function. */-#define HAVE_SYSCONF 1--/* Define to 1 if you have the <sys/stat.h> header file. */-#define HAVE_SYS_STAT_H 1--/* Define to 1 if you have the <sys/types.h> header file. */-#define HAVE_SYS_TYPES_H 1--/* Define to 1 if you have the <sys/wait.h> header file. */-#define HAVE_SYS_WAIT_H 1--/* Define to 1 if you have the <unistd.h> header file. */-#define HAVE_UNISTD_H 1--/* Define to 1 if you have the `vfork' function. */-#define HAVE_VFORK 1--/* Define to 1 if you have the <vfork.h> header file. */-/* #undef HAVE_VFORK_H */--/* Define to 1 if `fork' works. */-#define HAVE_WORKING_FORK 1--/* Define to 1 if `vfork' works. */-#define HAVE_WORKING_VFORK 1--/* Define to the address where bug reports for this package should be sent. */-#define PACKAGE_BUGREPORT "libraries@haskell.org"--/* Define to the full name of this package. */-#define PACKAGE_NAME "Haskell process package"--/* Define to the full name and version of this package. */-#define PACKAGE_STRING "Haskell process package 1.0"--/* Define to the one symbol short name of this package. */-#define PACKAGE_TARNAME "process"--/* Define to the home page for this package. */-#define PACKAGE_URL ""--/* Define to the version of this package. */-#define PACKAGE_VERSION "1.0"--/* Define to 1 if you have the ANSI C header files. */-#define STDC_HEADERS 1--/* Define to `int' if <sys/types.h> does not define. */-/* #undef pid_t */--/* Define as `fork' if `vfork' does not work. */-/* #undef vfork */
include/HsProcessConfig.h.in view
@@ -18,8 +18,8 @@ /* Define to 1 if you have the <memory.h> header file. */ #undef HAVE_MEMORY_H -/* Define to 1 if you have the `setitimer,' function. */-#undef HAVE_SETITIMER_+/* Define to 1 if you have the `setitimer' function. */+#undef HAVE_SETITIMER /* Define to 1 if you have the <signal.h> header file. */ #undef HAVE_SIGNAL_H
include/runProcess.h view
@@ -1,77 +1,86 @@-/* ---------------------------------------------------------------------------- - (c) The University of Glasgow 2004 - - Interface for code in runProcess.c (providing support for System.Process) - ------------------------------------------------------------------------- */ - -#include "HsProcessConfig.h" -// Otherwise these clash with similar definitions from other packages: -#undef PACKAGE_BUGREPORT -#undef PACKAGE_NAME -#undef PACKAGE_STRING -#undef PACKAGE_TARNAME -#undef PACKAGE_VERSION - -#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) -#define UNICODE -#include <windows.h> -#include <stdlib.h> -#endif - -#include <unistd.h> -#include <sys/types.h> - -#ifdef HAVE_FCNTL_H -#include <fcntl.h> -#endif - -#ifdef HAVE_VFORK_H -#include <vfork.h> -#endif - -#ifdef HAVE_VFORK -#define fork vfork -#endif - -#ifdef HAVE_SIGNAL_H -#include <signal.h> -#endif - -#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) -typedef pid_t ProcHandle; -#else -// Should really be intptr_t, but we don't have that type on the Haskell side -typedef PHANDLE ProcHandle; -#endif - -#include "processFlags.h" - -#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) - -extern ProcHandle runInteractiveProcess( char *const args[], - char *workingDirectory, - char **environment, - int fdStdIn, int fdStdOut, int fdStdErr, - int *pfdStdInput, - int *pfdStdOutput, - int *pfdStdError, - int set_inthandler, long inthandler, - int set_quithandler, long quithandler, - int flags); - -#else - -extern ProcHandle runInteractiveProcess( wchar_t *cmd, - wchar_t *workingDirectory, - wchar_t *environment, - int fdStdIn, int fdStdOut, int fdStdErr, - int *pfdStdInput, - int *pfdStdOutput, - int *pfdStdError, - int flags); - -#endif - -extern int terminateProcess( ProcHandle handle ); -extern int getProcessExitCode( ProcHandle handle, int *pExitCode ); -extern int waitForProcess( ProcHandle handle, int *ret ); +/* ----------------------------------------------------------------------------+ (c) The University of Glasgow 2004++ Interface for code in runProcess.c (providing support for System.Process)+ ------------------------------------------------------------------------- */++#include "HsProcessConfig.h"+// Otherwise these clash with similar definitions from other packages:+#undef PACKAGE_BUGREPORT+#undef PACKAGE_NAME+#undef PACKAGE_STRING+#undef PACKAGE_TARNAME+#undef PACKAGE_VERSION++#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+#define UNICODE+#include <windows.h>+#include <stdlib.h>+#endif++#include <unistd.h>+#include <sys/types.h>++#ifdef HAVE_FCNTL_H+#include <fcntl.h>+#endif++#ifdef HAVE_VFORK_H+#include <vfork.h>+#endif++#if defined(HAVE_WORKING_VFORK)+#define myfork vfork+#elif defined(HAVE_WORKING_FORK)+#define myfork fork+// We don't need a fork command on Windows+#elif !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))+#error Cannot find a working fork command+#endif++#ifdef HAVE_SIGNAL_H+#include <signal.h>+#endif++#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))+typedef pid_t ProcHandle;+#else+// Should really be intptr_t, but we don't have that type on the Haskell side+typedef PHANDLE ProcHandle;+#endif++#include "processFlags.h"++#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))++extern ProcHandle runInteractiveProcess( char *const args[], + char *workingDirectory, + char **environment, + int fdStdIn,+ int fdStdOut,+ int fdStdErr,+ int *pfdStdInput, + int *pfdStdOutput, + int *pfdStdError,+ int reset_int_quit_handlers,+ int flags,+ char **failed_doing);++#else++extern ProcHandle runInteractiveProcess( wchar_t *cmd,+ wchar_t *workingDirectory,+ wchar_t *environment,+ int fdStdIn,+ int fdStdOut,+ int fdStdErr,+ int *pfdStdInput,+ int *pfdStdOutput,+ int *pfdStdError,+ int flags);++#endif++extern int terminateProcess( ProcHandle handle );+extern int getProcessExitCode( ProcHandle handle, int *pExitCode );+extern int waitForProcess( ProcHandle handle, int *ret );
+ process.buildinfo view
@@ -0,0 +1,1 @@+install-includes: HsProcessConfig.h
process.cabal view
@@ -1,36 +1,56 @@-name: process-version: 1.1.0.2-license: BSD3-license-file: LICENSE-maintainer: libraries@haskell.org-bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries/process-synopsis: Process libraries-category: System+name: process+version: 1.2.0.0+-- GHC 7.6.1 released with 1.1.0.2+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=libraries/process+synopsis: Process libraries+category: System+build-type: Configure+cabal-version: >=1.10 description: This package contains libraries for dealing with system processes.+ extra-source-files:- aclocal.m4 configure.ac configure+ aclocal.m4+ changelog+ configure+ configure.ac include/HsProcessConfig.h.in+ process.buildinfo+ extra-tmp-files:- config.log config.status autom4te.cache+ autom4te.cache+ config.log+ config.status include/HsProcessConfig.h-build-type: Configure-cabal-version: >=1.6 source-repository head type: git- location: http://darcs.haskell.org/packages/process.git/+ location: http://git.haskell.org/packages/process.git -flag base4+source-repository this+ type: git+ location: http://git.haskell.org/packages/process.git+ tag: process-1.2.0.0-release -Library {- exposed-modules: System.Cmd- if !impl(nhc98) {+library+ default-language: Haskell2010+ other-extensions:+ BangPatterns+ CPP+ InterruptibleFFI+ RecordWildCards+ Trustworthy+ exposed-modules:+ System.Cmd System.Process if impl(ghc) exposed-modules:- System.Process.Internals+ System.Process.Internals+ c-sources: cbits/runProcess.c include-dirs: include@@ -39,27 +59,15 @@ install-includes: runProcess.h processFlags.h- HsProcessConfig.h++ ghc-options: -Wall++ build-depends: base >= 4.4 && < 4.8,+ directory >= 1.1 && < 1.3,+ filepath >= 1.2 && < 1.4,+ deepseq >= 1.1 && < 1.4 if os(windows)- build-depends: Win32 >=2.2.0.0+ build-depends: Win32 >=2.2 && < 2.4 extra-libraries: kernel32 else- build-depends: unix- }-- if (flag(base4)) {- build-depends: base >= 4 && < 5- cpp-options: -Dbase4- -- later, we can use the new MIN_VERSION_base() stuff that- -- arrived in Cabal-1.6.- } else {- build-depends: base >= 3 && < 4- cpp-options: -Dbase3- }-- build-depends: directory >= 1.0 && < 1.3,- filepath >= 1.1 && < 1.4,- deepseq >= 1.1 && < 1.4-- extensions: CPP-}+ build-depends: unix >= 2.5 && < 2.8