process 1.1.0.0 → 1.1.0.1
raw patch · 5 files changed
+176/−136 lines, 5 filesdep ~basedep ~filepath
Dependency ranges changed: base, filepath
Files
- System/Cmd.hs +6/−0
- System/Process.hs +75/−58
- System/Process/Internals.hs +84/−76
- include/processFlags.h +8/−0
- process.cabal +3/−2
System/Cmd.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module : System.Cmd@@ -39,3 +44,4 @@ escape c (b, str) = (False, c : str) #endif+
System/Process.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} #if __GLASGOW_HASKELL__ >= 701--- not available prior to 7.1+{-# LANGUAGE Trustworthy #-} {-# LANGUAGE InterruptibleFFI #-} #endif+ ----------------------------------------------------------------------------- -- | -- Module : System.Process@@ -18,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@@ -56,11 +57,11 @@ showCommandForUser, #ifndef __HUGS__- -- * Process completion- waitForProcess,- getProcessExitCode,- terminateProcess,- interruptProcessGroupOf,+ -- * Process completion+ waitForProcess,+ getProcessExitCode,+ terminateProcess,+ interruptProcessGroupOf, #endif ) where @@ -70,6 +71,12 @@ import System.Process.Internals import System.IO.Error+#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@@ -78,13 +85,13 @@ 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)@@ -132,13 +139,13 @@ '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@@ -149,7 +156,7 @@ 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@@ -276,10 +283,10 @@ 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@@ -316,9 +323,9 @@ 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_' ->@@ -341,6 +348,9 @@ -- Output is returned strictly, so this is not suitable for -- interactive applications. --+-- This function throws an 'IOError' if the process 'ExitCode' is+-- anything other than 'ExitSuccess'.+-- -- Users of this function should compile with @-threaded@ if they -- want other Haskell threads to keep running while waiting on -- the result of readProcess.@@ -484,7 +494,7 @@ 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@@ -546,9 +556,9 @@ 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@@ -561,7 +571,7 @@ -- processes created using 'createProcess' and setting the 'create_group' flag interruptProcessGroupOf- :: ProcessHandle -- ^ Lead process in the process group+ :: ProcessHandle -- ^ A process in the process group -> IO () interruptProcessGroupOf ph = do #if mingw32_HOST_OS@@ -577,7 +587,13 @@ 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 @@ -595,31 +611,31 @@ 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@@ -628,7 +644,8 @@ foreign import ccall interruptible "waitForProcess" -- NB. safe - can block c_waitForProcess- :: PHANDLE+ :: PHANDLE -> Ptr CInt- -> IO CInt+ -> IO CInt #endif /* !__HUGS__ */+
System/Process/Internals.hs view
@@ -2,6 +2,9 @@ {-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_GHC -w #-} -- XXX We get some warnings on Windows+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- |@@ -20,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,@@ -43,17 +46,17 @@ #ifndef __HUGS__ #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)-import System.Posix.Types ( CPid )+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@@ -78,25 +81,25 @@ 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 @@ -122,15 +125,15 @@ 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__)@@ -164,18 +167,18 @@ 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__ */ @@ -209,8 +212,8 @@ 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__)@@ -245,13 +248,13 @@ 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@@ -259,10 +262,10 @@ -- 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)) @@ -280,7 +283,7 @@ foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: Ptr CString- -> CString+ -> CString -> Ptr CString -> FD -> FD@@ -288,10 +291,10 @@ -> 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 @@ -340,9 +343,9 @@ -- 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)) @@ -395,7 +398,7 @@ 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 @@ -413,14 +416,19 @@ False {-is_socket-} False {-non-blocking-} fD <- FD.setNonBlockingMode fD True -- see #3316- mkHandleFromFD fD fd_type filepath mode False{-is_socket-}- (Just localeEncoding)+ 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-}+ 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__ -- ---------------------------------------------------------------------------- -- commandToProcess@@ -452,13 +460,13 @@ -> IO (FilePath, String) 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.+ 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. commandToProcess (RawCommand cmd args) = do return (cmd, translate cmd ++ concatMap ((' ':) . translate) args) @@ -487,24 +495,24 @@ -} 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
+ include/processFlags.h view
@@ -0,0 +1,8 @@+/* ----------------------------------------------------------------------------+ (c) The University of Glasgow 2004++ Flags used in runProcess.c and for System.Process.Internals+ ------------------------------------------------------------------------- */++#define RUN_PROCESS_IN_CLOSE_FDS 0x1+#define RUN_PROCESS_IN_NEW_GROUP 0x2
process.cabal view
@@ -1,5 +1,5 @@ name: process-version: 1.1.0.0+version: 1.1.0.1 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -38,6 +38,7 @@ runProcess.h install-includes: runProcess.h+ processFlags.h HsProcessConfig.h if os(windows) build-depends: Win32 >=2.2.0.0@@ -57,7 +58,7 @@ } build-depends: directory >= 1.0 && < 1.2,- filepath >= 1.1 && < 1.3+ filepath >= 1.1 && < 1.4 extensions: CPP }