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