Fix a -Wincomplete-uni-patterns warning
[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 \mb_inh mb_outh _ ph ->
458 case (mb_inh, mb_outh) of
459 (Just inh, Just outh) -> do
460
461 -- fork off a thread to start consuming the output
462 output <- hGetContents outh
463 withForkWait (C.evaluate $ rnf output) $ \waitOut -> do
464
465 -- now write any input
466 unless (null input) $
467 ignoreSigPipe $ hPutStr inh input
468 -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
469 ignoreSigPipe $ hClose inh
470
471 -- wait on the output
472 waitOut
473 hClose outh
474
475 -- wait on the process
476 ex <- waitForProcess ph
477 return (ex, output)
478
479 (Nothing,_) -> error "readCreateProcess: Failed to get a stdin handle."
480 (_,Nothing) -> error "readCreateProcess: Failed to get a stdout handle."
481
482 case ex of
483 ExitSuccess -> return output
484 ExitFailure r -> processFailedException "readCreateProcess" cmd args r
485 where
486 cmd = case cp of
487 CreateProcess { cmdspec = ShellCommand sc } -> sc
488 CreateProcess { cmdspec = RawCommand fp _ } -> fp
489 args = case cp of
490 CreateProcess { cmdspec = ShellCommand _ } -> []
491 CreateProcess { cmdspec = RawCommand _ args' } -> args'
492
493
494 -- | @readProcessWithExitCode@ is like @readProcess@ but with two differences:
495 --
496 -- * it returns the 'ExitCode' of the process, and does not throw any
497 -- exception if the code is not 'ExitSuccess'.
498 --
499 -- * it reads and returns the output from process' standard error handle,
500 -- rather than the process inheriting the standard error handle.
501 --
502 -- On Unix systems, see 'waitForProcess' for the meaning of exit codes
503 -- when the process died as the result of a signal.
504 --
505 readProcessWithExitCode
506 :: FilePath -- ^ Filename of the executable (see 'RawCommand' for details)
507 -> [String] -- ^ any arguments
508 -> String -- ^ standard input
509 -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
510 readProcessWithExitCode cmd args =
511 readCreateProcessWithExitCode $ proc cmd args
512
513 -- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it
514 -- lets you pass 'CreateProcess' giving better flexibility.
515 --
516 -- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess
517 -- record will be ignored.
518 --
519 -- @since 1.2.3.0
520 readCreateProcessWithExitCode
521 :: CreateProcess
522 -> String -- ^ standard input
523 -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
524 readCreateProcessWithExitCode cp input = do
525 let cp_opts = cp {
526 std_in = CreatePipe,
527 std_out = CreatePipe,
528 std_err = CreatePipe
529 }
530 withCreateProcess_ "readCreateProcessWithExitCode" cp_opts $
531 \mb_inh mb_outh mb_errh ph ->
532 case (mb_inh, mb_outh, mb_errh) of
533 (Just inh, Just outh, Just errh) -> do
534
535 out <- hGetContents outh
536 err <- hGetContents errh
537
538 -- fork off threads to start consuming stdout & stderr
539 withForkWait (C.evaluate $ rnf out) $ \waitOut ->
540 withForkWait (C.evaluate $ rnf err) $ \waitErr -> do
541
542 -- now write any input
543 unless (null input) $
544 ignoreSigPipe $ hPutStr inh input
545 -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
546 ignoreSigPipe $ hClose inh
547
548 -- wait on the output
549 waitOut
550 waitErr
551
552 hClose outh
553 hClose errh
554
555 -- wait on the process
556 ex <- waitForProcess ph
557 return (ex, out, err)
558
559 (Nothing,_,_) -> error "readCreateProcessWithExitCode: Failed to get a stdin handle."
560 (_,Nothing,_) -> error "readCreateProcessWithExitCode: Failed to get a stdout handle."
561 (_,_,Nothing) -> error "readCreateProcessWithExitCode: Failed to get a stderr handle."
562
563 -- | Fork a thread while doing something else, but kill it if there's an
564 -- exception.
565 --
566 -- This is important in the cases above because we want to kill the thread
567 -- that is holding the Handle lock, because when we clean up the process we
568 -- try to close that handle, which could otherwise deadlock.
569 --
570 withForkWait :: IO () -> (IO () -> IO a) -> IO a
571 withForkWait async body = do
572 waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
573 mask $ \restore -> do
574 tid <- forkIO $ try (restore async) >>= putMVar waitVar
575 let wait = takeMVar waitVar >>= either throwIO return
576 restore (body wait) `C.onException` killThread tid
577
578 ignoreSigPipe :: IO () -> IO ()
579 ignoreSigPipe = C.handle $ \e -> case e of
580 IOError { ioe_type = ResourceVanished
581 , ioe_errno = Just ioe }
582 | Errno ioe == ePIPE -> return ()
583 _ -> throwIO e
584
585 -- ----------------------------------------------------------------------------
586 -- showCommandForUser
587
588 -- | Given a program @/p/@ and arguments @/args/@,
589 -- @showCommandForUser /p/ /args/@ returns a string suitable for pasting
590 -- into @\/bin\/sh@ (on Unix systems) or @CMD.EXE@ (on Windows).
591 showCommandForUser :: FilePath -> [String] -> String
592 showCommandForUser cmd args = unwords (map translate (cmd : args))
593
594
595 -- ----------------------------------------------------------------------------
596 -- getPid
597
598 -- | Returns the PID (process ID) of a subprocess.
599 --
600 -- 'Nothing' is returned if the handle was already closed. Otherwise a
601 -- PID is returned that remains valid as long as the handle is open.
602 -- The operating system may reuse the PID as soon as the last handle to
603 -- the process is closed.
604 --
605 -- @since 1.6.3.0
606 getPid :: ProcessHandle -> IO (Maybe Pid)
607 getPid (ProcessHandle mh _ _) = do
608 p_ <- readMVar mh
609 case p_ of
610 #ifdef WINDOWS
611 OpenHandle h -> do
612 pid <- getProcessId h
613 return $ Just pid
614 #else
615 OpenHandle pid -> return $ Just pid
616 #endif
617 _ -> return Nothing
618
619
620 -- ----------------------------------------------------------------------------
621 -- waitForProcess
622
623 {- | Waits for the specified process to terminate, and returns its exit code.
624
625 GHC Note: in order to call @waitForProcess@ without blocking all the
626 other threads in the system, you must compile the program with
627 @-threaded@.
628
629 (/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@
630 indicates that the child was terminated by signal @/signum/@.
631 The signal numbers are platform-specific, so to test for a specific signal use
632 the constants provided by "System.Posix.Signals" in the @unix@ package.
633 Note: core dumps are not reported, use "System.Posix.Process" if you need this
634 detail.
635
636 -}
637 waitForProcess
638 :: ProcessHandle
639 -> IO ExitCode
640 waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do
641 p_ <- modifyProcessHandle ph $ \p_ -> return (p_,p_)
642 case p_ of
643 ClosedHandle e -> return e
644 OpenHandle h -> do
645 e <- alloca $ \pret -> do
646 -- don't hold the MVar while we call c_waitForProcess...
647 throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret)
648 modifyProcessHandle ph $ \p_' ->
649 case p_' of
650 ClosedHandle e -> return (p_', e)
651 OpenExtHandle{} -> return (p_', ExitFailure (-1))
652 OpenHandle ph' -> do
653 closePHANDLE ph'
654 code <- peek pret
655 let e = if (code == 0)
656 then ExitSuccess
657 else (ExitFailure (fromIntegral code))
658 return (ClosedHandle e, e)
659 when delegating_ctlc $
660 endDelegateControlC e
661 return e
662 #if defined(WINDOWS)
663 OpenExtHandle _ job iocp ->
664 maybe (ExitFailure (-1)) mkExitCode `fmap` waitForJobCompletion job iocp timeout_Infinite
665 where mkExitCode code | code == 0 = ExitSuccess
666 | otherwise = ExitFailure $ fromIntegral code
667 #else
668 OpenExtHandle _ _job _iocp ->
669 return $ ExitFailure (-1)
670 #endif
671 where
672 -- If more than one thread calls `waitpid` at a time, `waitpid` will
673 -- return the exit code to one of them and (-1) to the rest of them,
674 -- causing an exception to be thrown.
675 -- Cf. https://github.com/haskell/process/issues/46, and
676 -- https://github.com/haskell/process/pull/58 for further discussion
677 lockWaitpid m = withMVar (waitpidLock ph) $ \() -> m
678
679 -- ----------------------------------------------------------------------------
680 -- getProcessExitCode
681
682 {- |
683 This is a non-blocking version of 'waitForProcess'. If the process is
684 still running, 'Nothing' is returned. If the process has exited, then
685 @'Just' e@ is returned where @e@ is the exit code of the process.
686
687 On Unix systems, see 'waitForProcess' for the meaning of exit codes
688 when the process died as the result of a signal.
689 -}
690
691 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
692 getProcessExitCode ph@(ProcessHandle _ delegating_ctlc _) = tryLockWaitpid $ do
693 (m_e, was_open) <- modifyProcessHandle ph $ \p_ ->
694 case p_ of
695 ClosedHandle e -> return (p_, (Just e, False))
696 open -> do
697 alloca $ \pExitCode -> do
698 case getHandle open of
699 Nothing -> return (p_, (Nothing, False))
700 Just h -> do
701 res <- throwErrnoIfMinus1Retry "getProcessExitCode" $
702 c_getProcessExitCode h pExitCode
703 code <- peek pExitCode
704 if res == 0
705 then return (p_, (Nothing, False))
706 else do
707 closePHANDLE h
708 let e | code == 0 = ExitSuccess
709 | otherwise = ExitFailure (fromIntegral code)
710 return (ClosedHandle e, (Just e, True))
711 case m_e of
712 Just e | was_open && delegating_ctlc -> endDelegateControlC e
713 _ -> return ()
714 return m_e
715 where getHandle :: ProcessHandle__ -> Maybe PHANDLE
716 getHandle (OpenHandle h) = Just h
717 getHandle (ClosedHandle _) = Nothing
718 getHandle (OpenExtHandle h _ _) = Just h
719
720 -- If somebody is currently holding the waitpid lock, we don't want to
721 -- accidentally remove the pid from the process table.
722 -- Try acquiring the waitpid lock. If it is held, we are done
723 -- since that means the process is still running and we can return
724 -- `Nothing`. If it is not held, acquire it so we can run the
725 -- (non-blocking) call to `waitpid` without worrying about any
726 -- other threads calling it at the same time.
727 tryLockWaitpid :: IO (Maybe ExitCode) -> IO (Maybe ExitCode)
728 tryLockWaitpid action = bracket acquire release between
729 where
730 acquire = tryTakeMVar (waitpidLock ph)
731 release m = case m of
732 Nothing -> return ()
733 Just () -> putMVar (waitpidLock ph) ()
734 between m = case m of
735 Nothing -> return Nothing
736 Just () -> action
737
738 -- ----------------------------------------------------------------------------
739 -- terminateProcess
740
741 -- | Attempts to terminate the specified process. This function should
742 -- not be used under normal circumstances - no guarantees are given regarding
743 -- how cleanly the process is terminated. To check whether the process
744 -- has indeed terminated, use 'getProcessExitCode'.
745 --
746 -- On Unix systems, 'terminateProcess' sends the process the SIGTERM signal.
747 -- On Windows systems, if `use_process_jobs` is `True` then the Win32 @TerminateJobObject@
748 -- function is called to kill all processes associated with the job and passing the
749 -- exit code of 1 to each of them. Otherwise if `use_process_jobs` is `False` then the
750 -- Win32 @TerminateProcess@ function is called, passing an exit code of 1.
751 --
752 -- Note: on Windows, if the process was a shell command created by
753 -- 'createProcess' with 'shell', or created by 'runCommand' or
754 -- 'runInteractiveCommand', then 'terminateProcess' will only
755 -- terminate the shell, not the command itself. On Unix systems, both
756 -- processes are in a process group and will be terminated together.
757
758 terminateProcess :: ProcessHandle -> IO ()
759 terminateProcess ph = do
760 withProcessHandle ph $ \p_ ->
761 case p_ of
762 ClosedHandle _ -> return ()
763 #if defined(WINDOWS)
764 OpenExtHandle{} -> terminateJob ph 1 >> return ()
765 #else
766 OpenExtHandle{} -> error "terminateProcess with OpenExtHandle should not happen on POSIX."
767 #endif
768 OpenHandle h -> do
769 throwErrnoIfMinus1Retry_ "terminateProcess" $ c_terminateProcess h
770 return ()
771 -- does not close the handle, we might want to try terminating it
772 -- again, or get its exit code.
773
774
775 -- ----------------------------------------------------------------------------
776 -- Interface to C bits
777
778 foreign import ccall unsafe "terminateProcess"
779 c_terminateProcess
780 :: PHANDLE
781 -> IO CInt
782
783 foreign import ccall unsafe "getProcessExitCode"
784 c_getProcessExitCode
785 :: PHANDLE
786 -> Ptr CInt
787 -> IO CInt
788
789 foreign import ccall interruptible "waitForProcess" -- NB. safe - can block
790 c_waitForProcess
791 :: PHANDLE
792 -> Ptr CInt
793 -> IO CInt
794
795
796 -- ----------------------------------------------------------------------------
797 -- Old deprecated variants
798 -- ----------------------------------------------------------------------------
799
800 -- TODO: We're not going to mark these functions as DEPRECATED immediately in
801 -- process-1.2.0.0. That's because some of their replacements have not been
802 -- around for all that long. But they should eventually be marked with a
803 -- suitable DEPRECATED pragma after a release or two.
804
805
806 -- ----------------------------------------------------------------------------
807 -- runCommand
808
809 --TODO: in a later release {-# DEPRECATED runCommand "Use 'spawnCommand' instead" #-}
810
811 {- | Runs a command using the shell.
812 -}
813 runCommand
814 :: String
815 -> IO ProcessHandle
816
817 runCommand string = do
818 (_,_,_,ph) <- createProcess_ "runCommand" (shell string)
819 return ph
820
821
822 -- ----------------------------------------------------------------------------
823 -- runProcess
824
825 --TODO: in a later release {-# DEPRECATED runProcess "Use 'spawnProcess' or 'createProcess' instead" #-}
826
827 {- | Runs a raw command, optionally specifying 'Handle's from which to
828 take the @stdin@, @stdout@ and @stderr@ channels for the new
829 process (otherwise these handles are inherited from the current
830 process).
831
832 Any 'Handle's passed to 'runProcess' are placed immediately in the
833 closed state.
834
835 Note: consider using the more general 'createProcess' instead of
836 'runProcess'.
837 -}
838 runProcess
839 :: FilePath -- ^ Filename of the executable (see 'RawCommand' for details)
840 -> [String] -- ^ Arguments to pass to the executable
841 -> Maybe FilePath -- ^ Optional path to the working directory
842 -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)
843 -> Maybe Handle -- ^ Handle to use for @stdin@ (Nothing => use existing @stdin@)
844 -> Maybe Handle -- ^ Handle to use for @stdout@ (Nothing => use existing @stdout@)
845 -> Maybe Handle -- ^ Handle to use for @stderr@ (Nothing => use existing @stderr@)
846 -> IO ProcessHandle
847
848 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
849 (_,_,_,ph) <-
850 createProcess_ "runProcess"
851 (proc cmd args){ cwd = mb_cwd,
852 env = mb_env,
853 std_in = mbToStd mb_stdin,
854 std_out = mbToStd mb_stdout,
855 std_err = mbToStd mb_stderr }
856 maybeClose mb_stdin
857 maybeClose mb_stdout
858 maybeClose mb_stderr
859 return ph
860 where
861 maybeClose :: Maybe Handle -> IO ()
862 maybeClose (Just hdl)
863 | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl
864 maybeClose _ = return ()
865
866 mbToStd :: Maybe Handle -> StdStream
867 mbToStd Nothing = Inherit
868 mbToStd (Just hdl) = UseHandle hdl
869
870
871 -- ----------------------------------------------------------------------------
872 -- runInteractiveCommand
873
874 --TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-}
875
876 {- | Runs a command using the shell, and returns 'Handle's that may
877 be used to communicate with the process via its @stdin@, @stdout@,
878 and @stderr@ respectively.
879 -}
880 runInteractiveCommand
881 :: String
882 -> IO (Handle,Handle,Handle,ProcessHandle)
883
884 runInteractiveCommand string =
885 runInteractiveProcess1 "runInteractiveCommand" (shell string)
886
887
888 -- ----------------------------------------------------------------------------
889 -- runInteractiveProcess
890
891 --TODO: in a later release {-# DEPRECATED runInteractiveCommand "Use 'createProcess' instead" #-}
892
893 {- | Runs a raw command, and returns 'Handle's that may be used to communicate
894 with the process via its @stdin@, @stdout@ and @stderr@ respectively.
895
896 For example, to start a process and feed a string to its stdin:
897
898 > (inp,out,err,pid) <- runInteractiveProcess "..."
899 > forkIO (hPutStr inp str)
900 -}
901 runInteractiveProcess
902 :: FilePath -- ^ Filename of the executable (see 'RawCommand' for details)
903 -> [String] -- ^ Arguments to pass to the executable
904 -> Maybe FilePath -- ^ Optional path to the working directory
905 -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit)
906 -> IO (Handle,Handle,Handle,ProcessHandle)
907
908 runInteractiveProcess cmd args mb_cwd mb_env = do
909 runInteractiveProcess1 "runInteractiveProcess"
910 (proc cmd args){ cwd = mb_cwd, env = mb_env }
911
912 runInteractiveProcess1
913 :: String
914 -> CreateProcess
915 -> IO (Handle,Handle,Handle,ProcessHandle)
916 runInteractiveProcess1 fun cmd = do
917 (mb_in, mb_out, mb_err, p) <-
918 createProcess_ fun
919 cmd{ std_in = CreatePipe,
920 std_out = CreatePipe,
921 std_err = CreatePipe }
922 return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p)
923
924
925 -- ---------------------------------------------------------------------------
926 -- system & rawSystem
927
928 --TODO: in a later release {-# DEPRECATED system "Use 'callCommand' (or 'spawnCommand' and 'waitForProcess') instead" #-}
929
930 {-|
931 Computation @system cmd@ returns the exit code produced when the
932 operating system runs the shell command @cmd@.
933
934 This computation may fail with one of the following
935 'System.IO.Error.IOErrorType' exceptions:
936
937 [@PermissionDenied@]
938 The process has insufficient privileges to perform the operation.
939
940 [@ResourceExhausted@]
941 Insufficient resources are available to perform the operation.
942
943 [@UnsupportedOperation@]
944 The implementation does not support system calls.
945
946 On Windows, 'system' passes the command to the Windows command
947 interpreter (@CMD.EXE@ or @COMMAND.COM@), hence Unixy shell tricks
948 will not work.
949
950 On Unix systems, see 'waitForProcess' for the meaning of exit codes
951 when the process died as the result of a signal.
952 -}
953 system :: String -> IO ExitCode
954 system "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command")
955 system str = do
956 (_,_,_,p) <- createProcess_ "system" (shell str) { delegate_ctlc = True }
957 waitForProcess p
958
959
960 --TODO: in a later release {-# DEPRECATED rawSystem "Use 'callProcess' (or 'spawnProcess' and 'waitForProcess') instead" #-}
961
962 {-|
963 The computation @'rawSystem' /cmd/ /args/@ runs the operating system command
964 @/cmd/@ in such a way that it receives as arguments the @/args/@ strings
965 exactly as given, with no funny escaping or shell meta-syntax expansion.
966 It will therefore behave more portably between operating systems than 'system'.
967
968 The return codes and possible failures are the same as for 'system'.
969 -}
970 rawSystem :: String -> [String] -> IO ExitCode
971 rawSystem cmd args = do
972 (_,_,_,p) <- createProcess_ "rawSystem" (proc cmd args) { delegate_ctlc = True }
973 waitForProcess p