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