1{-# LANGUAGE CPP, ForeignFunctionInterface #-}
2#if __GLASGOW_HASKELL__ >= 709
3{-# LANGUAGE Safe #-}
4#else
5{-# LANGUAGE Trustworthy #-}
6#endif
7{-# LANGUAGE InterruptibleFFI #-}
8
9-----------------------------------------------------------------------------
10-- |
11-- Module      :  System.Process
12-- Copyright   :  (c) The University of Glasgow 2004-2008
13-- License     :  BSD-style (see the file libraries/base/LICENSE)
14--
15-- Maintainer  :  libraries@haskell.org
16-- Stability   :  experimental
17-- Portability :  non-portable (requires concurrency)
18--
19-- Operations for creating and interacting with sub-processes.
20--
21-----------------------------------------------------------------------------
22
23-- ToDo:
24--      * Flag to control whether exiting the parent also kills the child.
25
26module System.Process (
27    -- * Running sub-processes
28    createProcess,
29    createProcess_,
30    shell, proc,
31    CreateProcess(..),
32    CmdSpec(..),
33    StdStream(..),
34    ProcessHandle,
35
36    -- ** Simpler functions for common tasks
37    callProcess,
38    callCommand,
39    spawnProcess,
40    spawnCommand,
41    readCreateProcess,
42    readProcess,
43    readCreateProcessWithExitCode,
44    readProcessWithExitCode,
45    withCreateProcess,
46    cleanupProcess,
47
48    -- ** Related utilities
49    showCommandForUser,
50    Pid,
51    getPid,
52    getCurrentPid,
53
54    -- ** Control-C handling on Unix
55    -- $ctlc-handling
56
57    -- * Process completion
58    -- ** Notes about @exec@ on Windows
59    -- $exec-on-windows
60    waitForProcess,
61    getProcessExitCode,
62    terminateProcess,
63    interruptProcessGroupOf,
64
65    -- * Interprocess communication
66    createPipe,
67    createPipeFd,
68
69    -- * Old deprecated functions
70    -- | These functions pre-date 'createProcess' which is much more
71    -- flexible.
72    runProcess,
73    runCommand,
74    runInteractiveProcess,
75    runInteractiveCommand,
76    system,
77    rawSystem,
78    ) where
79
80import Prelude hiding (mapM)
81
82import System.Process.Internals
83
84import Control.Concurrent
85import Control.DeepSeq (rnf)
86import Control.Exception (SomeException, mask, allowInterrupt, bracket, try, throwIO)
87import qualified Control.Exception as C
88import Control.Monad
89import Data.Maybe
90import Foreign
91import Foreign.C
92import System.Exit      ( ExitCode(..) )
93import System.IO
94import System.IO.Error (mkIOError, ioeSetErrorString)
95
96#if defined(WINDOWS)
97import System.Win32.Process (getProcessId, getCurrentProcessId, ProcessId)
98#else
99import System.Posix.Process (getProcessID)
100import System.Posix.Types (CPid (..))
101#endif
102
103import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) )
104
105-- | The platform specific type for a process identifier.
106--
107-- This is always an integral type. Width and signedness are platform specific.
108--
109-- @since 1.6.3.0
110#if defined(WINDOWS)
111type Pid = ProcessId
112#else
113type Pid = CPid
114#endif
115
116-- ----------------------------------------------------------------------------
117-- createProcess
118
119-- | Construct a 'CreateProcess' record for passing to 'createProcess',
120-- representing a raw command with arguments.
121--
122-- See 'RawCommand' for precise semantics of the specified @FilePath@.
123proc :: FilePath -> [String] -> CreateProcess
124proc cmd args = CreateProcess { cmdspec = RawCommand cmd args,
125                                cwd = Nothing,
126                                env = Nothing,
127                                std_in = Inherit,
128                                std_out = Inherit,
129                                std_err = Inherit,
130                                close_fds = False,
131                                create_group = False,
132                                delegate_ctlc = False,
133                                detach_console = False,
134                                create_new_console = False,
135                                new_session = False,
136                                child_group = Nothing,
137                                child_user = Nothing,
138                                use_process_jobs = False }
139
140-- | Construct a 'CreateProcess' record for passing to 'createProcess',
141-- representing a command to be passed to the shell.
142shell :: String -> CreateProcess
143shell str = CreateProcess { cmdspec = ShellCommand str,
144                            cwd = Nothing,
145                            env = Nothing,
146                            std_in = Inherit,
147                            std_out = Inherit,
148                            std_err = Inherit,
149                            close_fds = False,
150                            create_group = False,
151                            delegate_ctlc = False,
152                            detach_console = False,
153                            create_new_console = False,
154                            new_session = False,
155                            child_group = Nothing,
156                            child_user = Nothing,
157                            use_process_jobs = False }
158
159{- |
160This is the most general way to spawn an external process.  The
161process can be a command line to be executed by a shell or a raw command
162with a list of arguments.  The stdin, stdout, and stderr streams of
163the new process may individually be attached to new pipes, to existing
164'Handle's, or just inherited from the parent (the default.)
165
166The details of how to create the process are passed in the
167'CreateProcess' record.  To make it easier to construct a
168'CreateProcess', the functions 'proc' and 'shell' are supplied that
169fill in the fields with default values which can be overriden as
170needed.
171
172'createProcess' returns @(/mb_stdin_hdl/, /mb_stdout_hdl/, /mb_stderr_hdl/, /ph/)@,
173where
174
175 * if @'std_in' == 'CreatePipe'@, then @/mb_stdin_hdl/@ will be @Just /h/@,
176   where @/h/@ is the write end of the pipe connected to the child
177   process's @stdin@.
178
179 * otherwise, @/mb_stdin_hdl/ == Nothing@
180
181Similarly for @/mb_stdout_hdl/@ and @/mb_stderr_hdl/@.
182
183For example, to execute a simple @ls@ command:
184
185>   r <- createProcess (proc "ls" [])
186
187To create a pipe from which to read the output of @ls@:
188
189>   (_, Just hout, _, _) <-
190>       createProcess (proc "ls" []){ std_out = CreatePipe }
191
192To also set the directory in which to run @ls@:
193
194>   (_, Just hout, _, _) <-
195>       createProcess (proc "ls" []){ cwd = Just "/home/bob",
196>                                     std_out = CreatePipe }
197
198Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the
199@UseHandle@ constructor will be closed by calling this function. This is not
200always the desired behavior. In cases where you would like to leave the
201@Handle@ open after spawning the child process, please use 'createProcess_'
202instead. All created @Handle@s are initially in text mode; if you need them
203to be in binary mode then use 'hSetBinaryMode'.
204
205@/ph/@ contains a handle to the running process.  On Windows
206'use_process_jobs' can be set in CreateProcess in order to create a
207Win32 Job object to monitor a process tree's progress.  If it is set
208then that job is also returned inside @/ph/@.  @/ph/@ can be used to
209kill all running sub-processes.  This feature has been available since
2101.5.0.0.
211
212-}
213createProcess
214  :: CreateProcess
215  -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
216createProcess cp = do
217  r <- createProcess_ "createProcess" cp
218  maybeCloseStd (std_in  cp)
219  maybeCloseStd (std_out cp)
220  maybeCloseStd (std_err cp)
221  return r
222 where
223  maybeCloseStd :: StdStream -> IO ()
224  maybeCloseStd (UseHandle hdl)
225    | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl
226  maybeCloseStd _ = return ()
227
228-- | A 'C.bracket'-style resource handler for 'createProcess'.
229--
230-- Does automatic cleanup when the action finishes. If there is an exception
231-- in the body then it ensures that the process gets terminated and any
232-- 'CreatePipe' 'Handle's are closed. In particular this means that if the
233-- Haskell thread is killed (e.g. 'killThread'), that the external process is
234-- also terminated.
235--
236-- e.g.
237--
238-- > withCreateProcess (proc cmd args) { ... }  $ \stdin stdout stderr ph -> do
239-- >   ...
240--
241-- @since 1.4.3.0
242withCreateProcess
243  :: CreateProcess
244  -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
245  -> IO a
246withCreateProcess c action =
247    C.bracket (createProcess c) cleanupProcess
248              (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
249
250-- wrapper so we can get exceptions with the appropriate function name.
251withCreateProcess_
252  :: String
253  -> CreateProcess
254  -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
255  -> IO a
256withCreateProcess_ fun c action =
257    C.bracketOnError (createProcess_ fun c) cleanupProcess
258                     (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
259
260-- | Cleans up the process.
261--
262-- This function is meant to be invoked from any application level cleanup
263-- handler. It terminates the process, and closes any 'CreatePipe' 'handle's.
264--
265-- @since 1.6.4.0
266cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
267               -> IO ()
268cleanupProcess (mb_stdin, mb_stdout, mb_stderr,
269                ph@(ProcessHandle _ delegating_ctlc _)) = do
270    terminateProcess ph
271    -- Note, it's important that other threads that might be reading/writing
272    -- these handles also get killed off, since otherwise they might be holding
273    -- the handle lock and prevent us from closing, leading to deadlock.
274    maybe (return ()) (ignoreSigPipe . hClose) mb_stdin
275    maybe (return ()) hClose mb_stdout
276    maybe (return ()) hClose mb_stderr
277    -- terminateProcess does not guarantee that it terminates the process.
278    -- Indeed on Unix it's SIGTERM, which asks nicely but does not guarantee
279    -- that it stops. If it doesn't stop, we don't want to hang, so we wait
280    -- asynchronously using forkIO.
281
282    -- However we want to end the Ctl-C handling synchronously, so we'll do
283    -- that synchronously, and set delegating_ctlc as False for the
284    -- waitForProcess (which would otherwise end the Ctl-C delegation itself).
285    when delegating_ctlc
286      stopDelegateControlC
287    _ <- forkIO (waitForProcess (resetCtlcDelegation ph) >> return ())
288    return ()
289  where
290    resetCtlcDelegation (ProcessHandle m _ l) = ProcessHandle m False l
291
292-- ----------------------------------------------------------------------------
293-- spawnProcess/spawnCommand
294
295-- | Creates a new process to run the specified raw command with the given
296-- arguments. It does not wait for the program to finish, but returns the
297-- 'ProcessHandle'.
298--
299-- @since 1.2.0.0
300spawnProcess :: FilePath -> [String] -> IO ProcessHandle
301spawnProcess cmd args = do
302    (_,_,_,p) <- createProcess_ "spawnProcess" (proc cmd args)
303    return p
304
305-- | Creates a new process to run the specified shell command.
306-- It does not wait for the program to finish, but returns the 'ProcessHandle'.
307--
308-- @since 1.2.0.0
309spawnCommand :: String -> IO ProcessHandle
310spawnCommand cmd = do
311    (_,_,_,p) <- createProcess_ "spawnCommand" (shell cmd)
312    return p
313
314
315-- ----------------------------------------------------------------------------
316-- callProcess/callCommand
317
318-- | Creates a new process to run the specified command with the given
319-- arguments, and wait for it to finish.  If the command returns a non-zero
320-- exit code, an exception is raised.
321--
322-- If an asynchronous exception is thrown to the thread executing
323-- @callProcess@, the forked process will be terminated and
324-- @callProcess@ will wait (block) until the process has been
325-- terminated.
326--
327-- @since 1.2.0.0
328callProcess :: FilePath -> [String] -> IO ()
329callProcess cmd args = do
330    exit_code <- withCreateProcess_ "callProcess"
331                   (proc cmd args) { delegate_ctlc = True } $ \_ _ _ p ->
332                   waitForProcess p
333    case exit_code of
334      ExitSuccess   -> return ()
335      ExitFailure r -> processFailedException "callProcess" cmd args r
336
337-- | Creates a new process to run the specified shell command.  If the
338-- command returns a non-zero exit code, an exception is raised.
339--
340-- If an asynchronous exception is thrown to the thread executing
341-- @callCommand@, the forked process will be terminated and
342-- @callCommand@ will wait (block) until the process has been
343-- terminated.
344--
345-- @since 1.2.0.0
346callCommand :: String -> IO ()
347callCommand cmd = do
348    exit_code <- withCreateProcess_ "callCommand"
349                   (shell cmd) { delegate_ctlc = True } $ \_ _ _ p ->
350                   waitForProcess p
351    case exit_code of
352      ExitSuccess   -> return ()
353      ExitFailure r -> processFailedException "callCommand" cmd [] r
354
355processFailedException :: String -> String -> [String] -> Int -> IO a
356processFailedException fun cmd args exit_code =
357      ioError (mkIOError OtherError (fun ++ ": " ++ cmd ++
358                                     concatMap ((' ':) . show) args ++
359                                     " (exit " ++ show exit_code ++ ")")
360                                 Nothing Nothing)
361
362
363-- ----------------------------------------------------------------------------
364-- Control-C handling on Unix
365
366-- $ctlc-handling
367--
368-- When running an interactive console process (such as a shell, console-based
369-- text editor or ghci), we typically want that process to be allowed to handle
370-- Ctl-C keyboard interrupts how it sees fit. For example, while most programs
371-- simply quit on a Ctl-C, some handle it specially. To allow this to happen,
372-- use the @'delegate_ctlc' = True@ option in the 'CreateProcess' options.
373--
374-- The gory details:
375--
376-- By default Ctl-C will generate a @SIGINT@ signal, causing a 'UserInterrupt'
377-- exception to be sent to the main Haskell thread of your program, which if
378-- not specially handled will terminate the program. Normally, this is exactly
379-- what is wanted: an orderly shutdown of the program in response to Ctl-C.
380--
381-- Of course when running another interactive program in the console then we
382-- want to let that program handle Ctl-C. Under Unix however, Ctl-C sends
383-- @SIGINT@ to every process using the console. The standard solution is that
384-- while running an interactive program, ignore @SIGINT@ in the parent, and let
385-- it be handled in the child process. If that process then terminates due to
386-- the @SIGINT@ signal, then at that point treat it as if we had recieved the
387-- @SIGINT@ ourselves and begin an orderly shutdown.
388--
389-- This behaviour is implemented by 'createProcess' (and
390-- 'waitForProcess' \/ 'getProcessExitCode') when the @'delegate_ctlc' = True@
391-- option is set. In particular, the @SIGINT@ signal will be ignored until
392-- 'waitForProcess' returns (or 'getProcessExitCode' returns a non-Nothing
393-- result), so it becomes especially important to use 'waitForProcess' for every
394-- processes created.
395--
396-- In addition, in 'delegate_ctlc' mode, 'waitForProcess' and
397-- 'getProcessExitCode' will throw a 'UserInterrupt' exception if the process
398-- terminated with @'ExitFailure' (-SIGINT)@. Typically you will not want to
399-- catch this exception, but let it propagate, giving a normal orderly shutdown.
400-- One detail to be aware of is that the 'UserInterrupt' exception is thrown
401-- /synchronously/ in the thread that calls 'waitForProcess', whereas normally
402-- @SIGINT@ causes the exception to be thrown /asynchronously/ to the main
403-- thread.
404--
405-- For even more detail on this topic, see
406-- <http://www.cons.org/cracauer/sigint.html "Proper handling of SIGINT/SIGQUIT">.
407
408-- $exec-on-windows
409--
410-- Note that processes which use the POSIX @exec@ system call (e.g. @gcc@)
411-- require special care on Windows. Specifically, the @msvcrt@ C runtime used
412-- frequently on Windows emulates @exec@ in a non-POSIX compliant manner, where
413-- the caller will be terminated (with exit code 0) and execution will continue
414-- in a new process. As a result, on Windows it will appear as though a child
415-- process which has called @exec@ has terminated despite the fact that the
416-- process would still be running on a POSIX-compliant platform.
417--
418-- Since many programs do use @exec@, the @process@ library exposes the
419-- 'use_process_jobs' flag to make it possible to reliably detect when such a
420-- process completes. When this flag is set a 'ProcessHandle' will not be
421-- deemed to be \"finished\" until all processes spawned by it have
422-- terminated (except those spawned by the child with the
423-- @CREATE_BREAKAWAY_FROM_JOB@ @CreateProcess@ flag).
424--
425-- Note, however, that, because of platform limitations, the exit code returned
426-- by @waitForProcess@ and @getProcessExitCode@ cannot not be relied upon when
427-- the child uses @exec@, even when 'use_process_jobs' is used. Specifically,
428-- these functions will return the exit code of the *original child* (which
429-- always exits with code 0, since it called @exec@), not the exit code of the
430-- process which carried on with execution after @exec@. This is different from
431-- the behavior prescribed by POSIX but is the best approximation that can be
432-- realised under the restrictions of the Windows process model.
433
434-- -----------------------------------------------------------------------------
435
436-- | @readProcess@ forks an external process, reads its standard output
437-- strictly, blocking until the process terminates, and returns the output
438-- string. The external process inherits the standard error.
439--
440-- If an asynchronous exception is thrown to the thread executing
441-- @readProcess@, the forked process will be terminated and @readProcess@ will
442-- wait (block) until the process has been terminated.
443--
444-- Output is returned strictly, so this is not suitable for launching processes
445-- that require interaction over the standard file streams.
446--
447-- This function throws an 'IOError' if the process 'ExitCode' is
448-- anything other than 'ExitSuccess'. If instead you want to get the
449-- 'ExitCode' then use 'readProcessWithExitCode'.
450--
451-- Users of this function should compile with @-threaded@ if they
452-- want other Haskell threads to keep running while waiting on
453-- the result of readProcess.
454--
455-- >  > readProcess "date" [] []
456-- >  "Thu Feb  7 10:03:39 PST 2008\n"
457--
458-- The arguments are:
459--
460-- * The command to run, which must be in the $PATH, or an absolute or relative path
461--
462-- * A list of separate command line arguments to the program
463--
464-- * A string to pass on standard input to the forked process.
465--
466readProcess
467    :: FilePath                 -- ^ Filename of the executable (see 'RawCommand' for details)
468    -> [String]                 -- ^ any arguments
469    -> String                   -- ^ standard input
470    -> IO String                -- ^ stdout
471readProcess cmd args = readCreateProcess $ proc cmd args
472
473-- | @readCreateProcess@ works exactly like 'readProcess' except that it
474-- lets you pass 'CreateProcess' giving better flexibility.
475--
476-- >  > readCreateProcess ((shell "pwd") { cwd = Just "/etc/" }) ""
477-- >  "/etc\n"
478--
479-- Note that @Handle@s provided for @std_in@ or @std_out@ via the CreateProcess
480-- record will be ignored.
481--
482-- @since 1.2.3.0
483
484readCreateProcess
485    :: CreateProcess
486    -> String                   -- ^ standard input
487    -> IO String                -- ^ stdout
488readCreateProcess cp input = do
489    let cp_opts = cp {
490                    std_in  = CreatePipe,
491                    std_out = CreatePipe
492                  }
493    (ex, output) <- withCreateProcess_ "readCreateProcess" cp_opts $
494      \mb_inh mb_outh _ ph ->
495        case (mb_inh, mb_outh) of
496          (Just inh, Just outh) -> do
497
498            -- fork off a thread to start consuming the output
499            output  <- hGetContents outh
500            withForkWait (C.evaluate $ rnf output) $ \waitOut -> do
501
502              -- now write any input
503              unless (null input) $
504                ignoreSigPipe $ hPutStr inh input
505              -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
506              ignoreSigPipe $ hClose inh
507
508              -- wait on the output
509              waitOut
510              hClose outh
511
512            -- wait on the process
513            ex <- waitForProcess ph
514            return (ex, output)
515
516          (Nothing,_) -> error "readCreateProcess: Failed to get a stdin handle."
517          (_,Nothing) -> error "readCreateProcess: Failed to get a stdout handle."
518
519    case ex of
520     ExitSuccess   -> return output
521     ExitFailure r -> processFailedException "readCreateProcess" cmd args r
522  where
523    cmd = case cp of
524            CreateProcess { cmdspec = ShellCommand sc } -> sc
525            CreateProcess { cmdspec = RawCommand fp _ } -> fp
526    args = case cp of
527             CreateProcess { cmdspec = ShellCommand _ } -> []
528             CreateProcess { cmdspec = RawCommand _ args' } -> args'
529
530
531-- | @readProcessWithExitCode@ is like 'readProcess' but with two differences:
532--
533--  * it returns the 'ExitCode' of the process, and does not throw any
534--    exception if the code is not 'ExitSuccess'.
535--
536--  * it reads and returns the output from process' standard error handle,
537--    rather than the process inheriting the standard error handle.
538--
539-- On Unix systems, see 'waitForProcess' for the meaning of exit codes
540-- when the process died as the result of a signal.
541--
542readProcessWithExitCode
543    :: FilePath                 -- ^ Filename of the executable (see 'RawCommand' for details)
544    -> [String]                 -- ^ any arguments
545    -> String                   -- ^ standard input
546    -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
547readProcessWithExitCode cmd args =
548    readCreateProcessWithExitCode $ proc cmd args
549
550-- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it
551-- lets you pass 'CreateProcess' giving better flexibility.
552--
553-- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess
554-- record will be ignored.
555--
556-- @since 1.2.3.0
557readCreateProcessWithExitCode
558    :: CreateProcess
559    -> String                      -- ^ standard input
560    -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
561readCreateProcessWithExitCode cp input = do
562    let cp_opts = cp {
563                    std_in  = CreatePipe,
564                    std_out = CreatePipe,
565                    std_err = CreatePipe
566                  }
567    withCreateProcess_ "readCreateProcessWithExitCode" cp_opts $
568      \mb_inh mb_outh mb_errh ph ->
569        case (mb_inh, mb_outh, mb_errh) of
570          (Just inh, Just outh, Just errh) -> do
571
572            out <- hGetContents outh
573            err <- hGetContents errh
574
575            -- fork off threads to start consuming stdout & stderr
576            withForkWait  (C.evaluate $ rnf out) $ \waitOut ->
577             withForkWait (C.evaluate $ rnf err) $ \waitErr -> do
578
579              -- now write any input
580              unless (null input) $
581                ignoreSigPipe $ hPutStr inh input
582              -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
583              ignoreSigPipe $ hClose inh
584
585              -- wait on the output
586              waitOut
587              waitErr
588
589              hClose outh
590              hClose errh
591
592            -- wait on the process
593            ex <- waitForProcess ph
594            return (ex, out, err)
595
596          (Nothing,_,_) -> error "readCreateProcessWithExitCode: Failed to get a stdin handle."
597          (_,Nothing,_) -> error "readCreateProcessWithExitCode: Failed to get a stdout handle."
598          (_,_,Nothing) -> error "readCreateProcessWithExitCode: Failed to get a stderr handle."
599
600-- | Fork a thread while doing something else, but kill it if there's an
601-- exception.
602--
603-- This is important in the cases above because we want to kill the thread
604-- that is holding the Handle lock, because when we clean up the process we
605-- try to close that handle, which could otherwise deadlock.
606--
607withForkWait :: IO () -> (IO () ->  IO a) -> IO a
608withForkWait async body = do
609  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
610  mask $ \restore -> do
611    tid <- forkIO $ try (restore async) >>= putMVar waitVar
612    let wait = takeMVar waitVar >>= either throwIO return
613    restore (body wait) `C.onException` killThread tid
614
615ignoreSigPipe :: IO () -> IO ()
616ignoreSigPipe = C.handle $ \e -> case e of
617                                   IOError { ioe_type  = ResourceVanished
618                                           , ioe_errno = Just ioe }
619                                     | Errno ioe == ePIPE -> return ()
620                                   _ -> throwIO e
621
622-- ----------------------------------------------------------------------------
623-- showCommandForUser
624
625-- | Given a program @/p/@ and arguments @/args/@,
626--   @showCommandForUser /p/ /args/@ returns a string suitable for pasting
627--   into @\/bin\/sh@ (on Unix systems) or @CMD.EXE@ (on Windows).
628showCommandForUser :: FilePath -> [String] -> String
629showCommandForUser cmd args = unwords (map translate (cmd : args))
630
631
632-- ----------------------------------------------------------------------------
633-- getPid
634
635-- | Returns the PID (process ID) of a subprocess.
636--
637-- 'Nothing' is returned if the handle was already closed. Otherwise a
638-- PID is returned that remains valid as long as the handle is open.
639-- The operating system may reuse the PID as soon as the last handle to
640-- the process is closed.
641--
642-- @since 1.6.3.0
643getPid :: ProcessHandle -> IO (Maybe Pid)
644getPid (ProcessHandle mh _ _) = do
645  p_ <- readMVar mh
646  case p_ of
647#ifdef WINDOWS
648    OpenHandle h -> do
649      pid <- getProcessId h
650      return $ Just pid
651#else
652    OpenHandle pid -> return $ Just pid
653#endif
654    _ -> return Nothing
655
656
657-- ----------------------------------------------------------------------------
658-- getCurrentPid
659
660-- | Returns the PID (process ID) of the current process. On POSIX systems,
661-- this calls 'getProcessID' from "System.Posix.Process" in the @unix@ package.
662-- On Windows, this calls 'getCurrentProcessId' from "System.Win32.Process" in
663-- the @Win32@ package.
664--
665-- @since 1.6.12.0
666getCurrentPid :: IO Pid
667getCurrentPid =
668#ifdef WINDOWS
669    getCurrentProcessId
670#else
671    getProcessID
672#endif
673
674
675-- ----------------------------------------------------------------------------
676-- waitForProcess
677
678{- | Waits for the specified process to terminate, and returns its exit code.
679
680GHC Note: in order to call @waitForProcess@ without blocking all the
681other threads in the system, you must compile the program with
682@-threaded@.
683
684Note that it is safe to call @waitForProcess@ for the same process in multiple
685threads. When the process ends, threads blocking on this call will wake in
686FIFO order.
687
688(/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@
689indicates that the child was terminated by signal @/signum/@.
690The signal numbers are platform-specific, so to test for a specific signal use
691the constants provided by "System.Posix.Signals" in the @unix@ package.
692Note: core dumps are not reported, use "System.Posix.Process" if you need this
693detail.
694
695-}
696waitForProcess
697  :: ProcessHandle
698  -> IO ExitCode
699waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do
700  p_ <- modifyProcessHandle ph $ \p_ -> return (p_,p_)
701  case p_ of
702    ClosedHandle e -> return e
703    OpenHandle h  -> do
704        -- don't hold the MVar while we call c_waitForProcess...
705        e <- waitForProcess' h
706        e' <- modifyProcessHandle ph $ \p_' ->
707          case p_' of
708            ClosedHandle e' -> return (p_', e')
709            OpenExtHandle{} -> fail "waitForProcess(OpenExtHandle): this cannot happen"
710            OpenHandle ph'  -> do
711              closePHANDLE ph'
712              when delegating_ctlc $
713                endDelegateControlC e
714              return (ClosedHandle e, e)
715        return e'
716#if defined(WINDOWS)
717    OpenExtHandle h job -> do
718        -- First wait for completion of the job...
719        waitForJobCompletion job
720        e <- waitForProcess' h
721        e' <- modifyProcessHandle ph $ \p_' ->
722          case p_' of
723            ClosedHandle e' -> return (p_', e')
724            OpenHandle{}    -> fail "waitForProcess(OpenHandle): this cannot happen"
725            OpenExtHandle ph' job' -> do
726              closePHANDLE ph'
727              closePHANDLE job'
728              when delegating_ctlc $
729                endDelegateControlC e
730              return (ClosedHandle e, e)
731        return e'
732#else
733    OpenExtHandle _ _job ->
734        return $ ExitFailure (-1)
735#endif
736  where
737    -- If more than one thread calls `waitpid` at a time, `waitpid` will
738    -- return the exit code to one of them and (-1) to the rest of them,
739    -- causing an exception to be thrown.
740    -- Cf. https://github.com/haskell/process/issues/46, and
741    -- https://github.com/haskell/process/pull/58 for further discussion
742    lockWaitpid m = withMVar (waitpidLock ph) $ \() -> m
743
744    waitForProcess' :: PHANDLE -> IO ExitCode
745    waitForProcess' h = alloca $ \pret -> do
746      throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret)
747      mkExitCode <$> peek pret
748
749    mkExitCode :: CInt -> ExitCode
750    mkExitCode code
751      | code == 0 = ExitSuccess
752      | otherwise = ExitFailure (fromIntegral code)
753
754
755-- ----------------------------------------------------------------------------
756-- getProcessExitCode
757
758{- |
759This is a non-blocking version of 'waitForProcess'.  If the process is
760still running, 'Nothing' is returned.  If the process has exited, then
761@'Just' e@ is returned where @e@ is the exit code of the process.
762
763On Unix systems, see 'waitForProcess' for the meaning of exit codes
764when the process died as the result of a signal.
765-}
766
767getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
768getProcessExitCode ph@(ProcessHandle _ delegating_ctlc _) = tryLockWaitpid $ do
769  (m_e, was_open) <- modifyProcessHandle ph $ \p_ ->
770    case p_ of
771      ClosedHandle e -> return (p_, (Just e, False))
772      open -> do
773        alloca $ \pExitCode -> do
774          case getHandle open of
775            Nothing -> return (p_, (Nothing, False))
776            Just h  -> do
777                res <- throwErrnoIfMinus1Retry "getProcessExitCode" $
778                                        c_getProcessExitCode h pExitCode
779                code <- peek pExitCode
780                if res == 0
781                   then return (p_, (Nothing, False))
782                   else do
783                        closePHANDLE h
784                        let e  | code == 0 = ExitSuccess
785                               | otherwise = ExitFailure (fromIntegral code)
786                        return (ClosedHandle e, (Just e, True))
787  case m_e of
788    Just e | was_open && delegating_ctlc -> endDelegateControlC e
789    _                                    -> return ()
790  return m_e
791    where getHandle :: ProcessHandle__ -> Maybe PHANDLE
792          getHandle (OpenHandle        h) = Just h
793          getHandle (ClosedHandle      _) = Nothing
794          getHandle (OpenExtHandle   h _) = Just h
795
796          -- If somebody is currently holding the waitpid lock, we don't want to
797          -- accidentally remove the pid from the process table.
798          -- Try acquiring the waitpid lock. If it is held, we are done
799          -- since that means the process is still running and we can return
800          -- `Nothing`. If it is not held, acquire it so we can run the
801          -- (non-blocking) call to `waitpid` without worrying about any
802          -- other threads calling it at the same time.
803          tryLockWaitpid :: IO (Maybe ExitCode) -> IO (Maybe ExitCode)
804          tryLockWaitpid action = bracket acquire release between
805            where
806              acquire   = tryTakeMVar (waitpidLock ph)
807              release m = case m of
808                Nothing -> return ()
809                Just () -> putMVar (waitpidLock ph) ()
810              between m = case m of
811                Nothing -> return Nothing
812                Just () -> action
813
814-- ----------------------------------------------------------------------------
815-- terminateProcess
816
817-- | Attempts to terminate the specified process.  This function should
818-- not be used under normal circumstances - no guarantees are given regarding
819-- how cleanly the process is terminated.  To check whether the process
820-- has indeed terminated, use 'getProcessExitCode'.
821--
822-- On Unix systems, 'terminateProcess' sends the process the SIGTERM signal.
823-- On Windows systems, if `use_process_jobs` is `True` then the Win32 @TerminateJobObject@
824-- function is called to kill all processes associated with the job and passing the
825-- exit code of 1 to each of them. Otherwise if `use_process_jobs` is `False` then the
826-- Win32 @TerminateProcess@ function is called, passing an exit code of 1.
827--
828-- Note: on Windows, if the process was a shell command created by
829-- 'createProcess' with 'shell', or created by 'runCommand' or
830-- 'runInteractiveCommand', then 'terminateProcess' will only
831-- terminate the shell, not the command itself.  On Unix systems, both
832-- processes are in a process group and will be terminated together.
833
834terminateProcess :: ProcessHandle -> IO ()
835terminateProcess ph = do
836  withProcessHandle ph $ \p_ ->
837    case p_ of
838      ClosedHandle  _ -> return ()
839#if defined(WINDOWS)
840      OpenExtHandle{} -> terminateJobUnsafe p_ 1 >> return ()
841#else
842      OpenExtHandle{} -> error "terminateProcess with OpenExtHandle should not happen on POSIX."
843#endif
844      OpenHandle    h -> do
845        throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h
846        return ()
847        -- does not close the handle, we might want to try terminating it
848        -- again, or get its exit code.
849
850
851-- ----------------------------------------------------------------------------
852-- Interface to C bits
853
854foreign import ccall unsafe "terminateProcess"
855  c_terminateProcess
856        :: PHANDLE
857        -> IO CInt
858
859foreign import ccall unsafe "getProcessExitCode"
860  c_getProcessExitCode
861        :: PHANDLE
862        -> Ptr CInt
863        -> IO CInt
864
865foreign import ccall interruptible "waitForProcess" -- NB. safe - can block
866  c_waitForProcess
867        :: PHANDLE
868        -> Ptr CInt
869        -> IO CInt
870
871
872-- ----------------------------------------------------------------------------
873-- Old deprecated variants
874-- ----------------------------------------------------------------------------
875
876-- TODO: We're not going to mark these functions as DEPRECATED immediately in
877-- process-1.2.0.0. That's because some of their replacements have not been
878-- around for all that long. But they should eventually be marked with a
879-- suitable DEPRECATED pragma after a release or two.
880
881
882-- ----------------------------------------------------------------------------
883-- runCommand
884
885--TODO: in a later release {-# DEPRECATED runCommand "Use 'spawnCommand' instead" #-}
886
887{- | Runs a command using the shell.
888 -}
889runCommand
890  :: String
891  -> IO ProcessHandle
892
893runCommand string = do
894  (_,_,_,ph) <- createProcess_ "runCommand" (shell string)
895  return ph
896
897
898-- ----------------------------------------------------------------------------
899-- runProcess
900
901--TODO: in a later release {-# DEPRECATED runProcess "Use 'spawnProcess' or 'createProcess' instead" #-}
902
903{- | Runs a raw command, optionally specifying 'Handle's from which to
904     take the @stdin@, @stdout@ and @stderr@ channels for the new
905     process (otherwise these handles are inherited from the current
906     process).
907
908     Any 'Handle's passed to 'runProcess' are placed immediately in the
909     closed state.
910
911     Note: consider using the more general 'createProcess' instead of
912     'runProcess'.
913-}
914runProcess
915  :: FilePath                   -- ^ Filename of the executable (see 'RawCommand' for details)
916  -> [String]                   -- ^ Arguments to pass to the executable
917  -> Maybe FilePath             -- ^ Optional path to the working directory
918  -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
919  -> Maybe Handle               -- ^ Handle to use for @stdin@ (Nothing => use existing @stdin@)
920  -> Maybe Handle               -- ^ Handle to use for @stdout@ (Nothing => use existing @stdout@)
921  -> Maybe Handle               -- ^ Handle to use for @stderr@ (Nothing => use existing @stderr@)
922  -> IO ProcessHandle
923
924runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
925  (_,_,_,ph) <-
926      createProcess_ "runProcess"
927         (proc cmd args){ cwd = mb_cwd,
928                          env = mb_env,
929                          std_in  = mbToStd mb_stdin,
930                          std_out = mbToStd mb_stdout,
931                          std_err = mbToStd mb_stderr }
932  maybeClose mb_stdin
933  maybeClose mb_stdout
934  maybeClose mb_stderr
935  return ph
936 where
937  maybeClose :: Maybe Handle -> IO ()
938  maybeClose (Just  hdl)
939    | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl
940  maybeClose _ = return ()
941
942  mbToStd :: Maybe Handle -> StdStream
943  mbToStd Nothing    = Inherit
944  mbToStd (Just hdl) = UseHandle hdl
945
946
947-- ----------------------------------------------------------------------------
948-- runInteractiveCommand
949
950--TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-}
951
952{- | Runs a command using the shell, and returns 'Handle's that may
953     be used to communicate with the process via its @stdin@, @stdout@,
954     and @stderr@ respectively.
955-}
956runInteractiveCommand
957  :: String
958  -> IO (Handle,Handle,Handle,ProcessHandle)
959
960runInteractiveCommand string =
961  runInteractiveProcess1 "runInteractiveCommand" (shell string)
962
963
964-- ----------------------------------------------------------------------------
965-- runInteractiveProcess
966
967--TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-}
968
969{- | Runs a raw command, and returns 'Handle's that may be used to communicate
970     with the process via its @stdin@, @stdout@ and @stderr@ respectively.
971
972    For example, to start a process and feed a string to its stdin:
973
974>   (inp,out,err,pid) <- runInteractiveProcess "..."
975>   forkIO (hPutStr inp str)
976-}
977runInteractiveProcess
978  :: FilePath                   -- ^ Filename of the executable (see 'RawCommand' for details)
979  -> [String]                   -- ^ Arguments to pass to the executable
980  -> Maybe FilePath             -- ^ Optional path to the working directory
981  -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
982  -> IO (Handle,Handle,Handle,ProcessHandle)
983
984runInteractiveProcess cmd args mb_cwd mb_env = do
985  runInteractiveProcess1 "runInteractiveProcess"
986        (proc cmd args){ cwd = mb_cwd, env = mb_env }
987
988runInteractiveProcess1
989  :: String
990  -> CreateProcess
991  -> IO (Handle,Handle,Handle,ProcessHandle)
992runInteractiveProcess1 fun cmd = do
993  (mb_in, mb_out, mb_err, p) <-
994      createProcess_ fun
995           cmd{ std_in  = CreatePipe,
996                std_out = CreatePipe,
997                std_err = CreatePipe }
998  return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p)
999
1000
1001-- ---------------------------------------------------------------------------
1002-- system & rawSystem
1003
1004--TODO: in a later release {-# DEPRECATED system "Use 'callCommand' (or 'spawnCommand' and 'waitForProcess') instead" #-}
1005
1006{-|
1007Computation @system cmd@ returns the exit code produced when the
1008operating system runs the shell command @cmd@.
1009
1010This computation may fail with one of the following
1011'System.IO.Error.IOErrorType' exceptions:
1012
1013[@PermissionDenied@]
1014The process has insufficient privileges to perform the operation.
1015
1016[@ResourceExhausted@]
1017Insufficient resources are available to perform the operation.
1018
1019[@UnsupportedOperation@]
1020The implementation does not support system calls.
1021
1022On Windows, 'system' passes the command to the Windows command
1023interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks
1024will not work.
1025
1026On Unix systems, see 'waitForProcess' for the meaning of exit codes
1027when the process died as the result of a signal.
1028-}
1029system :: String -> IO ExitCode
1030system "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command")
1031system str = do
1032  (_,_,_,p) <- createProcess_ "system" (shell str) { delegate_ctlc = True }
1033  waitForProcess p
1034
1035
1036--TODO: in a later release {-# DEPRECATED rawSystem "Use 'callProcess' (or 'spawnProcess' and 'waitForProcess') instead" #-}
1037
1038{-|
1039The computation @'rawSystem' /cmd/ /args/@ runs the operating system command
1040@/cmd/@ in such a way that it receives as arguments the @/args/@ strings
1041exactly as given, with no funny escaping or shell meta-syntax expansion.
1042It will therefore behave more portably between operating systems than 'system'.
1043
1044The return codes and possible failures are the same as for 'system'.
1045-}
1046rawSystem :: String -> [String] -> IO ExitCode
1047rawSystem cmd args = do
1048  (_,_,_,p) <- createProcess_ "rawSystem" (proc cmd args) { delegate_ctlc = True }
1049  waitForProcess p
1050