isPortableBuild s
| "GHC" `isPrefixOf` s = False
| "Data.Generics" `isPrefixOf` s = False
- | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
+ | otherwise = s `notElem` ["Foreign.Concurrent"]
forGHCBuild :: String -> Bool
forGHCBuild = ("GHC.Prim" /=)
+++ /dev/null
------------------------------------------------------------------------------
--- |
--- Module : System.Cmd
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- Executing an external command.
---
------------------------------------------------------------------------------
-
-module System.Cmd
- ( system, -- :: String -> IO ExitCode
- rawSystem, -- :: FilePath -> [String] -> IO ExitCode
- ) where
-
-import Prelude
-
-import System.Exit ( ExitCode )
-
-#ifdef __GLASGOW_HASKELL__
-import System.Process
-import GHC.IOBase ( ioException, IOException(..), IOErrorType(..) )
-#if !defined(mingw32_HOST_OS)
-import System.Process.Internals
-import System.Posix.Signals
-#endif
-#endif
-
-#ifdef __HUGS__
-import Hugs.System
-#endif
-
-#ifdef __NHC__
-import System (system)
-#endif
-
--- ---------------------------------------------------------------------------
--- system
-
-{-|
-Computation @system cmd@ returns the exit code
-produced when the operating system processes the command @cmd@.
-
-This computation may fail with
-
- * @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' is implemented using Windows's native system
-call, which ignores the @SHELL@ environment variable, and always
-passes the command to the Windows command interpreter (@CMD.EXE@ or
-@COMMAND.COM@), hence Unixy shell tricks will not work.
--}
-#ifdef __GLASGOW_HASKELL__
-system :: String -> IO ExitCode
-system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
-system str = do
-#if mingw32_HOST_OS
- p <- runCommand str
- waitForProcess p
-#else
- -- 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
- (cmd,args) <- commandToProcess str
- p <- runProcessPosix "runCommand" cmd args Nothing Nothing
- Nothing Nothing Nothing
- (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__ */
-
-{-|
-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
-
-#if mingw32_HOST_OS
- p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing
- waitForProcess p
-#else
- old_int <- installHandler sigINT Ignore Nothing
- old_quit <- installHandler sigQUIT Ignore Nothing
- p <- runProcessPosix "rawSystem" cmd args Nothing Nothing
- Nothing Nothing Nothing
- (Just defaultSignal) (Just defaultSignal)
- r <- waitForProcess p
- installHandler sigINT old_int Nothing
- installHandler sigQUIT old_quit Nothing
- return r
-#endif
-
-#elif !mingw32_HOST_OS
--- crude fallback implementation: could do much better than this under Unix
-rawSystem cmd args = system (unwords (map translate (cmd:args)))
-
-translate :: String -> String
-translate str = '\'' : foldr escape "'" str
- where escape '\'' = showString "'\\''"
- escape c = showChar c
-#else /* mingw32_HOST_OS && ! __GLASGOW_HASKELL__ */
-# if __HUGS__
-rawSystem cmd args = system (unwords (cmd : map translate args))
-# else
-rawSystem cmd args = system (unwords (map translate (cmd:args)))
-#endif
-
--- 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
+++ /dev/null
-{-# OPTIONS_GHC -cpp -fffi #-}
------------------------------------------------------------------------------
--- |
--- Module : System.Process
--- Copyright : (c) The University of Glasgow 2004
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : experimental
--- Portability : portable
---
--- Operations for creating and interacting with sub-processes.
---
------------------------------------------------------------------------------
-
--- ToDo:
--- * Flag to control whether exiting the parent also kills the child.
--- * Windows impl of runProcess should close the Handles.
--- * Add system/rawSystem replacements
-
-{- NOTES on createPipe:
-
- createPipe is no longer exported, because of the following problems:
-
- - it wasn't used to implement runInteractiveProcess on Unix, because
- the file descriptors for the unused ends of the pipe need to be closed
- in the child process.
-
- - on Windows, a special version of createPipe is needed that sets
- the inheritance flags correctly on the ends of the pipe (see
- mkAnonPipe below).
--}
-
-module System.Process (
- -- * Running sub-processes
- ProcessHandle,
- runCommand,
- runProcess,
- runInteractiveCommand,
- runInteractiveProcess,
-
- -- * Process completion
- waitForProcess,
- getProcessExitCode,
- terminateProcess,
- ) where
-
-import Prelude
-
-import System.Process.Internals
-
-import Foreign
-import Foreign.C
-import System.IO ( IOMode(..), Handle, hClose )
-import System.Exit ( ExitCode(..) )
-
-import System.Posix.Internals
-import GHC.IOBase ( FD )
-import GHC.Handle ( openFd )
-
--- ----------------------------------------------------------------------------
--- runCommand
-
-{- | Runs a command using the shell.
- -}
-runCommand
- :: String
- -> IO ProcessHandle
-
-runCommand string = do
- (cmd,args) <- commandToProcess string
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
- runProcessPosix "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing
- Nothing Nothing
-#else
- runProcessWin32 "runCommand" cmd [] Nothing Nothing Nothing Nothing Nothing args
-#endif
-
--- ----------------------------------------------------------------------------
--- 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.
--}
-runProcess
- :: FilePath -- ^ Filename of the executable
- -> [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@
- -> Maybe Handle -- ^ Handle to use for @stdout@
- -> Maybe Handle -- ^ Handle to use for @stderr@
- -> IO ProcessHandle
-
-runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
- h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env
- mb_stdin mb_stdout mb_stderr
- Nothing Nothing
-#else
- h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env
- mb_stdin mb_stdout mb_stderr ""
-#endif
- maybe (return ()) hClose mb_stdin
- maybe (return ()) hClose mb_stdout
- maybe (return ()) hClose mb_stderr
- return h
-
--- ----------------------------------------------------------------------------
--- 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.
--}
-runInteractiveCommand
- :: String
- -> IO (Handle,Handle,Handle,ProcessHandle)
-
-runInteractiveCommand string = do
- (cmd,args) <- commandToProcess string
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
- runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
-#else
- runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
-#endif
-
--- ----------------------------------------------------------------------------
--- runInteractiveProcess
-
-{- | 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)
--}
-runInteractiveProcess
- :: FilePath -- ^ Filename of the executable
- -> [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)
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
-runInteractiveProcess cmd args mb_cwd mb_env =
- runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env
-
-runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
- withFilePathException cmd $
- alloca $ \ pfdStdInput ->
- alloca $ \ pfdStdOutput ->
- alloca $ \ pfdStdError ->
- maybeWith withCEnvironment mb_env $ \pEnv ->
- maybeWith withCString mb_cwd $ \pWorkDir ->
- withMany withCString (cmd:args) $ \cstrs ->
- withArray0 nullPtr cstrs $ \pargs -> do
- proc_handle <- throwErrnoIfMinus1 fun
- (c_runInteractiveProcess pargs pWorkDir pEnv
- pfdStdInput pfdStdOutput pfdStdError)
- hndStdInput <- fdToHandle pfdStdInput WriteMode
- hndStdOutput <- fdToHandle pfdStdOutput ReadMode
- hndStdError <- fdToHandle pfdStdError ReadMode
- ph <- mkProcessHandle proc_handle
- return (hndStdInput, hndStdOutput, hndStdError, ph)
-
-foreign import ccall unsafe "runInteractiveProcess"
- c_runInteractiveProcess
- :: Ptr CString
- -> CString
- -> Ptr CString
- -> Ptr FD
- -> Ptr FD
- -> Ptr FD
- -> IO PHANDLE
-
-#else
-
-runInteractiveProcess cmd args mb_cwd mb_env =
- runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
-
-runInteractiveProcess1 fun cmd args workDir env extra_cmdline
- = withFilePathException cmd $ do
- let cmdline = translate cmd ++
- concat (map ((' ':) . translate) args) ++
- (if null extra_cmdline then "" else ' ':extra_cmdline)
- withCString cmdline $ \pcmdline ->
- alloca $ \ pfdStdInput ->
- alloca $ \ pfdStdOutput ->
- alloca $ \ pfdStdError -> do
- maybeWith withCEnvironment env $ \pEnv -> do
- maybeWith withCString workDir $ \pWorkDir -> do
- proc_handle <- throwErrnoIfMinus1 fun $
- c_runInteractiveProcess pcmdline pWorkDir pEnv
- pfdStdInput pfdStdOutput pfdStdError
- hndStdInput <- fdToHandle pfdStdInput WriteMode
- hndStdOutput <- fdToHandle pfdStdOutput ReadMode
- hndStdError <- fdToHandle pfdStdError ReadMode
- ph <- mkProcessHandle proc_handle
- return (hndStdInput, hndStdOutput, hndStdError, ph)
-
-foreign import ccall unsafe "runInteractiveProcess"
- c_runInteractiveProcess
- :: CString
- -> CString
- -> Ptr ()
- -> Ptr FD
- -> Ptr FD
- -> Ptr FD
- -> IO PHANDLE
-
-#endif
-
-fdToHandle :: Ptr FD -> IOMode -> IO Handle
-fdToHandle pfd mode = do
- fd <- peek pfd
- openFd fd (Just Stream)
- False{-not a socket-}
- ("fd:" ++ show fd) mode True{-binary-}
-
--- ----------------------------------------------------------------------------
--- waitForProcess
-
-{- | Waits for the specified process to terminate, and returns its exit code.
-
- GHC Note: in order to call @waitForProcess@ without blocking all the
- other threads in the system, you must compile the program with
- @-threaded@.
--}
-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)
- code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess h)
- withProcessHandle ph $ \p_ ->
- case p_ of
- ClosedHandle e -> return (p_,e)
- OpenHandle ph -> do
- closePHANDLE ph
- let e = if (code == 0)
- then ExitSuccess
- else (ExitFailure (fromIntegral code))
- return (ClosedHandle e, e)
-
--- ----------------------------------------------------------------------------
--- terminateProcess
-
--- | Attempts to terminate the specified process. This function should
--- not be used under normal circumstances - no guarantees are given regarding
--- how cleanly the process is terminated. To check whether the process
--- has indeed terminated, use 'getProcessExitCode'.
---
--- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
--- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
--- an exit code of 1.
-terminateProcess :: ProcessHandle -> IO ()
-terminateProcess ph = do
- withProcessHandle_ ph $ \p_ ->
- case p_ of
- ClosedHandle _ -> return p_
- OpenHandle h -> do
- throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h
- return p_
- -- does not close the handle, we might want to try terminating it
- -- again, or get its exit code.
-
--- ----------------------------------------------------------------------------
--- 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.
-Subsequent calls to @getProcessExitStatus@ always return @'Just'
-'ExitSuccess'@, regardless of what the original exit code was.
--}
-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 <- throwErrnoIfMinus1 "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
-
-foreign import ccall unsafe "terminateProcess"
- c_terminateProcess
- :: PHANDLE
- -> IO CInt
-
-foreign import ccall unsafe "getProcessExitCode"
- c_getProcessExitCode
- :: PHANDLE
- -> Ptr CInt
- -> IO CInt
-
-foreign import ccall safe "waitForProcess" -- NB. safe - can block
- c_waitForProcess
- :: PHANDLE
- -> IO CInt
+++ /dev/null
-{-# OPTIONS_GHC -cpp -fffi #-}
------------------------------------------------------------------------------
--- |
--- 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
---
--- Operations for creating and interacting with sub-processes.
---
------------------------------------------------------------------------------
-
--- #hide
-module System.Process.Internals (
-#ifndef __HUGS__
- ProcessHandle(..), ProcessHandle__(..),
- PHANDLE, closePHANDLE, mkProcessHandle,
- withProcessHandle, withProcessHandle_,
-#endif
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
- pPrPr_disableITimers, c_execvpe,
-# ifdef __GLASGOW_HASKELL__
- runProcessPosix,
-# endif
- ignoreSignal, defaultSignal,
-#else
-# ifdef __GLASGOW_HASKELL__
- runProcessWin32, translate,
-# endif
-#endif
-#ifndef __HUGS__
- commandToProcess,
-#endif
- withFilePathException, withCEnvironment
- ) where
-
-import Prelude -- necessary to get dependencies right
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-import System.Posix.Types ( CPid )
-import System.IO ( Handle )
-#else
-import Data.Word ( Word32 )
-import Data.IORef
-#endif
-
-import System.Exit ( ExitCode )
-import Data.Maybe ( fromMaybe )
-# ifdef __GLASGOW_HASKELL__
-import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) )
-import GHC.Handle ( stdin, stdout, stderr, withHandle_ )
-# elif __HUGS__
-import Hugs.Exception ( Exception(..), IOException(..) )
-# endif
-
-import Control.Concurrent
-import Control.Exception ( handle, throwIO )
-import Foreign.C
-import Foreign
-
-#if defined(mingw32_HOST_OS)
-import Control.Monad ( when )
-import System.Directory ( doesFileExist )
-import Control.Exception ( catchJust, ioErrors )
-import System.IO.Error ( isDoesNotExistError, doesNotExistErrorType,
- mkIOError )
-import System.Environment ( getEnv )
-import System.Directory.Internals ( parseSearchPath, joinFileName )
-#endif
-
-#ifdef __HUGS__
-{-# CFILES cbits/execvpe.c #-}
-#endif
-
-#include "HsBaseConfig.h"
-
-#ifndef __HUGS__
--- ----------------------------------------------------------------------------
--- ProcessHandle type
-
-{- | A handle to a process, which can be used to wait for termination
- of the process using 'waitForProcess'.
-
- None of the process-creation functions in this library wait for
- termination: they all return a 'ProcessHandle' which may be used
- to wait for the process later.
--}
-data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode
-newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)
-
-withProcessHandle
- :: ProcessHandle
- -> (ProcessHandle__ -> IO (ProcessHandle__, a))
- -> IO a
-withProcessHandle (ProcessHandle m) io = modifyMVar m io
-
-withProcessHandle_
- :: ProcessHandle
- -> (ProcessHandle__ -> IO ProcessHandle__)
- -> IO ()
-withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
-type PHANDLE = CPid
-
-mkProcessHandle :: PHANDLE -> IO ProcessHandle
-mkProcessHandle p = do
- m <- newMVar (OpenHandle p)
- return (ProcessHandle m)
-
-closePHANDLE :: PHANDLE -> IO ()
-closePHANDLE _ = return ()
-
-#else
-
-type PHANDLE = Word32
-
--- 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.
-mkProcessHandle :: PHANDLE -> IO ProcessHandle
-mkProcessHandle h = do
- m <- newMVar (OpenHandle h)
- addMVarFinalizer m (processHandleFinaliser m)
- return (ProcessHandle m)
-
-processHandleFinaliser m =
- modifyMVar_ m $ \p_ -> do
- case p_ of
- OpenHandle ph -> closePHANDLE ph
- _ -> return ()
- return (error "closed process handle")
-
-closePHANDLE :: PHANDLE -> IO ()
-closePHANDLE ph = c_CloseHandle ph
-
-foreign import stdcall unsafe "CloseHandle"
- c_CloseHandle
- :: PHANDLE
- -> IO ()
-#endif
-#endif /* !__HUGS__ */
-
--- ----------------------------------------------------------------------------
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
--- this function disables the itimer, which would otherwise cause confusing
--- signals to be sent to the new process.
-foreign import ccall unsafe "pPrPr_disableITimers"
- pPrPr_disableITimers :: IO ()
-
-foreign import ccall unsafe "execvpe"
- c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
-
-#endif
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
-#ifdef __GLASGOW_HASKELL__
--- -----------------------------------------------------------------------------
--- POSIX runProcess with signal handling in the child
-
-runProcessPosix
- :: String
- -> FilePath -- ^ Filename of the executable
- -> [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@
- -> Maybe Handle -- ^ Handle to use for @stdout@
- -> Maybe Handle -- ^ Handle to use for @stderr@
- -> Maybe CLong -- handler for SIGINT
- -> Maybe CLong -- handler for SIGQUIT
- -> IO ProcessHandle
-
-runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
- mb_sigint mb_sigquit
- = withFilePathException cmd $ do
- fd_stdin <- withHandle_ fun (fromMaybe stdin mb_stdin) $ return . haFD
- fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD
- fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD
- -- some of these might refer to the same Handle, so don't do
- -- nested withHandle_'s (that will deadlock).
- maybeWith withCEnvironment mb_env $ \pEnv -> do
- maybeWith withCString mb_cwd $ \pWorkDir -> do
- withMany withCString (cmd:args) $ \cstrs -> do
- 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)
- withArray0 nullPtr cstrs $ \pargs -> do
- ph <- throwErrnoIfMinus1 fun $
- c_runProcess pargs pWorkDir pEnv
- fd_stdin fd_stdout fd_stderr
- set_int inthand set_quit quithand
- mkProcessHandle ph
-
-foreign import ccall unsafe "runProcess"
- c_runProcess
- :: Ptr CString -- args
- -> CString -- working directory (or NULL)
- -> Ptr CString -- env (or NULL)
- -> FD -- stdin
- -> FD -- stdout
- -> FD -- stderr
- -> CInt -- non-zero: set child's SIGINT handler
- -> CLong -- SIGINT handler
- -> CInt -- non-zero: set child's SIGQUIT handler
- -> CLong -- SIGQUIT handler
- -> IO PHANDLE
-
-#endif /* __GLASGOW_HASKELL__ */
-
-ignoreSignal = CONST_SIG_IGN :: CLong
-defaultSignal = CONST_SIG_DFL :: CLong
-
-#else
-
-#ifdef __GLASGOW_HASKELL__
-
-runProcessWin32 fun cmd args mb_cwd mb_env
- mb_stdin mb_stdout mb_stderr extra_cmdline
- = withFilePathException cmd $ do
- fd_stdin <- withHandle_ fun (fromMaybe stdin mb_stdin) $ return . haFD
- fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD
- fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD
- -- some of these might refer to the same Handle, so don't do
- -- nested withHandle_'s (that will deadlock).
- maybeWith withCEnvironment mb_env $ \pEnv -> do
- maybeWith withCString mb_cwd $ \pWorkDir -> do
- let cmdline = translate cmd ++
- concat (map ((' ':) . translate) args) ++
- (if null extra_cmdline then "" else ' ':extra_cmdline)
- withCString cmdline $ \pcmdline -> do
- proc_handle <- throwErrnoIfMinus1 fun
- (c_runProcess pcmdline pWorkDir pEnv
- fd_stdin fd_stdout fd_stderr)
- mkProcessHandle proc_handle
-
-foreign import ccall unsafe "runProcess"
- c_runProcess
- :: CString
- -> CString
- -> Ptr ()
- -> FD
- -> FD
- -> FD
- -> IO PHANDLE
-
--- ------------------------------------------------------------------------
--- Passing commands to the OS on Windows
-
-{-
-On Windows this is tricky. We use CreateProcess, passing a single
-command-line string (lpCommandLine) as its argument. (CreateProcess
-is well documented on http://msdn.microsoft/com.)
-
- - It parses the beginning of the string to find the command. If the
- file name has embedded spaces, it must be quoted, using double
- quotes thus
- "foo\this that\cmd" arg1 arg2
-
- - The invoked command can in turn access the entire lpCommandLine string,
- and the C runtime does indeed do so, parsing it to generate the
- traditional argument vector argv[0], argv[1], etc. It does this
- using a complex and arcane set of rules which are described here:
-
- http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
-
- (if this URL stops working, you might be able to find it by
- searching for "Parsing C Command-Line Arguments" on MSDN. Also,
- the code in the Microsoft C runtime that does this translation
- is shipped with VC++).
-
-Our goal in runProcess is to take a command filename and list of
-arguments, and construct a string which inverts the translatsions
-described above, such that the program at the other end sees exactly
-the same arguments in its argv[] that we passed to rawSystem.
-
-This inverse translation is implemented by 'translate' below.
-
-Here are some pages that give informations on Windows-related
-limitations and deviations from Unix conventions:
-
- http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
- Command lines and environment variables effectively limited to 8191
- characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
-
- http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
- Command-line substitution under Windows XP. IIRC these facilities (or at
- least a large subset of them) are available on Win NT and 2000. Some
- might be available on Win 9x.
-
- http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
- How CMD.EXE processes command lines.
-
-
-Note: CreateProcess does have a separate argument (lpApplicationName)
-with which you can specify the command, but we have to slap the
-command into lpCommandLine anyway, so that argv[0] is what a C program
-expects (namely the application name). So it seems simpler to just
-use lpCommandLine alone, which CreateProcess supports.
--}
-
--- Translate command-line arguments for passing to CreateProcess().
-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)
- -- 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.
-
-#endif /* __GLASGOW_HASKELL__ */
-
-#endif
-
-#ifndef __HUGS__
--- ----------------------------------------------------------------------------
--- commandToProcess
-
-{- | Turns a shell command into a raw command. Usually this involves
- wrapping it in an invocation of the shell.
-
- 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.
-
- On Windows, CreateProcess takes a single string for the command,
- which is later decomposed by cmd.exe. In this case, we just want
- to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line. The
- command-line translation that we normally do for arguments on
- Windows isn't required (or desirable) here.
--}
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
-commandToProcess
- :: String
- -> IO (FilePath,[String])
-commandToProcess string = return ("/bin/sh", ["-c", string])
-
-#else
-
-commandToProcess
- :: String
- -> IO (FilePath,String)
-commandToProcess string = do
- cmd <- findCommandInterpreter
- return (cmd, "/c "++string)
- -- We don't want to put the cmd into a single
- -- argument, because cmd.exe will not try to split it up. Instead,
- -- we just tack the command on the end of the cmd.exe command line,
- -- which partly works. There seem to be some quoting issues, but
- -- I don't have the energy to find+fix them right now (ToDo). --SDM
- -- (later) Now I don't know what the above comment means. sigh.
-
--- Find CMD.EXE (or COMMAND.COM on Win98). We use the same algorithm as
--- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation).
-findCommandInterpreter :: IO FilePath
-findCommandInterpreter = do
- -- try COMSPEC first
- catchJust ioErrors (getEnv "COMSPEC") $ \e -> do
- when (not (isDoesNotExistError e)) $ ioError e
-
- -- try to find CMD.EXE or COMMAND.COM
- osver <- c_get_osver
- let filename | osver .&. 0x8000 /= 0 = "command.com"
- | otherwise = "cmd.exe"
- path <- getEnv "PATH"
- let
- -- use our own version of System.Directory.findExecutable, because
- -- that assumes the .exe suffix.
- search :: [FilePath] -> IO (Maybe FilePath)
- search [] = return Nothing
- search (d:ds) = do
- let path = d `joinFileName` filename
- b <- doesFileExist path
- if b then return (Just path)
- else search ds
- --
- mb_path <- search (parseSearchPath path)
-
- case mb_path of
- Nothing -> ioError (mkIOError doesNotExistErrorType
- "findCommandInterpreter" Nothing Nothing)
- Just cmd -> return cmd
-
-
-foreign import ccall unsafe "__hscore_get_osver"
- c_get_osver :: IO CUInt
-#endif
-
-#endif /* __HUGS__ */
-
--- ----------------------------------------------------------------------------
--- Utils
-
-withFilePathException :: FilePath -> IO a -> IO a
-withFilePathException fpath act = handle mapEx act
- where
- mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))
- mapEx e = throwIO e
-
-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a
-withCEnvironment env act =
- let env' = map (\(name, val) -> name ++ ('=':val)) env
- in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
-#else
-withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
-withCEnvironment env act =
- let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env
- in withCString env' (act . castPtr)
-#endif
-
GHC.Word,
Numeric,
Prelude,
- System.Cmd,
System.Console.GetOpt,
System.CPUTime,
System.Environment,
System.Posix.Internals,
System.Posix.Signals,
System.Posix.Types,
- System.Process,
- System.Process.Internals,
Text.ParserCombinators.ReadP,
Text.ParserCombinators.ReadPrec,
Text.Printf,
cbits/Win32Utils.c
cbits/consUtils.c
cbits/dirUtils.c
- cbits/execvpe.c
cbits/fpstring.c
cbits/inputReady.c
cbits/lockFile.c
cbits/longlong.c
- cbits/runProcess.c
cbits/selectUtils.c
include-dirs: include, ../../includes, ../../rts
includes: HsBase.h
+++ /dev/null
-/* -----------------------------------------------------------------------------
- (c) The University of Glasgow 1995-2004
-
- Our low-level exec() variant.
- -------------------------------------------------------------------------- */
-#include "HsBase.h"
-
-#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) /* to the end */
-
-/* Evidently non-Posix. */
-/* #include "PosixSource.h" */
-
-#include <unistd.h>
-#include <sys/time.h>
-#include <stdlib.h>
-#include <string.h>
-#include <errno.h>
-
-/*
- * We want the search semantics of execvp, but we want to provide our
- * own environment, like execve. The following copyright applies to
- * this code, as it is a derivative of execvp:
- *-
- * Copyright (c) 1991 The Regents of the University of California.
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- * 3. All advertising materials mentioning features or use of this software
- * must display the following acknowledgement:
- * This product includes software developed by the University of
- * California, Berkeley and its contributors.
- * 4. Neither the name of the University nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
- * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
- * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
- * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
- * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
- * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
- * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
- * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
- * SUCH DAMAGE.
- */
-
-int
-execvpe(char *name, char *const argv[], char **envp)
-{
- register int lp, ln;
- register char *p;
- int eacces=0, etxtbsy=0;
- char *bp, *cur, *path, *buf = 0;
-
- /* If it's an absolute or relative path name, it's easy. */
- if (strchr(name, '/')) {
- bp = (char *) name;
- cur = path = buf = NULL;
- goto retry;
- }
-
- /* Get the path we're searching. */
- if (!(path = getenv("PATH"))) {
-#ifdef HAVE_CONFSTR
- ln = confstr(_CS_PATH, NULL, 0);
- if ((cur = path = malloc(ln + 1)) != NULL) {
- path[0] = ':';
- (void) confstr (_CS_PATH, path + 1, ln);
- }
-#else
- if ((cur = path = malloc(1 + 1)) != NULL) {
- path[0] = ':';
- path[1] = '\0';
- }
-#endif
- } else
- cur = path = strdup(path);
-
- if (path == NULL || (bp = buf = malloc(strlen(path)+strlen(name)+2)) == NULL)
- goto done;
-
- while (cur != NULL) {
- p = cur;
- if ((cur = strchr(cur, ':')) != NULL)
- *cur++ = '\0';
-
- /*
- * It's a SHELL path -- double, leading and trailing colons mean the current
- * directory.
- */
- if (!*p) {
- p = ".";
- lp = 1;
- } else
- lp = strlen(p);
- ln = strlen(name);
-
- memcpy(buf, p, lp);
- buf[lp] = '/';
- memcpy(buf + lp + 1, name, ln);
- buf[lp + ln + 1] = '\0';
-
- retry:
- (void) execve(bp, argv, envp);
- switch (errno) {
- case EACCES:
- eacces = 1;
- break;
- case ENOENT:
- break;
- case ENOEXEC:
- {
- register size_t cnt;
- register char **ap;
-
- for (cnt = 0, ap = (char **) argv; *ap; ++ap, ++cnt)
- ;
- if ((ap = malloc((cnt + 2) * sizeof(char *))) != NULL) {
- memcpy(ap + 2, argv + 1, cnt * sizeof(char *));
-
- ap[0] = "sh";
- ap[1] = bp;
- (void) execve("/bin/sh", ap, envp);
- free(ap);
- }
- goto done;
- }
- case ETXTBSY:
- if (etxtbsy < 3)
- (void) sleep(++etxtbsy);
- goto retry;
- default:
- goto done;
- }
- }
- if (eacces)
- errno = EACCES;
- else if (!errno)
- errno = ENOENT;
- done:
- if (path)
- free(path);
- if (buf)
- free(buf);
- return (-1);
-}
-
-
-/* Copied verbatim from ghc/lib/std/cbits/system.c. */
-void pPrPr_disableITimers (void)
-{
-# ifdef HAVE_SETITIMER
- /* Reset the itimers in the child, so it doesn't get plagued
- * by SIGVTALRM interrupts.
- */
- struct timeval tv_null = { 0, 0 };
- struct itimerval itv;
- itv.it_interval = tv_null;
- itv.it_value = tv_null;
- setitimer(ITIMER_REAL, &itv, NULL);
- setitimer(ITIMER_VIRTUAL, &itv, NULL);
- setitimer(ITIMER_PROF, &itv, NULL);
-# endif
-}
-
-#endif
+++ /dev/null
-/* ----------------------------------------------------------------------------
- (c) The University of Glasgow 2004
-
- Support for System.Process
- ------------------------------------------------------------------------- */
-
-#include "HsBase.h"
-
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
-#include <windows.h>
-#include <stdlib.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))
-/* ----------------------------------------------------------------------------
- UNIX versions
- ------------------------------------------------------------------------- */
-
-ProcHandle
-runProcess (char *const args[], char *workingDirectory, char **environment,
- int fdStdInput, int fdStdOutput, int fdStdError,
- int set_inthandler, long inthandler,
- int set_quithandler, long quithandler)
-{
- int pid;
- struct sigaction dfl;
-
- switch(pid = fork())
- {
- case -1:
- return -1;
-
- case 0:
- {
- pPrPr_disableITimers();
-
- if (workingDirectory) {
- if (chdir (workingDirectory) < 0) {
- return -1;
- }
- }
-
- /* 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);
- }
-
- dup2 (fdStdInput, STDIN_FILENO);
- dup2 (fdStdOutput, STDOUT_FILENO);
- dup2 (fdStdError, STDERR_FILENO);
-
- if (environment) {
- execvpe(args[0], args, environment);
- } else {
- execvp(args[0], args);
- }
- }
- _exit(127);
- }
-
- return pid;
-}
-
-ProcHandle
-runInteractiveProcess (char *const args[],
- char *workingDirectory, char **environment,
- int *pfdStdInput, int *pfdStdOutput, int *pfdStdError)
-{
- int pid;
- int fdStdInput[2], fdStdOutput[2], fdStdError[2];
-
- pipe(fdStdInput);
- pipe(fdStdOutput);
- pipe(fdStdError);
-
- switch(pid = fork())
- {
- case -1:
- close(fdStdInput[0]);
- close(fdStdInput[1]);
- close(fdStdOutput[0]);
- close(fdStdOutput[1]);
- close(fdStdError[0]);
- close(fdStdError[1]);
- return -1;
-
- case 0:
- {
- pPrPr_disableITimers();
-
- if (workingDirectory) {
- if (chdir (workingDirectory) < 0) {
- return -1;
- }
- }
-
- if (fdStdInput[0] != STDIN_FILENO) {
- dup2 (fdStdInput[0], STDIN_FILENO);
- close(fdStdInput[0]);
- }
-
- if (fdStdOutput[1] != STDOUT_FILENO) {
- dup2 (fdStdOutput[1], STDOUT_FILENO);
- close(fdStdOutput[1]);
- }
-
- if (fdStdError[1] != STDERR_FILENO) {
- dup2 (fdStdError[1], STDERR_FILENO);
- close(fdStdError[1]);
- }
-
- close(fdStdInput[1]);
- close(fdStdOutput[0]);
- close(fdStdError[0]);
-
- /* the child */
- if (environment) {
- execvpe(args[0], args, environment);
- } else {
- execvp(args[0], args);
- }
- }
- _exit(127);
-
- default:
- close(fdStdInput[0]);
- close(fdStdOutput[1]);
- close(fdStdError[1]);
-
- *pfdStdInput = fdStdInput[1];
- *pfdStdOutput = fdStdOutput[0];
- *pfdStdError = fdStdError[0];
- break;
- }
-
- 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 wstat;
-
- while (waitpid(handle, &wstat, 0) < 0)
- {
- if (errno != EINTR)
- {
- return -1;
- }
- }
-
- if (WIFEXITED(wstat))
- return WEXITSTATUS(wstat);
- else
- if (WIFSIGNALED(wstat))
- {
- return wstat;
- }
- 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;
- BOOL status;
- SECURITY_ATTRIBUTES sec_attrs;
-
- /* Create inheritable security attributes */
- sec_attrs.nLength = sizeof(SECURITY_ATTRIBUTES);
- sec_attrs.lpSecurityDescriptor = NULL;
- sec_attrs.bInheritHandle = TRUE;
-
- /* Create the anon pipe with both ends inheritable */
- if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, &sec_attrs, 0))
- {
- maperrno();
- *pHandleIn = NULL;
- *pHandleOut = NULL;
- return FALSE;
- }
-
- if (isInheritableIn)
- *pHandleIn = hTemporaryIn;
- else
- {
- /* Make the read end non-inheritable */
- status = DuplicateHandle(GetCurrentProcess(), hTemporaryIn,
- GetCurrentProcess(), pHandleIn,
- 0,
- FALSE, /* non-inheritable */
- DUPLICATE_SAME_ACCESS);
- CloseHandle(hTemporaryIn);
- if (!status)
- {
- maperrno();
- *pHandleIn = NULL;
- *pHandleOut = NULL;
- CloseHandle(hTemporaryOut);
- return FALSE;
- }
- }
-
- if (isInheritableOut)
- *pHandleOut = hTemporaryOut;
- else
- {
- /* Make the write end non-inheritable */
- status = DuplicateHandle(GetCurrentProcess(), hTemporaryOut,
- GetCurrentProcess(), pHandleOut,
- 0,
- FALSE, /* non-inheritable */
- DUPLICATE_SAME_ACCESS);
- CloseHandle(hTemporaryOut);
- if (!status)
- {
- maperrno();
- *pHandleIn = NULL;
- *pHandleOut = NULL;
- CloseHandle(*pHandleIn);
- return FALSE;
- }
- }
-
- return TRUE;
-}
-
-ProcHandle
-runProcess (char *cmd, char *workingDirectory, void *environment,
- int fdStdInput, int fdStdOutput, int fdStdError)
-{
- STARTUPINFO sInfo;
- PROCESS_INFORMATION pInfo;
- DWORD flags;
-
- ZeroMemory(&sInfo, sizeof(sInfo));
- sInfo.cb = sizeof(sInfo);
- sInfo.hStdInput = (HANDLE) _get_osfhandle(fdStdInput);
- sInfo.hStdOutput= (HANDLE) _get_osfhandle(fdStdOutput);
- sInfo.hStdError = (HANDLE) _get_osfhandle(fdStdError);
-
- if (sInfo.hStdInput == INVALID_HANDLE_VALUE)
- sInfo.hStdInput = NULL;
- if (sInfo.hStdOutput == INVALID_HANDLE_VALUE)
- sInfo.hStdOutput = NULL;
- if (sInfo.hStdError == INVALID_HANDLE_VALUE)
- sInfo.hStdError = NULL;
-
- if (sInfo.hStdInput || sInfo.hStdOutput || sInfo.hStdError)
- sInfo.dwFlags = STARTF_USESTDHANDLES;
-
- if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) &&
- sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) &&
- sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE))
- flags = CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected
- else
- flags = 0;
-
- if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, flags, environment, workingDirectory, &sInfo, &pInfo))
- {
- maperrno();
- return -1;
- }
-
- CloseHandle(pInfo.hThread);
- return (ProcHandle)pInfo.hProcess;
-}
-
-ProcHandle
-runInteractiveProcess (char *cmd, char *workingDirectory, void *environment,
- int *pfdStdInput, int *pfdStdOutput, int *pfdStdError)
-{
- STARTUPINFO sInfo;
- PROCESS_INFORMATION pInfo;
- HANDLE hStdInputRead, hStdInputWrite;
- HANDLE hStdOutputRead, hStdOutputWrite;
- HANDLE hStdErrorRead, hStdErrorWrite;
-
- if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE))
- return -1;
-
- if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE))
- {
- CloseHandle(hStdInputRead);
- CloseHandle(hStdInputWrite);
- return -1;
- }
-
- if (!mkAnonPipe(&hStdErrorRead, FALSE, &hStdErrorWrite, TRUE))
- {
- CloseHandle(hStdInputRead);
- CloseHandle(hStdInputWrite);
- CloseHandle(hStdOutputRead);
- CloseHandle(hStdOutputWrite);
- return -1;
- }
-
- ZeroMemory(&sInfo, sizeof(sInfo));
- sInfo.cb = sizeof(sInfo);
- sInfo.dwFlags = STARTF_USESTDHANDLES;
- sInfo.hStdInput = hStdInputRead;
- sInfo.hStdOutput= hStdOutputWrite;
- sInfo.hStdError = hStdErrorWrite;
-
- if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, CREATE_NO_WINDOW, environment, workingDirectory, &sInfo, &pInfo))
- {
- maperrno();
- CloseHandle(hStdInputRead);
- CloseHandle(hStdInputWrite);
- CloseHandle(hStdOutputRead);
- CloseHandle(hStdOutputWrite);
- CloseHandle(hStdErrorRead);
- CloseHandle(hStdErrorWrite);
- return -1;
- }
- 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.
- CloseHandle(hStdInputRead);
- CloseHandle(hStdOutputWrite);
- 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 (int) pInfo.hProcess;
-}
-
-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)
-{
- DWORD retCode;
-
- if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0)
- {
- if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0)
- {
- maperrno();
- return -1;
- }
- return retCode;
- }
-
- maperrno();
- return -1;
-}
-
-#endif /* Win32 */
# do we have long longs?
AC_CHECK_TYPES([long long])
-dnl ** Working vfork?
-AC_FUNC_FORK
-
dnl ** determine whether or not const works
AC_C_CONST
AC_CHECK_HEADERS([wctype.h], [AC_CHECK_FUNCS(iswspace)])
AC_CHECK_FUNCS([lstat readdir_r])
-AC_CHECK_FUNCS([getclock getrusage setitimer times])
+AC_CHECK_FUNCS([getclock getrusage times])
AC_CHECK_FUNCS([_chsize ftruncate])
# map standard C types and ISO types to Haskell types
#include "dirUtils.h"
#include "WCsubst.h"
-#include "runProcess.h"
-
#if defined(__MINGW32__)
/* in Win32Utils.c */
extern void maperrno (void);
/* in Signals.c */
extern HsInt nocldstop;
-#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
-/* in execvpe.c */
-extern int execvpe(char *name, char *const argv[], char **envp);
-extern void pPrPr_disableITimers (void);
-#endif
-
/* -----------------------------------------------------------------------------
64-bit operations, defined in longlong.c
-------------------------------------------------------------------------- */
}
#endif /* !defined(__MINGW32__) */
-#if defined(__MINGW32__)
-INLINE unsigned int __hscore_get_osver(void) { return _osver; }
-#endif
-
/* ToDo: write a feature test that doesn't assume 'environ' to
* be in scope at link-time. */
extern char** environ;
+++ /dev/null
-/* ----------------------------------------------------------------------------
- (c) The University of Glasgow 2004
-
- Interface for code in runProcess.c (providing support for System.Process)
- ------------------------------------------------------------------------- */
-
-#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 long ProcHandle;
-#endif
-
-#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
-
-extern ProcHandle runProcess( char *const args[],
- char *workingDirectory, char **environment,
- int fdStdInput, int fdStdOutput, int fdStdError,
- int set_inthandler, long inthandler,
- int set_quithandler, long quithandler);
-
-extern ProcHandle runInteractiveProcess( char *const args[],
- char *workingDirectory,
- char **environment,
- int *pfdStdInput,
- int *pfdStdOutput,
- int *pfdStdError);
-
-#else
-
-extern ProcHandle runProcess( char *cmd,
- char *workingDirectory, void *environment,
- int fdStdInput, int fdStdOutput, int fdStdError);
-
-extern ProcHandle runInteractiveProcess( char *cmd,
- char *workingDirectory,
- void *environment,
- int *pfdStdInput,
- int *pfdStdOutput,
- int *pfdStdError);
-
-#endif
-
-extern int terminateProcess( ProcHandle handle );
-extern int getProcessExitCode( ProcHandle handle, int *pExitCode );
-extern int waitForProcess( ProcHandle handle );
projects / ghc-base.git / commitdiff