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

File 0001-Add-createPipe.2.patch, 68.9 KB (added by refold, 16 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