Ticket #8943: 0001-Add-createPipe.2.patch

File 0001-Add-createPipe.2.patch, 68.9 KB (added by refold, 15 months ago)

Updated version of the patch that compiles on Windows

  • deleted file System/Process.hs

    From 0bbb6ebce3e675c4e4698111d76ac701f5c42951 Mon Sep 17 00:00:00 2001
    From: Johan Tibell <[email protected]>
    Date: Sun, 30 Mar 2014 17:18:12 +0200
    Subject: [PATCH] Add createPipe
    
    Neccesary for implementing 'tee' like behavior.
    ---
     System/Process.hs  | 897 ---------------------------------------------------
     System/Process.hsc | 926 +++++++++++++++++++++++++++++++++++++++++++++++++++++
     2 files changed, 926 insertions(+), 897 deletions(-)
     delete mode 100644 System/Process.hs
     create mode 100644 System/Process.hsc
    
    diff --git a/System/Process.hs b/System/Process.hs
    deleted file mode 100644
    index 87e9a41..0000000
    + -  
    1 {-# LANGUAGE CPP #-} 
    2 #ifdef __GLASGOW_HASKELL__ 
    3 {-# LANGUAGE Trustworthy #-} 
    4 {-# LANGUAGE InterruptibleFFI #-} 
    5 #endif 
    6  
    7 ----------------------------------------------------------------------------- 
    8 -- | 
    9 -- Module      :  System.Process 
    10 -- Copyright   :  (c) The University of Glasgow 2004-2008 
    11 -- License     :  BSD-style (see the file libraries/base/LICENSE) 
    12 -- 
    13 -- Maintainer  :  [email protected] 
    14 -- Stability   :  experimental 
    15 -- Portability :  non-portable (requires concurrency) 
    16 -- 
    17 -- Operations for creating and interacting with sub-processes. 
    18 -- 
    19 ----------------------------------------------------------------------------- 
    20  
    21 -- ToDo: 
    22 --      * Flag to control whether exiting the parent also kills the child. 
    23  
    24 {- NOTES on createPipe: 
    25  
    26    createPipe is no longer exported, because of the following problems: 
    27  
    28         - it wasn't used to implement runInteractiveProcess on Unix, because 
    29           the file descriptors for the unused ends of the pipe need to be closed 
    30           in the child process. 
    31  
    32         - on Windows, a special version of createPipe is needed that sets 
    33           the inheritance flags correctly on the ends of the pipe (see 
    34           mkAnonPipe below). 
    35 -} 
    36  
    37 module System.Process ( 
    38     -- * Running sub-processes 
    39     createProcess, 
    40     shell, proc, 
    41     CreateProcess(..), 
    42     CmdSpec(..), 
    43     StdStream(..), 
    44     ProcessHandle, 
    45  
    46     -- ** Simpler functions for common tasks 
    47     callProcess, 
    48     callCommand, 
    49     spawnProcess, 
    50     spawnCommand, 
    51     readProcess, 
    52     readProcessWithExitCode, 
    53  
    54     -- ** Related utilities 
    55     showCommandForUser, 
    56  
    57     -- ** Control-C handling on Unix 
    58     -- $ctlc-handling 
    59  
    60     -- * Process completion 
    61     waitForProcess, 
    62     getProcessExitCode, 
    63     terminateProcess, 
    64     interruptProcessGroupOf, 
    65  
    66     -- * Old deprecated functions 
    67     -- | These functions pre-date 'createProcess' which is much more 
    68     -- flexible. 
    69     runProcess, 
    70     runCommand, 
    71     runInteractiveProcess, 
    72     runInteractiveCommand, 
    73     system, 
    74     rawSystem, 
    75     ) where 
    76  
    77 import Prelude hiding (mapM) 
    78  
    79 import System.Process.Internals 
    80  
    81 import Control.Concurrent 
    82 import Control.DeepSeq (rnf) 
    83 import Control.Exception (SomeException, mask, try, throwIO) 
    84 import qualified Control.Exception as C 
    85 import Control.Monad 
    86 import Data.Maybe 
    87 import Foreign 
    88 import Foreign.C 
    89 import System.Exit      ( ExitCode(..) ) 
    90 import System.IO 
    91 import System.IO.Error (mkIOError, ioeSetErrorString) 
    92  
    93 #if !defined(mingw32_HOST_OS) 
    94 import System.Posix.Process (getProcessGroupIDOf) 
    95 import System.Posix.Types 
    96 #endif 
    97  
    98 #ifdef __GLASGOW_HASKELL__ 
    99 import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) ) 
    100 # if defined(mingw32_HOST_OS) 
    101 import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT) 
    102 import System.Win32.Process (getProcessId) 
    103 # else 
    104 import System.Posix.Signals 
    105 # endif 
    106 #endif 
    107  
    108 -- ---------------------------------------------------------------------------- 
    109 -- createProcess 
    110  
    111 -- | Construct a 'CreateProcess' record for passing to 'createProcess', 
    112 -- representing a raw command with arguments. 
    113 -- 
    114 -- The 'FilePath' argument names the executable, and is interpreted according 
    115 -- to the platform's standard policy for searching for 
    116 -- executables. Specifically: 
    117 -- 
    118 -- * on Unix systems the 
    119 --   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/execvp.html execvp(3)> 
    120 --   semantics is used, where if the executable filename does not 
    121 --   contain a slash (@/@) then the @PATH@ environment variable is 
    122 --   searched for the executable. 
    123 -- 
    124 -- * on Windows systems the Win32 @CreateProcess@ semantics is used. 
    125 --   Briefly: if the filename does not contain a path, then the 
    126 --   directory containing the parent executable is searched, followed 
    127 --   by the current directory, then some standard locations, and 
    128 --   finally the current @PATH@.  An @.exe@ extension is added if the 
    129 --   filename does not already have an extension.  For full details 
    130 --   see the 
    131 --   <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365527%28v=vs.85%29.aspx documentation> 
    132 --   for the Windows @SearchPath@ API. 
    133  
    134 proc :: FilePath -> [String] -> CreateProcess 
    135 proc cmd args = CreateProcess { cmdspec = RawCommand cmd args, 
    136                                 cwd = Nothing, 
    137                                 env = Nothing, 
    138                                 std_in = Inherit, 
    139                                 std_out = Inherit, 
    140                                 std_err = Inherit, 
    141                                 close_fds = False, 
    142                                 create_group = False, 
    143                                 delegate_ctlc = False} 
    144  
    145 -- | Construct a 'CreateProcess' record for passing to 'createProcess', 
    146 -- representing a command to be passed to the shell. 
    147 shell :: String -> CreateProcess 
    148 shell str = CreateProcess { cmdspec = ShellCommand str, 
    149                             cwd = Nothing, 
    150                             env = Nothing, 
    151                             std_in = Inherit, 
    152                             std_out = Inherit, 
    153                             std_err = Inherit, 
    154                             close_fds = False, 
    155                             create_group = False, 
    156                             delegate_ctlc = False} 
    157  
    158 {- | 
    159 This is the most general way to spawn an external process.  The 
    160 process can be a command line to be executed by a shell or a raw command 
    161 with a list of arguments.  The stdin, stdout, and stderr streams of 
    162 the new process may individually be attached to new pipes, to existing 
    163 'Handle's, or just inherited from the parent (the default.) 
    164  
    165 The details of how to create the process are passed in the 
    166 'CreateProcess' record.  To make it easier to construct a 
    167 'CreateProcess', the functions 'proc' and 'shell' are supplied that 
    168 fill in the fields with default values which can be overriden as 
    169 needed. 
    170  
    171 'createProcess' returns @(/mb_stdin_hdl/, /mb_stdout_hdl/, /mb_stderr_hdl/, /ph/)@, 
    172 where 
    173  
    174  * if @'std_in' == 'CreatePipe'@, then @/mb_stdin_hdl/@ will be @Just /h/@, 
    175    where @/h/@ is the write end of the pipe connected to the child 
    176    process's @stdin@. 
    177  
    178  * otherwise, @/mb_stdin_hdl/ == Nothing@ 
    179  
    180 Similarly for @/mb_stdout_hdl/@ and @/mb_stderr_hdl/@. 
    181  
    182 For example, to execute a simple @ls@ command: 
    183  
    184 >   r <- createProcess (proc "ls" []) 
    185  
    186 To create a pipe from which to read the output of @ls@: 
    187  
    188 >   (_, Just hout, _, _) <- 
    189 >       createProcess (proc "ls" []){ std_out = CreatePipe } 
    190  
    191 To also set the directory in which to run @ls@: 
    192  
    193 >   (_, Just hout, _, _) <- 
    194 >       createProcess (proc "ls" []){ cwd = Just "\home\bob", 
    195 >                                     std_out = CreatePipe } 
    196  
    197 -} 
    198 createProcess 
    199   :: CreateProcess 
    200   -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) 
    201 createProcess cp = do 
    202   r <- createProcess_ "createProcess" cp 
    203   maybeCloseStd (std_in  cp) 
    204   maybeCloseStd (std_out cp) 
    205   maybeCloseStd (std_err cp) 
    206   return r 
    207  where 
    208   maybeCloseStd :: StdStream -> IO () 
    209   maybeCloseStd (UseHandle hdl) 
    210     | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl 
    211   maybeCloseStd _ = return () 
    212  
    213 {- 
    214 -- TODO: decide if we want to expose this to users 
    215 -- | A 'C.bracketOnError'-style resource handler for 'createProcess'. 
    216 -- 
    217 -- In normal operation it adds nothing, you are still responsible for waiting 
    218 -- for (or forcing) process termination and closing any 'Handle's. It only does 
    219 -- automatic cleanup if there is an exception. If there is an exception in the 
    220 -- body then it ensures that the process gets terminated and any 'CreatePipe' 
    221 -- 'Handle's are closed. In particular this means that if the Haskell thread 
    222 -- is killed (e.g. 'killThread'), that the external process is also terminated. 
    223 -- 
    224 -- e.g. 
    225 -- 
    226 -- > withCreateProcess (proc cmd args) { ... }  $ \_ _ _ ph -> do 
    227 -- >   ... 
    228 -- 
    229 withCreateProcess 
    230   :: CreateProcess 
    231   -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) 
    232   -> IO a 
    233 withCreateProcess c action = 
    234     C.bracketOnError (createProcess c) cleanupProcess 
    235                      (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) 
    236 -} 
    237  
    238 -- wrapper so we can get exceptions with the appropriate function name. 
    239 withCreateProcess_ 
    240   :: String 
    241   -> CreateProcess 
    242   -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) 
    243   -> IO a 
    244 withCreateProcess_ fun c action = 
    245     C.bracketOnError (createProcess_ fun c) cleanupProcess 
    246                      (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) 
    247  
    248  
    249 cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) 
    250                -> IO () 
    251 cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do 
    252     terminateProcess ph 
    253     -- Note, it's important that other threads that might be reading/writing 
    254     -- these handles also get killed off, since otherwise they might be holding 
    255     -- the handle lock and prevent us from closing, leading to deadlock. 
    256     maybe (return ()) (ignoreSigPipe . hClose) mb_stdin 
    257     maybe (return ()) hClose mb_stdout 
    258     maybe (return ()) hClose mb_stderr 
    259     -- terminateProcess does not guarantee that it terminates the process. 
    260     -- Indeed on Unix it's SIGTERM, which asks nicely but does not guarantee 
    261     -- that it stops. If it doesn't stop, we don't want to hang, so we wait 
    262     -- asynchronously using forkIO. 
    263     _ <- forkIO (waitForProcess ph >> return ()) 
    264     return () 
    265  
    266  
    267 -- ---------------------------------------------------------------------------- 
    268 -- spawnProcess/spawnCommand 
    269  
    270 -- | Creates a new process to run the specified raw command with the given 
    271 -- arguments. It does not wait for the program to finish, but returns the 
    272 -- 'ProcessHandle'. 
    273 -- 
    274 -- /Since: 1.2.0.0/ 
    275 spawnProcess :: FilePath -> [String] -> IO ProcessHandle 
    276 spawnProcess cmd args = do 
    277     (_,_,_,p) <- createProcess_ "spawnProcess" (proc cmd args) 
    278     return p 
    279  
    280 -- | Creates a new process to run the specified shell command. 
    281 -- It does not wait for the program to finish, but returns the 'ProcessHandle'. 
    282 -- 
    283 -- /Since: 1.2.0.0/ 
    284 spawnCommand :: String -> IO ProcessHandle 
    285 spawnCommand cmd = do 
    286     (_,_,_,p) <- createProcess_ "spawnCommand" (shell cmd) 
    287     return p 
    288  
    289  
    290 -- ---------------------------------------------------------------------------- 
    291 -- callProcess/callCommand 
    292  
    293 -- | Creates a new process to run the specified command with the given 
    294 -- arguments, and wait for it to finish.  If the command returns a non-zero 
    295 -- exit code, an exception is raised. 
    296 -- 
    297 -- If an asynchronous exception is thrown to the thread executing 
    298 -- @callProcess@. The forked process will be terminated and 
    299 -- @callProcess@ will wait (block) until the process has been 
    300 -- terminated. 
    301 -- 
    302 -- /Since: 1.2.0.0/ 
    303 callProcess :: FilePath -> [String] -> IO () 
    304 callProcess cmd args = do 
    305     exit_code <- withCreateProcess_ "callCommand" 
    306                    (proc cmd args) { delegate_ctlc = True } $ \_ _ _ p -> 
    307                    waitForProcess p 
    308     case exit_code of 
    309       ExitSuccess   -> return () 
    310       ExitFailure r -> processFailedException "callProcess" cmd args r 
    311  
    312 -- | Creates a new process to run the specified shell command.  If the 
    313 -- command returns a non-zero exit code, an exception is raised. 
    314 -- 
    315 -- If an asynchronous exception is thrown to the thread executing 
    316 -- @callCommand@. The forked process will be terminated and 
    317 -- @callCommand@ will wait (block) until the process has been 
    318 -- terminated. 
    319 -- 
    320 -- /Since: 1.2.0.0/ 
    321 callCommand :: String -> IO () 
    322 callCommand cmd = do 
    323     exit_code <- withCreateProcess_ "callCommand" 
    324                    (shell cmd) { delegate_ctlc = True } $ \_ _ _ p -> 
    325                    waitForProcess p 
    326     case exit_code of 
    327       ExitSuccess   -> return () 
    328       ExitFailure r -> processFailedException "callCommand" cmd [] r 
    329  
    330 processFailedException :: String -> String -> [String] -> Int -> IO a 
    331 processFailedException fun cmd args exit_code = 
    332       ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++ 
    333                                      concatMap ((' ':) . show) args ++ 
    334                                      " (exit " ++ show exit_code ++ ")") 
    335                                  Nothing Nothing) 
    336  
    337  
    338 -- ---------------------------------------------------------------------------- 
    339 -- Control-C handling on Unix 
    340  
    341 -- $ctlc-handling 
    342 -- 
    343 -- When running an interactive console process (such as a shell, console-based 
    344 -- text editor or ghci), we typically want that process to be allowed to handle 
    345 -- Ctl-C keyboard interrupts how it sees fit. For example, while most programs 
    346 -- simply quit on a Ctl-C, some handle it specially. To allow this to happen, 
    347 -- use the @'delegate_ctlc' = True@ option in the 'CreateProcess' options. 
    348 -- 
    349 -- The gory details: 
    350 -- 
    351 -- By default Ctl-C will generate a @SIGINT@ signal, causing a 'UserInterrupt' 
    352 -- exception to be sent to the main Haskell thread of your program, which if 
    353 -- not specially handled will terminate the program. Normally, this is exactly 
    354 -- what is wanted: an orderly shutdown of the program in response to Ctl-C. 
    355 -- 
    356 -- Of course when running another interactive program in the console then we 
    357 -- want to let that program handle Ctl-C. Under Unix however, Ctl-C sends 
    358 -- @SIGINT@ to every process using the console. The standard solution is that 
    359 -- while running an interactive program, ignore @SIGINT@ in the parent, and let 
    360 -- it be handled in the child process. If that process then terminates due to 
    361 -- the @SIGINT@ signal, then at that point treat it as if we had recieved the 
    362 -- @SIGINT@ ourselves and begin an orderly shutdown. 
    363 -- 
    364 -- This behaviour is implemented by 'createProcess' (and 
    365 -- 'waitForProcess' \/ 'getProcessExitCode') when the @'delegate_ctlc' = True@ 
    366 -- option is set. In particular, the @SIGINT@ signal will be ignored until 
    367 -- 'waitForProcess' returns (or 'getProcessExitCode' returns a non-Nothing 
    368 -- result), so it becomes especially important to use 'waitForProcess' for every 
    369 -- processes created. 
    370 -- 
    371 -- In addition, in 'delegate_ctlc' mode, 'waitForProcess' and 
    372 -- 'getProcessExitCode' will throw a 'UserInterrupt' exception if the process 
    373 -- terminated with @'ExitFailure' (-SIGINT)@. Typically you will not want to 
    374 -- catch this exception, but let it propagate, giving a normal orderly shutdown. 
    375 -- One detail to be aware of is that the 'UserInterrupt' exception is thrown 
    376 -- /synchronously/ in the thread that calls 'waitForProcess', whereas normally 
    377 -- @SIGINT@ causes the exception to be thrown /asynchronously/ to the main 
    378 -- thread. 
    379 -- 
    380 -- For even more detail on this topic, see 
    381 -- <http://www.cons.org/cracauer/sigint.html "Proper handling of SIGINT/SIGQUIT">. 
    382  
    383 -- ----------------------------------------------------------------------------- 
    384  
    385 -- | @readProcess@ forks an external process, reads its standard output 
    386 -- strictly, blocking until the process terminates, and returns the output 
    387 -- string. 
    388 -- 
    389 -- If an asynchronous exception is thrown to the thread executing 
    390 -- @readProcess@. The forked process will be terminated and @readProcess@ will 
    391 -- wait (block) until the process has been terminated. 
    392 -- 
    393 -- Output is returned strictly, so this is not suitable for 
    394 -- interactive applications. 
    395 -- 
    396 -- This function throws an 'IOError' if the process 'ExitCode' is 
    397 -- anything other than 'ExitSuccess'. 
    398 -- 
    399 -- Users of this function should compile with @-threaded@ if they 
    400 -- want other Haskell threads to keep running while waiting on 
    401 -- the result of readProcess. 
    402 -- 
    403 -- >  > readProcess "date" [] [] 
    404 -- >  "Thu Feb  7 10:03:39 PST 2008\n" 
    405 -- 
    406 -- The arguments are: 
    407 -- 
    408 -- * The command to run, which must be in the $PATH, or an absolute path 
    409 -- 
    410 -- * A list of separate command line arguments to the program 
    411 -- 
    412 -- * A string to pass on the standard input to the program. 
    413 -- 
    414 readProcess 
    415     :: FilePath                 -- ^ Filename of the executable (see 'proc' for details) 
    416     -> [String]                 -- ^ any arguments 
    417     -> String                   -- ^ standard input 
    418     -> IO String                -- ^ stdout 
    419 readProcess cmd args input = do 
    420     let cp_opts = (proc cmd args) { 
    421                     std_in  = CreatePipe, 
    422                     std_out = CreatePipe, 
    423                     std_err = Inherit 
    424                   } 
    425     (ex, output) <- withCreateProcess_ "readProcess" cp_opts $ 
    426       \(Just inh) (Just outh) _ ph -> do 
    427  
    428         -- fork off a thread to start consuming the output 
    429         output  <- hGetContents outh 
    430         withForkWait (C.evaluate $ rnf output) $ \waitOut -> do 
    431  
    432           -- now write any input 
    433           unless (null input) $ 
    434             ignoreSigPipe $ hPutStr inh input 
    435           -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE 
    436           ignoreSigPipe $ hClose inh 
    437  
    438           -- wait on the output 
    439           waitOut 
    440           hClose outh 
    441  
    442         -- wait on the process 
    443         ex <- waitForProcess ph 
    444         return (ex, output) 
    445  
    446     case ex of 
    447      ExitSuccess   -> return output 
    448      ExitFailure r -> processFailedException "readProcess" cmd args r 
    449  
    450 {- | 
    451 @readProcessWithExitCode@ creates an external process, reads its 
    452 standard output and standard error strictly, waits until the process 
    453 terminates, and then returns the 'ExitCode' of the process, 
    454 the standard output, and the standard error. 
    455  
    456 If an asynchronous exception is thrown to the thread executing 
    457 @readProcessWithExitCode@. The forked process will be terminated and 
    458 @readProcessWithExitCode@ will wait (block) until the process has been 
    459 terminated. 
    460  
    461 'readProcess' and 'readProcessWithExitCode' are fairly simple wrappers 
    462 around 'createProcess'.  Constructing variants of these functions is 
    463 quite easy: follow the link to the source code to see how 
    464 'readProcess' is implemented. 
    465  
    466 On Unix systems, see 'waitForProcess' for the meaning of exit codes 
    467 when the process died as the result of a signal. 
    468 -} 
    469  
    470 readProcessWithExitCode 
    471     :: FilePath                 -- ^ Filename of the executable (see 'proc' for details) 
    472     -> [String]                 -- ^ any arguments 
    473     -> String                   -- ^ standard input 
    474     -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr 
    475 readProcessWithExitCode cmd args input = do 
    476     let cp_opts = (proc cmd args) { 
    477                     std_in  = CreatePipe, 
    478                     std_out = CreatePipe, 
    479                     std_err = CreatePipe 
    480                   } 
    481     withCreateProcess_ "readProcessWithExitCode" cp_opts $ 
    482       \(Just inh) (Just outh) (Just errh) ph -> do 
    483  
    484         out <- hGetContents outh 
    485         err <- hGetContents errh 
    486  
    487         -- fork off threads to start consuming stdout & stderr 
    488         withForkWait  (C.evaluate $ rnf out) $ \waitOut -> 
    489          withForkWait (C.evaluate $ rnf err) $ \waitErr -> do 
    490  
    491           -- now write any input 
    492           unless (null input) $ 
    493             ignoreSigPipe $ hPutStr inh input 
    494           -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE 
    495           ignoreSigPipe $ hClose inh 
    496  
    497           -- wait on the output 
    498           waitOut 
    499           waitErr 
    500  
    501           hClose outh 
    502           hClose errh 
    503  
    504         -- wait on the process 
    505         ex <- waitForProcess ph 
    506  
    507         return (ex, out, err) 
    508  
    509 -- | Fork a thread while doing something else, but kill it if there's an 
    510 -- exception. 
    511 -- 
    512 -- This is important in the cases above because we want to kill the thread 
    513 -- that is holding the Handle lock, because when we clean up the process we 
    514 -- try to close that handle, which could otherwise deadlock. 
    515 -- 
    516 withForkWait :: IO () -> (IO () ->  IO a) -> IO a 
    517 withForkWait async body = do 
    518   waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ())) 
    519   mask $ \restore -> do 
    520     tid <- forkIO $ try (restore async) >>= putMVar waitVar 
    521     let wait = takeMVar waitVar >>= either throwIO return 
    522     restore (body wait) `C.onException` killThread tid 
    523  
    524 ignoreSigPipe :: IO () -> IO () 
    525 #if defined(__GLASGOW_HASKELL__) 
    526 ignoreSigPipe = C.handle $ \e -> case e of 
    527                                    IOError { ioe_type  = ResourceVanished 
    528                                            , ioe_errno = Just ioe } 
    529                                      | Errno ioe == ePIPE -> return () 
    530                                    _ -> throwIO e 
    531 #else 
    532 ignoreSigPipe = id 
    533 #endif 
    534  
    535 -- ---------------------------------------------------------------------------- 
    536 -- showCommandForUser 
    537  
    538 -- | Given a program @/p/@ and arguments @/args/@, 
    539 --   @showCommandForUser /p/ /args/@ returns a string suitable for pasting 
    540 --   into @\/bin\/sh@ (on Unix systems) or @CMD.EXE@ (on Windows). 
    541 showCommandForUser :: FilePath -> [String] -> String 
    542 showCommandForUser cmd args = unwords (map translate (cmd : args)) 
    543  
    544  
    545 -- ---------------------------------------------------------------------------- 
    546 -- waitForProcess 
    547  
    548 {- | Waits for the specified process to terminate, and returns its exit code. 
    549  
    550 GHC Note: in order to call @waitForProcess@ without blocking all the 
    551 other threads in the system, you must compile the program with 
    552 @-threaded@. 
    553  
    554 (/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@ 
    555 indicates that the child was terminated by signal @/signum/@. 
    556 The signal numbers are platform-specific, so to test for a specific signal use 
    557 the constants provided by "System.Posix.Signals" in the @unix@ package. 
    558 Note: core dumps are not reported, use "System.Posix.Process" if you need this 
    559 detail. 
    560  
    561 -} 
    562 waitForProcess 
    563   :: ProcessHandle 
    564   -> IO ExitCode 
    565 waitForProcess ph@(ProcessHandle _ delegating_ctlc) = do 
    566   p_ <- modifyProcessHandle ph $ \p_ -> return (p_,p_) 
    567   case p_ of 
    568     ClosedHandle e -> return e 
    569     OpenHandle h  -> do 
    570         -- don't hold the MVar while we call c_waitForProcess... 
    571         -- (XXX but there's a small race window here during which another 
    572         -- thread could close the handle or call waitForProcess) 
    573         e <- alloca $ \pret -> do 
    574           throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret) 
    575           modifyProcessHandle ph $ \p_' -> 
    576             case p_' of 
    577               ClosedHandle e -> return (p_',e) 
    578               OpenHandle ph' -> do 
    579                 closePHANDLE ph' 
    580                 code <- peek pret 
    581                 let e = if (code == 0) 
    582                        then ExitSuccess 
    583                        else (ExitFailure (fromIntegral code)) 
    584                 return (ClosedHandle e, e) 
    585         when delegating_ctlc $ 
    586           endDelegateControlC e 
    587         return e 
    588  
    589  
    590 -- ---------------------------------------------------------------------------- 
    591 -- getProcessExitCode 
    592  
    593 {- | 
    594 This is a non-blocking version of 'waitForProcess'.  If the process is 
    595 still running, 'Nothing' is returned.  If the process has exited, then 
    596 @'Just' e@ is returned where @e@ is the exit code of the process. 
    597  
    598 On Unix systems, see 'waitForProcess' for the meaning of exit codes 
    599 when the process died as the result of a signal. 
    600 -} 
    601  
    602 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) 
    603 getProcessExitCode ph@(ProcessHandle _ delegating_ctlc) = do 
    604   (m_e, was_open) <- modifyProcessHandle ph $ \p_ -> 
    605     case p_ of 
    606       ClosedHandle e -> return (p_, (Just e, False)) 
    607       OpenHandle h -> 
    608         alloca $ \pExitCode -> do 
    609             res <- throwErrnoIfMinus1Retry "getProcessExitCode" $ 
    610                         c_getProcessExitCode h pExitCode 
    611             code <- peek pExitCode 
    612             if res == 0 
    613               then return (p_, (Nothing, False)) 
    614               else do 
    615                    closePHANDLE h 
    616                    let e  | code == 0 = ExitSuccess 
    617                           | otherwise = ExitFailure (fromIntegral code) 
    618                    return (ClosedHandle e, (Just e, True)) 
    619   case m_e of 
    620     Just e | was_open && delegating_ctlc -> endDelegateControlC e 
    621     _                                    -> return () 
    622   return m_e 
    623  
    624  
    625 -- ---------------------------------------------------------------------------- 
    626 -- terminateProcess 
    627  
    628 -- | Attempts to terminate the specified process.  This function should 
    629 -- not be used under normal circumstances - no guarantees are given regarding 
    630 -- how cleanly the process is terminated.  To check whether the process 
    631 -- has indeed terminated, use 'getProcessExitCode'. 
    632 -- 
    633 -- On Unix systems, 'terminateProcess' sends the process the SIGTERM signal. 
    634 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing 
    635 -- an exit code of 1. 
    636 -- 
    637 -- Note: on Windows, if the process was a shell command created by 
    638 -- 'createProcess' with 'shell', or created by 'runCommand' or 
    639 -- 'runInteractiveCommand', then 'terminateProcess' will only 
    640 -- terminate the shell, not the command itself.  On Unix systems, both 
    641 -- processes are in a process group and will be terminated together. 
    642  
    643 terminateProcess :: ProcessHandle -> IO () 
    644 terminateProcess ph = do 
    645   withProcessHandle ph $ \p_ -> 
    646     case p_ of 
    647       ClosedHandle _ -> return () 
    648       OpenHandle h -> do 
    649         throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h 
    650         return () 
    651         -- does not close the handle, we might want to try terminating it 
    652         -- again, or get its exit code. 
    653  
    654  
    655 -- ---------------------------------------------------------------------------- 
    656 -- interruptProcessGroupOf 
    657  
    658 -- | Sends an interrupt signal to the process group of the given process. 
    659 -- 
    660 -- On Unix systems, it sends the group the SIGINT signal. 
    661 -- 
    662 -- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for 
    663 -- processes created using 'createProcess' and setting the 'create_group' flag 
    664  
    665 interruptProcessGroupOf 
    666     :: ProcessHandle    -- ^ A process in the process group 
    667     -> IO () 
    668 interruptProcessGroupOf ph = do 
    669     withProcessHandle ph $ \p_ -> do 
    670         case p_ of 
    671             ClosedHandle _ -> return () 
    672             OpenHandle h -> do 
    673 #if mingw32_HOST_OS 
    674                 pid <- getProcessId h 
    675                 generateConsoleCtrlEvent cTRL_BREAK_EVENT pid 
    676 -- We can't use an #elif here, because MIN_VERSION_unix isn't defined 
    677 -- on Windows, so on Windows cpp fails: 
    678 -- error: missing binary operator before token "(" 
    679 #else 
    680                 pgid <- getProcessGroupIDOf h 
    681                 signalProcessGroup sigINT pgid 
    682 #endif 
    683                 return () 
    684  
    685  
    686 -- ---------------------------------------------------------------------------- 
    687 -- Interface to C bits 
    688  
    689 foreign import ccall unsafe "terminateProcess" 
    690   c_terminateProcess 
    691         :: PHANDLE 
    692         -> IO CInt 
    693  
    694 foreign import ccall unsafe "getProcessExitCode" 
    695   c_getProcessExitCode 
    696         :: PHANDLE 
    697         -> Ptr CInt 
    698         -> IO CInt 
    699  
    700 foreign import ccall interruptible "waitForProcess" -- NB. safe - can block 
    701   c_waitForProcess 
    702         :: PHANDLE 
    703         -> Ptr CInt 
    704         -> IO CInt 
    705  
    706  
    707 -- ---------------------------------------------------------------------------- 
    708 -- Old deprecated variants 
    709 -- ---------------------------------------------------------------------------- 
    710  
    711 -- TODO: We're not going to mark these functions as DEPRECATED immediately in 
    712 -- process-1.2.0.0. That's because some of their replacements have not been 
    713 -- around for all that long. But they should eventually be marked with a 
    714 -- suitable DEPRECATED pragma after a release or two. 
    715  
    716  
    717 -- ---------------------------------------------------------------------------- 
    718 -- runCommand 
    719  
    720 --TODO: in a later release {-# DEPRECATED runCommand "Use 'spawnCommand' instead" #-} 
    721  
    722 {- | Runs a command using the shell. 
    723  -} 
    724 runCommand 
    725   :: String 
    726   -> IO ProcessHandle 
    727  
    728 runCommand string = do 
    729   (_,_,_,ph) <- createProcess_ "runCommand" (shell string) 
    730   return ph 
    731  
    732  
    733 -- ---------------------------------------------------------------------------- 
    734 -- runProcess 
    735  
    736 --TODO: in a later release {-# DEPRECATED runProcess "Use 'spawnProcess' or 'createProcess' instead" #-} 
    737  
    738 {- | Runs a raw command, optionally specifying 'Handle's from which to 
    739      take the @stdin@, @stdout@ and @stderr@ channels for the new 
    740      process (otherwise these handles are inherited from the current 
    741      process). 
    742  
    743      Any 'Handle's passed to 'runProcess' are placed immediately in the 
    744      closed state. 
    745  
    746      Note: consider using the more general 'createProcess' instead of 
    747      'runProcess'. 
    748 -} 
    749 runProcess 
    750   :: FilePath                   -- ^ Filename of the executable (see 'proc' for details) 
    751   -> [String]                   -- ^ Arguments to pass to the executable 
    752   -> Maybe FilePath             -- ^ Optional path to the working directory 
    753   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit) 
    754   -> Maybe Handle               -- ^ Handle to use for @stdin@ (Nothing => use existing @stdin@) 
    755   -> Maybe Handle               -- ^ Handle to use for @stdout@ (Nothing => use existing @stdout@) 
    756   -> Maybe Handle               -- ^ Handle to use for @stderr@ (Nothing => use existing @stderr@) 
    757   -> IO ProcessHandle 
    758  
    759 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do 
    760   (_,_,_,ph) <- 
    761       createProcess_ "runProcess" 
    762          (proc cmd args){ cwd = mb_cwd, 
    763                           env = mb_env, 
    764                           std_in  = mbToStd mb_stdin, 
    765                           std_out = mbToStd mb_stdout, 
    766                           std_err = mbToStd mb_stderr } 
    767   maybeClose mb_stdin 
    768   maybeClose mb_stdout 
    769   maybeClose mb_stderr 
    770   return ph 
    771  where 
    772   maybeClose :: Maybe Handle -> IO () 
    773   maybeClose (Just  hdl) 
    774     | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl 
    775   maybeClose _ = return () 
    776  
    777   mbToStd :: Maybe Handle -> StdStream 
    778   mbToStd Nothing    = Inherit 
    779   mbToStd (Just hdl) = UseHandle hdl 
    780  
    781  
    782 -- ---------------------------------------------------------------------------- 
    783 -- runInteractiveCommand 
    784  
    785 --TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-} 
    786  
    787 {- | Runs a command using the shell, and returns 'Handle's that may 
    788      be used to communicate with the process via its @stdin@, @stdout@, 
    789      and @stderr@ respectively. The 'Handle's are initially in binary 
    790      mode; if you need them to be in text mode then use 'hSetBinaryMode'. 
    791 -} 
    792 runInteractiveCommand 
    793   :: String 
    794   -> IO (Handle,Handle,Handle,ProcessHandle) 
    795  
    796 runInteractiveCommand string = 
    797   runInteractiveProcess1 "runInteractiveCommand" (shell string) 
    798  
    799  
    800 -- ---------------------------------------------------------------------------- 
    801 -- runInteractiveProcess 
    802  
    803 --TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-} 
    804  
    805 {- | Runs a raw command, and returns 'Handle's that may be used to communicate 
    806      with the process via its @stdin@, @stdout@ and @stderr@ respectively. 
    807  
    808     For example, to start a process and feed a string to its stdin: 
    809  
    810 >   (inp,out,err,pid) <- runInteractiveProcess "..." 
    811 >   forkIO (hPutStr inp str) 
    812  
    813     The 'Handle's are initially in binary mode; if you need them to be 
    814     in text mode then use 'hSetBinaryMode'. 
    815 -} 
    816 runInteractiveProcess 
    817   :: FilePath                   -- ^ Filename of the executable (see 'proc' for details) 
    818   -> [String]                   -- ^ Arguments to pass to the executable 
    819   -> Maybe FilePath             -- ^ Optional path to the working directory 
    820   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit) 
    821   -> IO (Handle,Handle,Handle,ProcessHandle) 
    822  
    823 runInteractiveProcess cmd args mb_cwd mb_env = do 
    824   runInteractiveProcess1 "runInteractiveProcess" 
    825         (proc cmd args){ cwd = mb_cwd, env = mb_env } 
    826  
    827 runInteractiveProcess1 
    828   :: String 
    829   -> CreateProcess 
    830   -> IO (Handle,Handle,Handle,ProcessHandle) 
    831 runInteractiveProcess1 fun cmd = do 
    832   (mb_in, mb_out, mb_err, p) <- 
    833       createProcess_ fun 
    834            cmd{ std_in  = CreatePipe, 
    835                 std_out = CreatePipe, 
    836                 std_err = CreatePipe } 
    837   return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p) 
    838  
    839  
    840 -- --------------------------------------------------------------------------- 
    841 -- system & rawSystem 
    842  
    843 --TODO: in a later release {-# DEPRECATED system "Use 'callCommand' (or 'spawnCommand' and 'waitForProcess') instead" #-} 
    844  
    845 {-| 
    846 Computation @system cmd@ returns the exit code produced when the 
    847 operating system runs the shell command @cmd@. 
    848  
    849 This computation may fail with one of the following 
    850 'System.IO.Error.IOErrorType' exceptions: 
    851  
    852 [@PermissionDenied@] 
    853 The process has insufficient privileges to perform the operation. 
    854  
    855 [@ResourceExhausted@] 
    856 Insufficient resources are available to perform the operation. 
    857  
    858 [@UnsupportedOperation@] 
    859 The implementation does not support system calls. 
    860  
    861 On Windows, 'system' passes the command to the Windows command 
    862 interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks 
    863 will not work. 
    864  
    865 On Unix systems, see 'waitForProcess' for the meaning of exit codes 
    866 when the process died as the result of a signal. 
    867 -} 
    868 #ifdef __GLASGOW_HASKELL__ 
    869 system :: String -> IO ExitCode 
    870 system "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command") 
    871 system str = do 
    872   (_,_,_,p) <- createProcess_ "system" (shell str) { delegate_ctlc = True } 
    873   waitForProcess p 
    874 #endif  /* __GLASGOW_HASKELL__ */ 
    875  
    876  
    877 --TODO: in a later release {-# DEPRECATED rawSystem "Use 'callProcess' (or 'spawnProcess' and 'waitForProcess') instead" #-} 
    878  
    879 {-| 
    880 The computation @'rawSystem' /cmd/ /args/@ runs the operating system command 
    881 @/cmd/@ in such a way that it receives as arguments the @/args/@ strings 
    882 exactly as given, with no funny escaping or shell meta-syntax expansion. 
    883 It will therefore behave more portably between operating systems than 'system'. 
    884  
    885 The return codes and possible failures are the same as for 'system'. 
    886 -} 
    887 rawSystem :: String -> [String] -> IO ExitCode 
    888 #ifdef __GLASGOW_HASKELL__ 
    889 rawSystem cmd args = do 
    890   (_,_,_,p) <- createProcess_ "rawSystem" (proc cmd args) { delegate_ctlc = True } 
    891   waitForProcess p 
    892 #elif !mingw32_HOST_OS 
    893 -- crude fallback implementation: could do much better than this under Unix 
    894 rawSystem cmd args = system (showCommandForUser cmd args) 
    895 #else 
    896 rawSystem cmd args = system (showCommandForUser cmd args) 
    897 #endif 
  • new file System/Process.hsc

    diff --git a/System/Process.hsc b/System/Process.hsc
    new file mode 100644
    index 0000000..8ed9600
    - +  
     1{-# LANGUAGE CPP, ForeignFunctionInterface #-} 
     2#ifdef __GLASGOW_HASKELL__ 
     3{-# LANGUAGE Trustworthy #-} 
     4{-# LANGUAGE InterruptibleFFI #-} 
     5#endif 
     6 
     7----------------------------------------------------------------------------- 
     8-- | 
     9-- Module      :  System.Process 
     10-- Copyright   :  (c) The University of Glasgow 2004-2008 
     11-- License     :  BSD-style (see the file libraries/base/LICENSE) 
     12-- 
     13-- Maintainer  :  [email protected] 
     14-- Stability   :  experimental 
     15-- Portability :  non-portable (requires concurrency) 
     16-- 
     17-- Operations for creating and interacting with sub-processes. 
     18-- 
     19----------------------------------------------------------------------------- 
     20 
     21-- ToDo: 
     22--      * Flag to control whether exiting the parent also kills the child. 
     23 
     24module System.Process ( 
     25    -- * Running sub-processes 
     26    createProcess, 
     27    shell, proc, 
     28    CreateProcess(..), 
     29    CmdSpec(..), 
     30    StdStream(..), 
     31    ProcessHandle, 
     32 
     33    -- ** Simpler functions for common tasks 
     34    callProcess, 
     35    callCommand, 
     36    spawnProcess, 
     37    spawnCommand, 
     38    readProcess, 
     39    readProcessWithExitCode, 
     40 
     41    -- ** Related utilities 
     42    showCommandForUser, 
     43 
     44    -- ** Control-C handling on Unix 
     45    -- $ctlc-handling 
     46 
     47    -- * Process completion 
     48    waitForProcess, 
     49    getProcessExitCode, 
     50    terminateProcess, 
     51    interruptProcessGroupOf, 
     52 
     53    -- Interprocess communication 
     54    createPipe, 
     55 
     56    -- * Old deprecated functions 
     57    -- | These functions pre-date 'createProcess' which is much more 
     58    -- flexible. 
     59    runProcess, 
     60    runCommand, 
     61    runInteractiveProcess, 
     62    runInteractiveCommand, 
     63    system, 
     64    rawSystem, 
     65    ) where 
     66 
     67import Prelude hiding (mapM) 
     68 
     69import System.Process.Internals 
     70 
     71import Control.Concurrent 
     72import Control.DeepSeq (rnf) 
     73import Control.Exception (SomeException, mask, try, throwIO) 
     74import qualified Control.Exception as C 
     75import Control.Monad 
     76import Data.Maybe 
     77import Foreign 
     78import Foreign.C 
     79import System.Exit      ( ExitCode(..) ) 
     80import System.IO 
     81import System.IO.Error (mkIOError, ioeSetErrorString) 
     82 
     83#if defined(mingw32_HOST_OS) 
     84# include <io.h>        /* for _close and _pipe */ 
     85# include <fcntl.h>     /* for _O_BINARY */ 
     86import Control.Exception (onException) 
     87import Foreign.C.Types (CInt(..), CUInt(..)) 
     88#else 
     89import System.Posix.Process (getProcessGroupIDOf) 
     90import qualified System.Posix.IO as Posix 
     91import System.Posix.Types 
     92#endif 
     93 
     94#ifdef __GLASGOW_HASKELL__ 
     95import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) ) 
     96# if defined(mingw32_HOST_OS) 
     97import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT) 
     98import System.Win32.Process (getProcessId) 
     99# else 
     100import System.Posix.Signals 
     101# endif 
     102#endif 
     103 
     104-- ---------------------------------------------------------------------------- 
     105-- createProcess 
     106 
     107-- | Construct a 'CreateProcess' record for passing to 'createProcess', 
     108-- representing a raw command with arguments. 
     109-- 
     110-- The 'FilePath' argument names the executable, and is interpreted according 
     111-- to the platform's standard policy for searching for 
     112-- executables. Specifically: 
     113-- 
     114-- * on Unix systems the 
     115--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/execvp.html execvp(3)> 
     116--   semantics is used, where if the executable filename does not 
     117--   contain a slash (@/@) then the @PATH@ environment variable is 
     118--   searched for the executable. 
     119-- 
     120-- * on Windows systems the Win32 @CreateProcess@ semantics is used. 
     121--   Briefly: if the filename does not contain a path, then the 
     122--   directory containing the parent executable is searched, followed 
     123--   by the current directory, then some standard locations, and 
     124--   finally the current @PATH@.  An @.exe@ extension is added if the 
     125--   filename does not already have an extension.  For full details 
     126--   see the 
     127--   <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365527%28v=vs.85%29.aspx documentation> 
     128--   for the Windows @SearchPath@ API. 
     129 
     130proc :: FilePath -> [String] -> CreateProcess 
     131proc cmd args = CreateProcess { cmdspec = RawCommand cmd args, 
     132                                cwd = Nothing, 
     133                                env = Nothing, 
     134                                std_in = Inherit, 
     135                                std_out = Inherit, 
     136                                std_err = Inherit, 
     137                                close_fds = False, 
     138                                create_group = False, 
     139                                delegate_ctlc = False} 
     140 
     141-- | Construct a 'CreateProcess' record for passing to 'createProcess', 
     142-- representing a command to be passed to the shell. 
     143shell :: String -> CreateProcess 
     144shell str = CreateProcess { cmdspec = ShellCommand str, 
     145                            cwd = Nothing, 
     146                            env = Nothing, 
     147                            std_in = Inherit, 
     148                            std_out = Inherit, 
     149                            std_err = Inherit, 
     150                            close_fds = False, 
     151                            create_group = False, 
     152                            delegate_ctlc = False} 
     153 
     154{- | 
     155This is the most general way to spawn an external process.  The 
     156process can be a command line to be executed by a shell or a raw command 
     157with a list of arguments.  The stdin, stdout, and stderr streams of 
     158the new process may individually be attached to new pipes, to existing 
     159'Handle's, or just inherited from the parent (the default.) 
     160 
     161The details of how to create the process are passed in the 
     162'CreateProcess' record.  To make it easier to construct a 
     163'CreateProcess', the functions 'proc' and 'shell' are supplied that 
     164fill in the fields with default values which can be overriden as 
     165needed. 
     166 
     167'createProcess' returns @(/mb_stdin_hdl/, /mb_stdout_hdl/, /mb_stderr_hdl/, /ph/)@, 
     168where 
     169 
     170 * if @'std_in' == 'CreatePipe'@, then @/mb_stdin_hdl/@ will be @Just /h/@, 
     171   where @/h/@ is the write end of the pipe connected to the child 
     172   process's @stdin@. 
     173 
     174 * otherwise, @/mb_stdin_hdl/ == Nothing@ 
     175 
     176Similarly for @/mb_stdout_hdl/@ and @/mb_stderr_hdl/@. 
     177 
     178For example, to execute a simple @ls@ command: 
     179 
     180>   r <- createProcess (proc "ls" []) 
     181 
     182To create a pipe from which to read the output of @ls@: 
     183 
     184>   (_, Just hout, _, _) <- 
     185>       createProcess (proc "ls" []){ std_out = CreatePipe } 
     186 
     187To also set the directory in which to run @ls@: 
     188 
     189>   (_, Just hout, _, _) <- 
     190>       createProcess (proc "ls" []){ cwd = Just "\home\bob", 
     191>                                     std_out = CreatePipe } 
     192 
     193-} 
     194createProcess 
     195  :: CreateProcess 
     196  -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) 
     197createProcess cp = do 
     198  r <- createProcess_ "createProcess" cp 
     199  maybeCloseStd (std_in  cp) 
     200  maybeCloseStd (std_out cp) 
     201  maybeCloseStd (std_err cp) 
     202  return r 
     203 where 
     204  maybeCloseStd :: StdStream -> IO () 
     205  maybeCloseStd (UseHandle hdl) 
     206    | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl 
     207  maybeCloseStd _ = return () 
     208 
     209{- 
     210-- TODO: decide if we want to expose this to users 
     211-- | A 'C.bracketOnError'-style resource handler for 'createProcess'. 
     212-- 
     213-- In normal operation it adds nothing, you are still responsible for waiting 
     214-- for (or forcing) process termination and closing any 'Handle's. It only does 
     215-- automatic cleanup if there is an exception. If there is an exception in the 
     216-- body then it ensures that the process gets terminated and any 'CreatePipe' 
     217-- 'Handle's are closed. In particular this means that if the Haskell thread 
     218-- is killed (e.g. 'killThread'), that the external process is also terminated. 
     219-- 
     220-- e.g. 
     221-- 
     222-- > withCreateProcess (proc cmd args) { ... }  $ \_ _ _ ph -> do 
     223-- >   ... 
     224-- 
     225withCreateProcess 
     226  :: CreateProcess 
     227  -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) 
     228  -> IO a 
     229withCreateProcess c action = 
     230    C.bracketOnError (createProcess c) cleanupProcess 
     231                     (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) 
     232-} 
     233 
     234-- wrapper so we can get exceptions with the appropriate function name. 
     235withCreateProcess_ 
     236  :: String 
     237  -> CreateProcess 
     238  -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) 
     239  -> IO a 
     240withCreateProcess_ fun c action = 
     241    C.bracketOnError (createProcess_ fun c) cleanupProcess 
     242                     (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph) 
     243 
     244 
     245cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) 
     246               -> IO () 
     247cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do 
     248    terminateProcess ph 
     249    -- Note, it's important that other threads that might be reading/writing 
     250    -- these handles also get killed off, since otherwise they might be holding 
     251    -- the handle lock and prevent us from closing, leading to deadlock. 
     252    maybe (return ()) (ignoreSigPipe . hClose) mb_stdin 
     253    maybe (return ()) hClose mb_stdout 
     254    maybe (return ()) hClose mb_stderr 
     255    -- terminateProcess does not guarantee that it terminates the process. 
     256    -- Indeed on Unix it's SIGTERM, which asks nicely but does not guarantee 
     257    -- that it stops. If it doesn't stop, we don't want to hang, so we wait 
     258    -- asynchronously using forkIO. 
     259    _ <- forkIO (waitForProcess ph >> return ()) 
     260    return () 
     261 
     262 
     263-- ---------------------------------------------------------------------------- 
     264-- spawnProcess/spawnCommand 
     265 
     266-- | Creates a new process to run the specified raw command with the given 
     267-- arguments. It does not wait for the program to finish, but returns the 
     268-- 'ProcessHandle'. 
     269-- 
     270-- /Since: 1.2.0.0/ 
     271spawnProcess :: FilePath -> [String] -> IO ProcessHandle 
     272spawnProcess cmd args = do 
     273    (_,_,_,p) <- createProcess_ "spawnProcess" (proc cmd args) 
     274    return p 
     275 
     276-- | Creates a new process to run the specified shell command. 
     277-- It does not wait for the program to finish, but returns the 'ProcessHandle'. 
     278-- 
     279-- /Since: 1.2.0.0/ 
     280spawnCommand :: String -> IO ProcessHandle 
     281spawnCommand cmd = do 
     282    (_,_,_,p) <- createProcess_ "spawnCommand" (shell cmd) 
     283    return p 
     284 
     285 
     286-- ---------------------------------------------------------------------------- 
     287-- callProcess/callCommand 
     288 
     289-- | Creates a new process to run the specified command with the given 
     290-- arguments, and wait for it to finish.  If the command returns a non-zero 
     291-- exit code, an exception is raised. 
     292-- 
     293-- If an asynchronous exception is thrown to the thread executing 
     294-- @callProcess@. The forked process will be terminated and 
     295-- @callProcess@ will wait (block) until the process has been 
     296-- terminated. 
     297-- 
     298-- /Since: 1.2.0.0/ 
     299callProcess :: FilePath -> [String] -> IO () 
     300callProcess cmd args = do 
     301    exit_code <- withCreateProcess_ "callCommand" 
     302                   (proc cmd args) { delegate_ctlc = True } $ \_ _ _ p -> 
     303                   waitForProcess p 
     304    case exit_code of 
     305      ExitSuccess   -> return () 
     306      ExitFailure r -> processFailedException "callProcess" cmd args r 
     307 
     308-- | Creates a new process to run the specified shell command.  If the 
     309-- command returns a non-zero exit code, an exception is raised. 
     310-- 
     311-- If an asynchronous exception is thrown to the thread executing 
     312-- @callCommand@. The forked process will be terminated and 
     313-- @callCommand@ will wait (block) until the process has been 
     314-- terminated. 
     315-- 
     316-- /Since: 1.2.0.0/ 
     317callCommand :: String -> IO () 
     318callCommand cmd = do 
     319    exit_code <- withCreateProcess_ "callCommand" 
     320                   (shell cmd) { delegate_ctlc = True } $ \_ _ _ p -> 
     321                   waitForProcess p 
     322    case exit_code of 
     323      ExitSuccess   -> return () 
     324      ExitFailure r -> processFailedException "callCommand" cmd [] r 
     325 
     326processFailedException :: String -> String -> [String] -> Int -> IO a 
     327processFailedException fun cmd args exit_code = 
     328      ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++ 
     329                                     concatMap ((' ':) . show) args ++ 
     330                                     " (exit " ++ show exit_code ++ ")") 
     331                                 Nothing Nothing) 
     332 
     333 
     334-- ---------------------------------------------------------------------------- 
     335-- Control-C handling on Unix 
     336 
     337-- $ctlc-handling 
     338-- 
     339-- When running an interactive console process (such as a shell, console-based 
     340-- text editor or ghci), we typically want that process to be allowed to handle 
     341-- Ctl-C keyboard interrupts how it sees fit. For example, while most programs 
     342-- simply quit on a Ctl-C, some handle it specially. To allow this to happen, 
     343-- use the @'delegate_ctlc' = True@ option in the 'CreateProcess' options. 
     344-- 
     345-- The gory details: 
     346-- 
     347-- By default Ctl-C will generate a @SIGINT@ signal, causing a 'UserInterrupt' 
     348-- exception to be sent to the main Haskell thread of your program, which if 
     349-- not specially handled will terminate the program. Normally, this is exactly 
     350-- what is wanted: an orderly shutdown of the program in response to Ctl-C. 
     351-- 
     352-- Of course when running another interactive program in the console then we 
     353-- want to let that program handle Ctl-C. Under Unix however, Ctl-C sends 
     354-- @SIGINT@ to every process using the console. The standard solution is that 
     355-- while running an interactive program, ignore @SIGINT@ in the parent, and let 
     356-- it be handled in the child process. If that process then terminates due to 
     357-- the @SIGINT@ signal, then at that point treat it as if we had recieved the 
     358-- @SIGINT@ ourselves and begin an orderly shutdown. 
     359-- 
     360-- This behaviour is implemented by 'createProcess' (and 
     361-- 'waitForProcess' \/ 'getProcessExitCode') when the @'delegate_ctlc' = True@ 
     362-- option is set. In particular, the @SIGINT@ signal will be ignored until 
     363-- 'waitForProcess' returns (or 'getProcessExitCode' returns a non-Nothing 
     364-- result), so it becomes especially important to use 'waitForProcess' for every 
     365-- processes created. 
     366-- 
     367-- In addition, in 'delegate_ctlc' mode, 'waitForProcess' and 
     368-- 'getProcessExitCode' will throw a 'UserInterrupt' exception if the process 
     369-- terminated with @'ExitFailure' (-SIGINT)@. Typically you will not want to 
     370-- catch this exception, but let it propagate, giving a normal orderly shutdown. 
     371-- One detail to be aware of is that the 'UserInterrupt' exception is thrown 
     372-- /synchronously/ in the thread that calls 'waitForProcess', whereas normally 
     373-- @SIGINT@ causes the exception to be thrown /asynchronously/ to the main 
     374-- thread. 
     375-- 
     376-- For even more detail on this topic, see 
     377-- <http://www.cons.org/cracauer/sigint.html "Proper handling of SIGINT/SIGQUIT">. 
     378 
     379-- ----------------------------------------------------------------------------- 
     380 
     381-- | @readProcess@ forks an external process, reads its standard output 
     382-- strictly, blocking until the process terminates, and returns the output 
     383-- string. 
     384-- 
     385-- If an asynchronous exception is thrown to the thread executing 
     386-- @readProcess@. The forked process will be terminated and @readProcess@ will 
     387-- wait (block) until the process has been terminated. 
     388-- 
     389-- Output is returned strictly, so this is not suitable for 
     390-- interactive applications. 
     391-- 
     392-- This function throws an 'IOError' if the process 'ExitCode' is 
     393-- anything other than 'ExitSuccess'. 
     394-- 
     395-- Users of this function should compile with @-threaded@ if they 
     396-- want other Haskell threads to keep running while waiting on 
     397-- the result of readProcess. 
     398-- 
     399-- >  > readProcess "date" [] [] 
     400-- >  "Thu Feb  7 10:03:39 PST 2008\n" 
     401-- 
     402-- The arguments are: 
     403-- 
     404-- * The command to run, which must be in the $PATH, or an absolute path 
     405-- 
     406-- * A list of separate command line arguments to the program 
     407-- 
     408-- * A string to pass on the standard input to the program. 
     409-- 
     410readProcess 
     411    :: FilePath                 -- ^ Filename of the executable (see 'proc' for details) 
     412    -> [String]                 -- ^ any arguments 
     413    -> String                   -- ^ standard input 
     414    -> IO String                -- ^ stdout 
     415readProcess cmd args input = do 
     416    let cp_opts = (proc cmd args) { 
     417                    std_in  = CreatePipe, 
     418                    std_out = CreatePipe, 
     419                    std_err = Inherit 
     420                  } 
     421    (ex, output) <- withCreateProcess_ "readProcess" cp_opts $ 
     422      \(Just inh) (Just outh) _ ph -> do 
     423 
     424        -- fork off a thread to start consuming the output 
     425        output  <- hGetContents outh 
     426        withForkWait (C.evaluate $ rnf output) $ \waitOut -> do 
     427 
     428          -- now write any input 
     429          unless (null input) $ 
     430            ignoreSigPipe $ hPutStr inh input 
     431          -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE 
     432          ignoreSigPipe $ hClose inh 
     433 
     434          -- wait on the output 
     435          waitOut 
     436          hClose outh 
     437 
     438        -- wait on the process 
     439        ex <- waitForProcess ph 
     440        return (ex, output) 
     441 
     442    case ex of 
     443     ExitSuccess   -> return output 
     444     ExitFailure r -> processFailedException "readProcess" cmd args r 
     445 
     446{- | 
     447@readProcessWithExitCode@ creates an external process, reads its 
     448standard output and standard error strictly, waits until the process 
     449terminates, and then returns the 'ExitCode' of the process, 
     450the standard output, and the standard error. 
     451 
     452If an asynchronous exception is thrown to the thread executing 
     453@readProcessWithExitCode@. The forked process will be terminated and 
     454@readProcessWithExitCode@ will wait (block) until the process has been 
     455terminated. 
     456 
     457'readProcess' and 'readProcessWithExitCode' are fairly simple wrappers 
     458around 'createProcess'.  Constructing variants of these functions is 
     459quite easy: follow the link to the source code to see how 
     460'readProcess' is implemented. 
     461 
     462On Unix systems, see 'waitForProcess' for the meaning of exit codes 
     463when the process died as the result of a signal. 
     464-} 
     465 
     466readProcessWithExitCode 
     467    :: FilePath                 -- ^ Filename of the executable (see 'proc' for details) 
     468    -> [String]                 -- ^ any arguments 
     469    -> String                   -- ^ standard input 
     470    -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr 
     471readProcessWithExitCode cmd args input = do 
     472    let cp_opts = (proc cmd args) { 
     473                    std_in  = CreatePipe, 
     474                    std_out = CreatePipe, 
     475                    std_err = CreatePipe 
     476                  } 
     477    withCreateProcess_ "readProcessWithExitCode" cp_opts $ 
     478      \(Just inh) (Just outh) (Just errh) ph -> do 
     479 
     480        out <- hGetContents outh 
     481        err <- hGetContents errh 
     482 
     483        -- fork off threads to start consuming stdout & stderr 
     484        withForkWait  (C.evaluate $ rnf out) $ \waitOut -> 
     485         withForkWait (C.evaluate $ rnf err) $ \waitErr -> do 
     486 
     487          -- now write any input 
     488          unless (null input) $ 
     489            ignoreSigPipe $ hPutStr inh input 
     490          -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE 
     491          ignoreSigPipe $ hClose inh 
     492 
     493          -- wait on the output 
     494          waitOut 
     495          waitErr 
     496 
     497          hClose outh 
     498          hClose errh 
     499 
     500        -- wait on the process 
     501        ex <- waitForProcess ph 
     502 
     503        return (ex, out, err) 
     504 
     505-- | Fork a thread while doing something else, but kill it if there's an 
     506-- exception. 
     507-- 
     508-- This is important in the cases above because we want to kill the thread 
     509-- that is holding the Handle lock, because when we clean up the process we 
     510-- try to close that handle, which could otherwise deadlock. 
     511-- 
     512withForkWait :: IO () -> (IO () ->  IO a) -> IO a 
     513withForkWait async body = do 
     514  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ())) 
     515  mask $ \restore -> do 
     516    tid <- forkIO $ try (restore async) >>= putMVar waitVar 
     517    let wait = takeMVar waitVar >>= either throwIO return 
     518    restore (body wait) `C.onException` killThread tid 
     519 
     520ignoreSigPipe :: IO () -> IO () 
     521#if defined(__GLASGOW_HASKELL__) 
     522ignoreSigPipe = C.handle $ \e -> case e of 
     523                                   IOError { ioe_type  = ResourceVanished 
     524                                           , ioe_errno = Just ioe } 
     525                                     | Errno ioe == ePIPE -> return () 
     526                                   _ -> throwIO e 
     527#else 
     528ignoreSigPipe = id 
     529#endif 
     530 
     531-- ---------------------------------------------------------------------------- 
     532-- showCommandForUser 
     533 
     534-- | Given a program @/p/@ and arguments @/args/@, 
     535--   @showCommandForUser /p/ /args/@ returns a string suitable for pasting 
     536--   into @\/bin\/sh@ (on Unix systems) or @CMD.EXE@ (on Windows). 
     537showCommandForUser :: FilePath -> [String] -> String 
     538showCommandForUser cmd args = unwords (map translate (cmd : args)) 
     539 
     540 
     541-- ---------------------------------------------------------------------------- 
     542-- waitForProcess 
     543 
     544{- | Waits for the specified process to terminate, and returns its exit code. 
     545 
     546GHC Note: in order to call @waitForProcess@ without blocking all the 
     547other threads in the system, you must compile the program with 
     548@-threaded@. 
     549 
     550(/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@ 
     551indicates that the child was terminated by signal @/signum/@. 
     552The signal numbers are platform-specific, so to test for a specific signal use 
     553the constants provided by "System.Posix.Signals" in the @unix@ package. 
     554Note: core dumps are not reported, use "System.Posix.Process" if you need this 
     555detail. 
     556 
     557-} 
     558waitForProcess 
     559  :: ProcessHandle 
     560  -> IO ExitCode 
     561waitForProcess ph@(ProcessHandle _ delegating_ctlc) = do 
     562  p_ <- modifyProcessHandle ph $ \p_ -> return (p_,p_) 
     563  case p_ of 
     564    ClosedHandle e -> return e 
     565    OpenHandle h  -> do 
     566        -- don't hold the MVar while we call c_waitForProcess... 
     567        -- (XXX but there's a small race window here during which another 
     568        -- thread could close the handle or call waitForProcess) 
     569        e <- alloca $ \pret -> do 
     570          throwErrnoIfMinus1Retry_ "waitForProcess" (c_waitForProcess h pret) 
     571          modifyProcessHandle ph $ \p_' -> 
     572            case p_' of 
     573              ClosedHandle e -> return (p_',e) 
     574              OpenHandle ph' -> do 
     575                closePHANDLE ph' 
     576                code <- peek pret 
     577                let e = if (code == 0) 
     578                       then ExitSuccess 
     579                       else (ExitFailure (fromIntegral code)) 
     580                return (ClosedHandle e, e) 
     581        when delegating_ctlc $ 
     582          endDelegateControlC e 
     583        return e 
     584 
     585 
     586-- ---------------------------------------------------------------------------- 
     587-- getProcessExitCode 
     588 
     589{- | 
     590This is a non-blocking version of 'waitForProcess'.  If the process is 
     591still running, 'Nothing' is returned.  If the process has exited, then 
     592@'Just' e@ is returned where @e@ is the exit code of the process. 
     593 
     594On Unix systems, see 'waitForProcess' for the meaning of exit codes 
     595when the process died as the result of a signal. 
     596-} 
     597 
     598getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) 
     599getProcessExitCode ph@(ProcessHandle _ delegating_ctlc) = do 
     600  (m_e, was_open) <- modifyProcessHandle ph $ \p_ -> 
     601    case p_ of 
     602      ClosedHandle e -> return (p_, (Just e, False)) 
     603      OpenHandle h -> 
     604        alloca $ \pExitCode -> do 
     605            res <- throwErrnoIfMinus1Retry "getProcessExitCode" $ 
     606                        c_getProcessExitCode h pExitCode 
     607            code <- peek pExitCode 
     608            if res == 0 
     609              then return (p_, (Nothing, False)) 
     610              else do 
     611                   closePHANDLE h 
     612                   let e  | code == 0 = ExitSuccess 
     613                          | otherwise = ExitFailure (fromIntegral code) 
     614                   return (ClosedHandle e, (Just e, True)) 
     615  case m_e of 
     616    Just e | was_open && delegating_ctlc -> endDelegateControlC e 
     617    _                                    -> return () 
     618  return m_e 
     619 
     620 
     621-- ---------------------------------------------------------------------------- 
     622-- terminateProcess 
     623 
     624-- | Attempts to terminate the specified process.  This function should 
     625-- not be used under normal circumstances - no guarantees are given regarding 
     626-- how cleanly the process is terminated.  To check whether the process 
     627-- has indeed terminated, use 'getProcessExitCode'. 
     628-- 
     629-- On Unix systems, 'terminateProcess' sends the process the SIGTERM signal. 
     630-- On Windows systems, the Win32 @TerminateProcess@ function is called, passing 
     631-- an exit code of 1. 
     632-- 
     633-- Note: on Windows, if the process was a shell command created by 
     634-- 'createProcess' with 'shell', or created by 'runCommand' or 
     635-- 'runInteractiveCommand', then 'terminateProcess' will only 
     636-- terminate the shell, not the command itself.  On Unix systems, both 
     637-- processes are in a process group and will be terminated together. 
     638 
     639terminateProcess :: ProcessHandle -> IO () 
     640terminateProcess ph = do 
     641  withProcessHandle ph $ \p_ -> 
     642    case p_ of 
     643      ClosedHandle _ -> return () 
     644      OpenHandle h -> do 
     645        throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h 
     646        return () 
     647        -- does not close the handle, we might want to try terminating it 
     648        -- again, or get its exit code. 
     649 
     650 
     651-- ---------------------------------------------------------------------------- 
     652-- interruptProcessGroupOf 
     653 
     654-- | Sends an interrupt signal to the process group of the given process. 
     655-- 
     656-- On Unix systems, it sends the group the SIGINT signal. 
     657-- 
     658-- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for 
     659-- processes created using 'createProcess' and setting the 'create_group' flag 
     660 
     661interruptProcessGroupOf 
     662    :: ProcessHandle    -- ^ A process in the process group 
     663    -> IO () 
     664interruptProcessGroupOf ph = do 
     665    withProcessHandle ph $ \p_ -> do 
     666        case p_ of 
     667            ClosedHandle _ -> return () 
     668            OpenHandle h -> do 
     669#if mingw32_HOST_OS 
     670                pid <- getProcessId h 
     671                generateConsoleCtrlEvent cTRL_BREAK_EVENT pid 
     672-- We can't use an #elif here, because MIN_VERSION_unix isn't defined 
     673-- on Windows, so on Windows cpp fails: 
     674-- error: missing binary operator before token "(" 
     675#else 
     676                pgid <- getProcessGroupIDOf h 
     677                signalProcessGroup sigINT pgid 
     678#endif 
     679                return () 
     680 
     681 
     682-- ---------------------------------------------------------------------------- 
     683-- Interface to C bits 
     684 
     685foreign import ccall unsafe "terminateProcess" 
     686  c_terminateProcess 
     687        :: PHANDLE 
     688        -> IO CInt 
     689 
     690foreign import ccall unsafe "getProcessExitCode" 
     691  c_getProcessExitCode 
     692        :: PHANDLE 
     693        -> Ptr CInt 
     694        -> IO CInt 
     695 
     696foreign import ccall interruptible "waitForProcess" -- NB. safe - can block 
     697  c_waitForProcess 
     698        :: PHANDLE 
     699        -> Ptr CInt 
     700        -> IO CInt 
     701 
     702 
     703-- ---------------------------------------------------------------------------- 
     704-- Old deprecated variants 
     705-- ---------------------------------------------------------------------------- 
     706 
     707-- TODO: We're not going to mark these functions as DEPRECATED immediately in 
     708-- process-1.2.0.0. That's because some of their replacements have not been 
     709-- around for all that long. But they should eventually be marked with a 
     710-- suitable DEPRECATED pragma after a release or two. 
     711 
     712 
     713-- ---------------------------------------------------------------------------- 
     714-- runCommand 
     715 
     716--TODO: in a later release {-# DEPRECATED runCommand "Use 'spawnCommand' instead" #-} 
     717 
     718{- | Runs a command using the shell. 
     719 -} 
     720runCommand 
     721  :: String 
     722  -> IO ProcessHandle 
     723 
     724runCommand string = do 
     725  (_,_,_,ph) <- createProcess_ "runCommand" (shell string) 
     726  return ph 
     727 
     728 
     729-- ---------------------------------------------------------------------------- 
     730-- runProcess 
     731 
     732--TODO: in a later release {-# DEPRECATED runProcess "Use 'spawnProcess' or 'createProcess' instead" #-} 
     733 
     734{- | Runs a raw command, optionally specifying 'Handle's from which to 
     735     take the @stdin@, @stdout@ and @stderr@ channels for the new 
     736     process (otherwise these handles are inherited from the current 
     737     process). 
     738 
     739     Any 'Handle's passed to 'runProcess' are placed immediately in the 
     740     closed state. 
     741 
     742     Note: consider using the more general 'createProcess' instead of 
     743     'runProcess'. 
     744-} 
     745runProcess 
     746  :: FilePath                   -- ^ Filename of the executable (see 'proc' for details) 
     747  -> [String]                   -- ^ Arguments to pass to the executable 
     748  -> Maybe FilePath             -- ^ Optional path to the working directory 
     749  -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit) 
     750  -> Maybe Handle               -- ^ Handle to use for @stdin@ (Nothing => use existing @stdin@) 
     751  -> Maybe Handle               -- ^ Handle to use for @stdout@ (Nothing => use existing @stdout@) 
     752  -> Maybe Handle               -- ^ Handle to use for @stderr@ (Nothing => use existing @stderr@) 
     753  -> IO ProcessHandle 
     754 
     755runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do 
     756  (_,_,_,ph) <- 
     757      createProcess_ "runProcess" 
     758         (proc cmd args){ cwd = mb_cwd, 
     759                          env = mb_env, 
     760                          std_in  = mbToStd mb_stdin, 
     761                          std_out = mbToStd mb_stdout, 
     762                          std_err = mbToStd mb_stderr } 
     763  maybeClose mb_stdin 
     764  maybeClose mb_stdout 
     765  maybeClose mb_stderr 
     766  return ph 
     767 where 
     768  maybeClose :: Maybe Handle -> IO () 
     769  maybeClose (Just  hdl) 
     770    | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl 
     771  maybeClose _ = return () 
     772 
     773  mbToStd :: Maybe Handle -> StdStream 
     774  mbToStd Nothing    = Inherit 
     775  mbToStd (Just hdl) = UseHandle hdl 
     776 
     777 
     778-- ---------------------------------------------------------------------------- 
     779-- runInteractiveCommand 
     780 
     781--TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-} 
     782 
     783{- | Runs a command using the shell, and returns 'Handle's that may 
     784     be used to communicate with the process via its @stdin@, @stdout@, 
     785     and @stderr@ respectively. The 'Handle's are initially in binary 
     786     mode; if you need them to be in text mode then use 'hSetBinaryMode'. 
     787-} 
     788runInteractiveCommand 
     789  :: String 
     790  -> IO (Handle,Handle,Handle,ProcessHandle) 
     791 
     792runInteractiveCommand string = 
     793  runInteractiveProcess1 "runInteractiveCommand" (shell string) 
     794 
     795 
     796-- ---------------------------------------------------------------------------- 
     797-- runInteractiveProcess 
     798 
     799--TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-} 
     800 
     801{- | Runs a raw command, and returns 'Handle's that may be used to communicate 
     802     with the process via its @stdin@, @stdout@ and @stderr@ respectively. 
     803 
     804    For example, to start a process and feed a string to its stdin: 
     805 
     806>   (inp,out,err,pid) <- runInteractiveProcess "..." 
     807>   forkIO (hPutStr inp str) 
     808 
     809    The 'Handle's are initially in binary mode; if you need them to be 
     810    in text mode then use 'hSetBinaryMode'. 
     811-} 
     812runInteractiveProcess 
     813  :: FilePath                   -- ^ Filename of the executable (see 'proc' for details) 
     814  -> [String]                   -- ^ Arguments to pass to the executable 
     815  -> Maybe FilePath             -- ^ Optional path to the working directory 
     816  -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit) 
     817  -> IO (Handle,Handle,Handle,ProcessHandle) 
     818 
     819runInteractiveProcess cmd args mb_cwd mb_env = do 
     820  runInteractiveProcess1 "runInteractiveProcess" 
     821        (proc cmd args){ cwd = mb_cwd, env = mb_env } 
     822 
     823runInteractiveProcess1 
     824  :: String 
     825  -> CreateProcess 
     826  -> IO (Handle,Handle,Handle,ProcessHandle) 
     827runInteractiveProcess1 fun cmd = do 
     828  (mb_in, mb_out, mb_err, p) <- 
     829      createProcess_ fun 
     830           cmd{ std_in  = CreatePipe, 
     831                std_out = CreatePipe, 
     832                std_err = CreatePipe } 
     833  return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p) 
     834 
     835 
     836-- --------------------------------------------------------------------------- 
     837-- system & rawSystem 
     838 
     839--TODO: in a later release {-# DEPRECATED system "Use 'callCommand' (or 'spawnCommand' and 'waitForProcess') instead" #-} 
     840 
     841{-| 
     842Computation @system cmd@ returns the exit code produced when the 
     843operating system runs the shell command @cmd@. 
     844 
     845This computation may fail with one of the following 
     846'System.IO.Error.IOErrorType' exceptions: 
     847 
     848[@PermissionDenied@] 
     849The process has insufficient privileges to perform the operation. 
     850 
     851[@ResourceExhausted@] 
     852Insufficient resources are available to perform the operation. 
     853 
     854[@UnsupportedOperation@] 
     855The implementation does not support system calls. 
     856 
     857On Windows, 'system' passes the command to the Windows command 
     858interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks 
     859will not work. 
     860 
     861On Unix systems, see 'waitForProcess' for the meaning of exit codes 
     862when the process died as the result of a signal. 
     863-} 
     864#ifdef __GLASGOW_HASKELL__ 
     865system :: String -> IO ExitCode 
     866system "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command") 
     867system str = do 
     868  (_,_,_,p) <- createProcess_ "system" (shell str) { delegate_ctlc = True } 
     869  waitForProcess p 
     870#endif  /* __GLASGOW_HASKELL__ */ 
     871 
     872 
     873--TODO: in a later release {-# DEPRECATED rawSystem "Use 'callProcess' (or 'spawnProcess' and 'waitForProcess') instead" #-} 
     874 
     875{-| 
     876The computation @'rawSystem' /cmd/ /args/@ runs the operating system command 
     877@/cmd/@ in such a way that it receives as arguments the @/args/@ strings 
     878exactly as given, with no funny escaping or shell meta-syntax expansion. 
     879It will therefore behave more portably between operating systems than 'system'. 
     880 
     881The return codes and possible failures are the same as for 'system'. 
     882-} 
     883rawSystem :: String -> [String] -> IO ExitCode 
     884#ifdef __GLASGOW_HASKELL__ 
     885rawSystem cmd args = do 
     886  (_,_,_,p) <- createProcess_ "rawSystem" (proc cmd args) { delegate_ctlc = True } 
     887  waitForProcess p 
     888#elif !mingw32_HOST_OS 
     889-- crude fallback implementation: could do much better than this under Unix 
     890rawSystem cmd args = system (showCommandForUser cmd args) 
     891#else 
     892rawSystem cmd args = system (showCommandForUser cmd args) 
     893#endif 
     894 
     895-- --------------------------------------------------------------------------- 
     896-- createPipe 
     897 
     898-- | Create a pipe for interprocess communication and return a 
     899-- @(readEnd, writeEnd)@ `Handle` pair. 
     900createPipe :: IO (Handle, Handle) 
     901#if !mingw32_HOST_OS 
     902createPipe = do 
     903    (readfd, writefd) <- Posix.createPipe 
     904    readh <- Posix.fdToHandle readfd 
     905    writeh <- Posix.fdToHandle writefd 
     906    return (readh, writeh) 
     907#else 
     908createPipe = do 
     909    (readfd, writefd) <- allocaArray 2 $ \ pfds -> do 
     910        throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY) 
     911        readfd <- peek pfds 
     912        writefd <- peekElemOff pfds 1 
     913        return (readfd, writefd) 
     914    (do readh <- fdToHandle readfd 
     915        writeh <- fdToHandle writefd 
     916        return (readh, writeh)) `onException` (close readfd >> close writefd) 
     917 
     918close :: CInt -> IO () 
     919close = throwErrnoIfMinus1_ "_close" . c__close 
     920 
     921foreign import ccall "io.h _pipe" c__pipe :: 
     922    Ptr CInt -> CUInt -> CInt -> IO CInt 
     923 
     924foreign import ccall "io.h _close" c__close :: 
     925    CInt -> IO CInt 
     926#endif