Commit f4af593c authored by batterseapower's avatar batterseapower
Browse files

Merge branch 'master' of ssh://darcs.haskell.org/srv/darcs/packages/process

Conflicts:
	System/Process/Internals.hs
parents 87555b51 8f7a6d2a
......@@ -2,6 +2,7 @@
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Cmd
......@@ -43,3 +44,4 @@ translate str = '"' : snd (foldr escape (True,"\"") str)
escape c (b, str) = (False, c : str)
#endif
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
-- not available prior to 7.1
{-# LANGUAGE InterruptibleFFI #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : System.Process
......@@ -19,36 +19,36 @@
-----------------------------------------------------------------------------
-- ToDo:
-- * Flag to control whether exiting the parent also kills the child.
-- * Flag to control whether exiting the parent also kills the child.
{- 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.
- 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).
the inheritance flags correctly on the ends of the pipe (see
mkAnonPipe below).
-}
module System.Process (
#ifndef __HUGS__
-- * Running sub-processes
-- * Running sub-processes
createProcess,
shell, proc,
CreateProcess(..),
CmdSpec(..),
StdStream(..),
ProcessHandle,
ProcessHandle,
-- ** Specific variants of createProcess
runCommand,
runProcess,
runInteractiveCommand,
runInteractiveProcess,
runCommand,
runProcess,
runInteractiveCommand,
runInteractiveProcess,
readProcess,
readProcessWithExitCode,
#endif
......@@ -57,11 +57,11 @@ module System.Process (
showCommandForUser,
#ifndef __HUGS__
-- * Process completion
waitForProcess,
getProcessExitCode,
terminateProcess,
interruptProcessGroupOf,
-- * Process completion
waitForProcess,
getProcessExitCode,
terminateProcess,
interruptProcessGroupOf,
#endif
) where
......@@ -85,13 +85,13 @@ import Foreign.C
import System.IO
import Data.Maybe
#endif
import System.Exit ( ExitCode(..) )
import System.Exit ( ExitCode(..) )
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__ >= 611
import GHC.IO.Exception ( ioException, IOErrorType(..) )
import GHC.IO.Exception ( ioException, IOErrorType(..) )
#else
import GHC.IOBase ( ioException, IOErrorType(..) )
import GHC.IOBase ( ioException, IOErrorType(..) )
#endif
#if defined(mingw32_HOST_OS)
import System.Win32.Process (getProcessId)
......@@ -139,13 +139,13 @@ runCommand string = do
'runProcess'.
-}
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@ (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@)
:: 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@ (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
......@@ -156,7 +156,7 @@ runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
std_in = mbToStd mb_stdin,
std_out = mbToStd mb_stdout,
std_err = mbToStd mb_stderr }
Nothing Nothing
Nothing Nothing
maybeClose mb_stdin
maybeClose mb_stdout
maybeClose mb_stderr
......@@ -283,10 +283,10 @@ runInteractiveCommand string =
in text mode then use 'hSetBinaryMode'.
-}
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)
:: 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)
runInteractiveProcess cmd args mb_cwd mb_env = do
......@@ -323,9 +323,9 @@ waitForProcess ph = do
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)
-- 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_' ->
......@@ -494,7 +494,7 @@ syncProcess fun c = do
old_int <- installHandler sigINT Ignore Nothing
old_quit <- installHandler sigQUIT Ignore Nothing
(_,_,_,p) <- runGenProcess_ fun c
(Just defaultSignal) (Just defaultSignal)
(Just defaultSignal) (Just defaultSignal)
r <- waitForProcess p
_ <- installHandler sigINT old_int Nothing
_ <- installHandler sigQUIT old_quit Nothing
......@@ -556,9 +556,9 @@ terminateProcess ph = do
ClosedHandle _ -> return p_
OpenHandle h -> do
throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h
return p_
-- does not close the handle, we might want to try terminating it
-- again, or get its exit code.
return p_
-- does not close the handle, we might want to try terminating it
-- again, or get its exit code.
-- ----------------------------------------------------------------------------
-- interruptProcessGroupOf
......@@ -611,31 +611,31 @@ getProcessExitCode ph = do
case p_ of
ClosedHandle e -> return (p_, Just e)
OpenHandle h ->
alloca $ \pExitCode -> do
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)
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
:: PHANDLE
-> IO CInt
foreign import ccall unsafe "getProcessExitCode"
c_getProcessExitCode
:: PHANDLE
-> Ptr CInt
-> IO CInt
:: PHANDLE
-> Ptr CInt
-> IO CInt
#if __GLASGOW_HASKELL__ < 701
-- not available prior to 7.1
......@@ -644,7 +644,8 @@ foreign import ccall unsafe "getProcessExitCode"
foreign import ccall interruptible "waitForProcess" -- NB. safe - can block
c_waitForProcess
:: PHANDLE
:: PHANDLE
-> Ptr CInt
-> IO CInt
-> IO CInt
#endif /* !__HUGS__ */
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface, RecordWildCards #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, RecordWildCards #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -w #-}
-- XXX We get some warnings on Windows
......@@ -24,21 +23,21 @@
-- #hide
module System.Process.Internals (
#ifndef __HUGS__
ProcessHandle(..), ProcessHandle__(..),
PHANDLE, closePHANDLE, mkProcessHandle,
withProcessHandle, withProcessHandle_,
ProcessHandle(..), ProcessHandle__(..),
PHANDLE, closePHANDLE, mkProcessHandle,
withProcessHandle, withProcessHandle_,
#ifdef __GLASGOW_HASKELL__
CreateProcess(..),
CmdSpec(..), StdStream(..),
runGenProcess_,
runGenProcess_,
#endif
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
pPrPr_disableITimers, c_execvpe,
ignoreSignal, defaultSignal,
pPrPr_disableITimers, c_execvpe,
ignoreSignal, defaultSignal,
#endif
#endif
withFilePathException, withCEnvironment,
translate,
withFilePathException, withCEnvironment,
translate,
#ifndef __HUGS__
fdToHandle,
......@@ -49,15 +48,15 @@ module System.Process.Internals (
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
import System.Posix.Types
import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe )
import System.IO ( IOMode(..) )
import System.IO ( IOMode(..) )
#else
import Data.Word ( Word32 )
import Data.IORef
#endif
#endif
import System.IO ( Handle )
import System.Exit ( ExitCode )
import System.IO ( Handle )
import System.Exit ( ExitCode )
import Control.Concurrent
import Control.Exception
import Foreign.C
......@@ -82,25 +81,25 @@ import GHC.IO.IOMode
import System.Win32.DebugApi (PHANDLE)
#endif
#else
import GHC.IOBase ( haFD, FD, IOException(..) )
import GHC.IOBase ( haFD, FD, IOException(..) )
import GHC.Handle
#endif
# elif __HUGS__
import Hugs.Exception ( IOException(..) )
import Hugs.Exception ( IOException(..) )
# endif
#ifdef base4
import System.IO.Error ( ioeSetFileName )
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 Control.Monad ( when )
import System.Directory ( doesFileExist )
import System.IO.Error ( isDoesNotExistError, doesNotExistErrorType,
mkIOError )
import System.Environment ( getEnv )
import System.FilePath
#endif
......@@ -126,15 +125,15 @@ data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode
newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)
withProcessHandle
:: ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a))
-> IO a
:: ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a))
-> IO a
withProcessHandle (ProcessHandle m) io = modifyMVar m io
withProcessHandle_
:: ProcessHandle
-> (ProcessHandle__ -> IO ProcessHandle__)
-> IO ()
:: ProcessHandle
-> (ProcessHandle__ -> IO ProcessHandle__)
-> IO ()
withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
......@@ -168,18 +167,18 @@ mkProcessHandle h = do
processHandleFinaliser m =
modifyMVar_ m $ \p_ -> do
case p_ of
OpenHandle ph -> closePHANDLE ph
_ -> return ()
return (error "closed process handle")
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 ()
:: PHANDLE
-> IO ()
#endif
#endif /* !__HUGS__ */
......@@ -213,8 +212,8 @@ data StdStream
runGenProcess_
:: String -- ^ function name (for error messages)
-> CreateProcess
-> Maybe CLong -- ^ handler for SIGINT
-> Maybe CLong -- ^ handler for SIGQUIT
-> 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__)
......@@ -249,13 +248,13 @@ runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,
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)
= 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)
-- runInteractiveProcess() blocks signals around the fork().
-- Since blocking/unblocking of signals is a global state
......@@ -263,10 +262,10 @@ runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,
-- 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
pfdStdInput pfdStdOutput pfdStdError
set_int inthand set_quit quithand
((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
.|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0))
......@@ -284,7 +283,7 @@ runInteractiveProcess_lock = unsafePerformIO $ newMVar ()
foreign import ccall unsafe "runInteractiveProcess"
c_runInteractiveProcess
:: Ptr CString
-> CString
-> CString
-> Ptr CString
-> FD
-> FD
......@@ -292,10 +291,10 @@ foreign import ccall unsafe "runInteractiveProcess"
-> 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 -- non-zero: set child's SIGINT handler
-> CLong -- SIGINT handler
-> CInt -- non-zero: set child's SIGQUIT handler
-> CLong -- SIGQUIT handler
-> CInt -- flags
-> IO PHANDLE
......@@ -344,9 +343,9 @@ runGenProcess_ fun CreateProcess{ cmdspec = cmdsp,
-- 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
pfdStdInput pfdStdOutput pfdStdError
((if mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
.|.(if mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0))
......@@ -399,7 +398,7 @@ mbFd fun _std (UseHandle hdl) =
return (Handle__{haDevice=fd,..}, FD.fdFD fd)
Nothing ->
ioError (mkIOError illegalOperationErrorType
"createProcess" (Just hdl) Nothing
"createProcess" (Just hdl) Nothing
`ioeSetErrorString` "handle is not a file descriptor")
#endif
......@@ -417,17 +416,17 @@ pfdToHandle pfd mode = do
False {-is_socket-}
False {-non-blocking-}
fD <- FD.setNonBlockingMode fD True -- see #3316
#if __GLASGOW_HASKELL__ >= 703
enc <- getLocaleEncoding
#else
let enc = localeEncoding
#endif
mkHandleFromFD fD fd_type filepath mode False{-is_socket-}
(Just enc)
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-}
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
#endif
#ifndef __HUGS__
......@@ -462,12 +461,12 @@ commandToProcess
commandToProcess (ShellCommand string) = do
cmd <- findCommandInterpreter
return (cmd, translate 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.
-- 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.
commandToProcess (RawCommand cmd args) = do
return (cmd, translate cmd ++ concatMap ((' ':) . translate) args)
......@@ -496,24 +495,24 @@ findCommandInterpreter = do
-}
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 path1 = d </> "cmd.exe"
path2 = d </> "command.com"
b1 <- doesFileExist path1
b2 <- doesFileExist path2
if b1 then return (Just path1)
else if b2 then return (Just path2)
else search ds
-- 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 path1 = d </> "cmd.exe"
path2 = d </> "command.com"
b1 <- doesFileExist path1
b2 <- doesFileExist path2
if b1 then return (Just path1)
else if b2 then return (Just path2)
else search ds
--
mb_path <- search (splitSearchPath path)
case mb_path of
Nothing -> ioError (mkIOError doesNotExistErrorType
"findCommandInterpreter" Nothing Nothing)
"findCommandInterpreter" Nothing Nothing)
Just cmd -> return cmd
#endif
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment