1{-# LANGUAGE CPP #-} 2{-# LANGUAGE TypeFamilies #-} 3{-# LANGUAGE DeriveDataTypeable #-} 4{-# LANGUAGE RecordWildCards #-} 5{-# LANGUAGE DataKinds #-} 6{-# LANGUAGE DeriveFunctor #-} 7{-# LANGUAGE RankNTypes #-} 8{-# LANGUAGE ScopedTypeVariables #-} 9-- | Please see the README.md file for examples of using this API. 10module System.Process.Typed 11 ( -- * Types 12 ProcessConfig 13 , StreamSpec 14 , StreamType (..) 15 , Process 16 17 -- * ProcessConfig 18 -- ** Smart constructors 19 , proc 20 , shell 21 22 -- ** Setters 23 , setStdin 24 , setStdout 25 , setStderr 26 , setWorkingDir 27 , setWorkingDirInherit 28 , setEnv 29 , setEnvInherit 30 , setCloseFds 31 , setCreateGroup 32 , setDelegateCtlc 33#if MIN_VERSION_process(1, 3, 0) 34 , setDetachConsole 35 , setCreateNewConsole 36 , setNewSession 37#endif 38#if MIN_VERSION_process(1, 4, 0) && !WINDOWS 39 , setChildGroup 40 , setChildGroupInherit 41 , setChildUser 42 , setChildUserInherit 43#endif 44 45 -- * Stream specs 46 , mkStreamSpec 47 , inherit 48 , nullStream 49 , closed 50 , byteStringInput 51 , byteStringOutput 52 , createPipe 53 , useHandleOpen 54 , useHandleClose 55 56 -- * Launch a process 57 , startProcess 58 , stopProcess 59 , withProcessWait 60 , withProcessWait_ 61 , withProcessTerm 62 , withProcessTerm_ 63 , withProcess 64 , withProcess_ 65 , readProcess 66 , readProcess_ 67 , runProcess 68 , runProcess_ 69 , readProcessStdout 70 , readProcessStdout_ 71 , readProcessStderr 72 , readProcessStderr_ 73 , readProcessInterleaved 74 , readProcessInterleaved_ 75 76 -- * Interact with a process 77 78 -- ** Process exit code 79 , waitExitCode 80 , waitExitCodeSTM 81 , getExitCode 82 , getExitCodeSTM 83 , checkExitCode 84 , checkExitCodeSTM 85 86 -- ** Process streams 87 , getStdin 88 , getStdout 89 , getStderr 90 91 -- * Exceptions 92 , ExitCodeException (..) 93 , ByteStringOutputException (..) 94 -- * Unsafe functions 95 , unsafeProcessHandle 96 ) where 97 98import qualified Data.ByteString as S 99import Data.ByteString.Lazy.Internal (defaultChunkSize) 100import qualified Control.Exception as E 101import Control.Exception hiding (bracket, finally) 102import Control.Monad (void) 103import Control.Monad.IO.Class 104import qualified System.Process as P 105import Data.Typeable (Typeable) 106import System.IO (Handle, hClose, IOMode(ReadWriteMode), withBinaryFile) 107import System.IO.Error (isPermissionError) 108import Control.Concurrent (threadDelay) 109import Control.Concurrent.Async (async, asyncWithUnmask, cancel, waitCatch) 110import Control.Concurrent.STM (newEmptyTMVarIO, atomically, putTMVar, TMVar, readTMVar, tryReadTMVar, STM, tryPutTMVar, throwSTM, catchSTM) 111import System.Exit (ExitCode (ExitSuccess)) 112import System.Process.Typed.Internal 113import qualified Data.ByteString.Lazy as L 114import qualified Data.ByteString.Lazy.Char8 as L8 115import Data.String (IsString (fromString)) 116import GHC.RTS.Flags (getConcFlags, ctxtSwitchTime) 117import Control.Monad.IO.Unlift 118 119#if MIN_VERSION_process(1, 4, 0) && !WINDOWS 120import System.Posix.Types (GroupID, UserID) 121#endif 122 123#if !MIN_VERSION_base(4, 8, 0) 124import Control.Applicative (Applicative (..), (<$>), (<$)) 125#endif 126 127#if !MIN_VERSION_process(1, 3, 0) 128import qualified System.Process.Internals as P (createProcess_) 129#endif 130 131-- | An abstract configuration for a process, which can then be 132-- launched into an actual running 'Process'. Takes three type 133-- parameters, providing the types of standard input, standard output, 134-- and standard error, respectively. 135-- 136-- There are three ways to construct a value of this type: 137-- 138-- * With the 'proc' smart constructor, which takes a command name and 139-- a list of arguments. 140-- 141-- * With the 'shell' smart constructor, which takes a shell string 142-- 143-- * With the 'IsString' instance via OverloadedStrings. If you 144-- provide it a string with no spaces (e.g., @"date"@), it will 145-- treat it as a raw command with no arguments (e.g., @proc "date" 146-- []@). If it has spaces, it will use @shell@. 147-- 148-- In all cases, the default for all three streams is to inherit the 149-- streams from the parent process. For other settings, see the 150-- setters below for default values. 151-- 152-- @since 0.1.0.0 153data ProcessConfig stdin stdout stderr = ProcessConfig 154 { pcCmdSpec :: !P.CmdSpec 155 , pcStdin :: !(StreamSpec 'STInput stdin) 156 , pcStdout :: !(StreamSpec 'STOutput stdout) 157 , pcStderr :: !(StreamSpec 'STOutput stderr) 158 , pcWorkingDir :: !(Maybe FilePath) 159 , pcEnv :: !(Maybe [(String, String)]) 160 , pcCloseFds :: !Bool 161 , pcCreateGroup :: !Bool 162 , pcDelegateCtlc :: !Bool 163 164#if MIN_VERSION_process(1, 3, 0) 165 , pcDetachConsole :: !Bool 166 , pcCreateNewConsole :: !Bool 167 , pcNewSession :: !Bool 168#endif 169 170#if MIN_VERSION_process(1, 4, 0) && !WINDOWS 171 , pcChildGroup :: !(Maybe GroupID) 172 , pcChildUser :: !(Maybe UserID) 173#endif 174 } 175instance Show (ProcessConfig stdin stdout stderr) where 176 show pc = concat 177 [ case pcCmdSpec pc of 178 P.ShellCommand s -> "Shell command: " ++ s 179 P.RawCommand x xs -> "Raw command: " ++ unwords (map escape (x:xs)) 180 , "\n" 181 , case pcWorkingDir pc of 182 Nothing -> "" 183 Just wd -> concat 184 [ "Run from: " 185 , wd 186 , "\n" 187 ] 188 , case pcEnv pc of 189 Nothing -> "" 190 Just e -> unlines 191 $ "Modified environment:" 192 : map (\(k, v) -> concat [k, "=", v]) e 193 ] 194 where 195 escape x 196 | any (`elem` " \\\"'") x = show x 197 | otherwise = x 198instance (stdin ~ (), stdout ~ (), stderr ~ ()) 199 => IsString (ProcessConfig stdin stdout stderr) where 200 fromString s 201 | any (== ' ') s = shell s 202 | otherwise = proc s [] 203 204-- | Whether a stream is an input stream or output stream. Note that 205-- this is from the perspective of the /child process/, so that a 206-- child's standard input stream is an @STInput@, even though the 207-- parent process will be writing to it. 208-- 209-- @since 0.1.0.0 210data StreamType = STInput | STOutput 211 212-- | A specification for how to create one of the three standard child 213-- streams. See examples below. 214-- 215-- @since 0.1.0.0 216data StreamSpec (streamType :: StreamType) a = StreamSpec 217 { ssStream :: !(forall b. (P.StdStream -> IO b) -> IO b) 218 , ssCreate :: !(ProcessConfig () () () -> Maybe Handle -> Cleanup a) 219 } 220 deriving Functor 221 222-- | This instance uses 'byteStringInput' to convert a raw string into 223-- a stream of input for a child process. 224-- 225-- @since 0.1.0.0 226instance (streamType ~ 'STInput, res ~ ()) 227 => IsString (StreamSpec streamType res) where 228 fromString = byteStringInput . fromString 229 230-- | Internal type, to make for easier composition of cleanup actions. 231-- 232-- @since 0.1.0.0 233newtype Cleanup a = Cleanup { runCleanup :: IO (a, IO ()) } 234 deriving Functor 235instance Applicative Cleanup where 236 pure x = Cleanup (return (x, return ())) 237 Cleanup f <*> Cleanup x = Cleanup $ do 238 (f', c1) <- f 239 (`onException` c1) $ do 240 (x', c2) <- x 241 return (f' x', c1 `finally` c2) 242 243-- | A running process. The three type parameters provide the type of 244-- the standard input, standard output, and standard error streams. 245-- 246-- @since 0.1.0.0 247data Process stdin stdout stderr = Process 248 { pConfig :: !(ProcessConfig () () ()) 249 , pCleanup :: !(IO ()) 250 , pStdin :: !stdin 251 , pStdout :: !stdout 252 , pStderr :: !stderr 253 , pHandle :: !P.ProcessHandle 254 , pExitCode :: !(TMVar ExitCode) 255 } 256instance Show (Process stdin stdout stderr) where 257 show p = "Running process: " ++ show (pConfig p) 258 259-- | Internal helper 260defaultProcessConfig :: ProcessConfig () () () 261defaultProcessConfig = ProcessConfig 262 { pcCmdSpec = P.ShellCommand "" 263 , pcStdin = inherit 264 , pcStdout = inherit 265 , pcStderr = inherit 266 , pcWorkingDir = Nothing 267 , pcEnv = Nothing 268 , pcCloseFds = False 269 , pcCreateGroup = False 270 , pcDelegateCtlc = False 271 272#if MIN_VERSION_process(1, 3, 0) 273 , pcDetachConsole = False 274 , pcCreateNewConsole = False 275 , pcNewSession = False 276#endif 277 278#if MIN_VERSION_process(1, 4, 0) && !WINDOWS 279 , pcChildGroup = Nothing 280 , pcChildUser = Nothing 281#endif 282 } 283 284-- | Create a 'ProcessConfig' from the given command and arguments. 285-- 286-- @since 0.1.0.0 287proc :: FilePath -> [String] -> ProcessConfig () () () 288proc cmd args = setProc cmd args defaultProcessConfig 289 290-- | Internal helper 291setProc :: FilePath -> [String] 292 -> ProcessConfig stdin stdout stderr 293 -> ProcessConfig stdin stdout stderr 294setProc cmd args p = p { pcCmdSpec = P.RawCommand cmd args } 295 296-- | Create a 'ProcessConfig' from the given shell command. 297-- 298-- @since 0.1.0.0 299shell :: String -> ProcessConfig () () () 300shell cmd = setShell cmd defaultProcessConfig 301 302-- | Internal helper 303setShell :: String 304 -> ProcessConfig stdin stdout stderr 305 -> ProcessConfig stdin stdout stderr 306setShell cmd p = p { pcCmdSpec = P.ShellCommand cmd } 307 308-- | Set the child's standard input stream to the given 'StreamSpec'. 309-- 310-- Default: 'inherit' 311-- 312-- @since 0.1.0.0 313setStdin :: StreamSpec 'STInput stdin 314 -> ProcessConfig stdin0 stdout stderr 315 -> ProcessConfig stdin stdout stderr 316setStdin spec pc = pc { pcStdin = spec } 317 318-- | Set the child's standard output stream to the given 'StreamSpec'. 319-- 320-- Default: 'inherit' 321-- 322-- @since 0.1.0.0 323setStdout :: StreamSpec 'STOutput stdout 324 -> ProcessConfig stdin stdout0 stderr 325 -> ProcessConfig stdin stdout stderr 326setStdout spec pc = pc { pcStdout = spec } 327 328-- | Set the child's standard error stream to the given 'StreamSpec'. 329-- 330-- Default: 'inherit' 331-- 332-- @since 0.1.0.0 333setStderr :: StreamSpec 'STOutput stderr 334 -> ProcessConfig stdin stdout stderr0 335 -> ProcessConfig stdin stdout stderr 336setStderr spec pc = pc { pcStderr = spec } 337 338-- | Set the working directory of the child process. 339-- 340-- Default: current process's working directory. 341-- 342-- @since 0.1.0.0 343setWorkingDir :: FilePath 344 -> ProcessConfig stdin stdout stderr 345 -> ProcessConfig stdin stdout stderr 346setWorkingDir dir pc = pc { pcWorkingDir = Just dir } 347 348-- | Inherit the working directory from the parent process. 349-- 350-- @since 0.2.2.0 351setWorkingDirInherit 352 :: ProcessConfig stdin stdout stderr 353 -> ProcessConfig stdin stdout stderr 354setWorkingDirInherit pc = pc { pcWorkingDir = Nothing } 355 356-- | Set the environment variables of the child process. 357-- 358-- Default: current process's environment. 359-- 360-- @since 0.1.0.0 361setEnv :: [(String, String)] 362 -> ProcessConfig stdin stdout stderr 363 -> ProcessConfig stdin stdout stderr 364setEnv env pc = pc { pcEnv = Just env } 365 366-- | Inherit the environment variables from the parent process. 367-- 368-- @since 0.2.2.0 369setEnvInherit 370 :: ProcessConfig stdin stdout stderr 371 -> ProcessConfig stdin stdout stderr 372setEnvInherit pc = pc { pcEnv = Nothing } 373 374-- | Should we close all file descriptors besides stdin, stdout, and 375-- stderr? See 'P.close_fds' for more information. 376-- 377-- Default: False 378-- 379-- @since 0.1.0.0 380setCloseFds 381 :: Bool 382 -> ProcessConfig stdin stdout stderr 383 -> ProcessConfig stdin stdout stderr 384setCloseFds x pc = pc { pcCloseFds = x } 385 386-- | Should we create a new process group? 387-- 388-- Default: False 389-- 390-- @since 0.1.0.0 391setCreateGroup 392 :: Bool 393 -> ProcessConfig stdin stdout stderr 394 -> ProcessConfig stdin stdout stderr 395setCreateGroup x pc = pc { pcCreateGroup = x } 396 397-- | Delegate handling of Ctrl-C to the child. For more information, 398-- see 'P.delegate_ctlc'. 399-- 400-- Default: False 401-- 402-- @since 0.1.0.0 403setDelegateCtlc 404 :: Bool 405 -> ProcessConfig stdin stdout stderr 406 -> ProcessConfig stdin stdout stderr 407setDelegateCtlc x pc = pc { pcDelegateCtlc = x } 408 409#if MIN_VERSION_process(1, 3, 0) 410 411-- | Detach console on Windows, see 'P.detach_console'. 412-- 413-- Default: False 414-- 415-- @since 0.1.0.0 416setDetachConsole 417 :: Bool 418 -> ProcessConfig stdin stdout stderr 419 -> ProcessConfig stdin stdout stderr 420setDetachConsole x pc = pc { pcDetachConsole = x } 421 422-- | Create new console on Windows, see 'P.create_new_console'. 423-- 424-- Default: False 425-- 426-- @since 0.1.0.0 427setCreateNewConsole 428 :: Bool 429 -> ProcessConfig stdin stdout stderr 430 -> ProcessConfig stdin stdout stderr 431setCreateNewConsole x pc = pc { pcCreateNewConsole = x } 432 433-- | Set a new session with the POSIX @setsid@ syscall, does nothing 434-- on non-POSIX. See 'P.new_session'. 435-- 436-- Default: False 437-- 438-- @since 0.1.0.0 439setNewSession 440 :: Bool 441 -> ProcessConfig stdin stdout stderr 442 -> ProcessConfig stdin stdout stderr 443setNewSession x pc = pc { pcNewSession = x } 444#endif 445 446#if MIN_VERSION_process(1, 4, 0) && !WINDOWS 447-- | Set the child process's group ID with the POSIX @setgid@ syscall, 448-- does nothing on non-POSIX. See 'P.child_group'. 449-- 450-- Default: False 451-- 452-- @since 0.1.0.0 453setChildGroup 454 :: GroupID 455 -> ProcessConfig stdin stdout stderr 456 -> ProcessConfig stdin stdout stderr 457setChildGroup x pc = pc { pcChildGroup = Just x } 458 459-- | Inherit the group from the parent process. 460-- 461-- @since 0.2.2.0 462setChildGroupInherit 463 :: ProcessConfig stdin stdout stderr 464 -> ProcessConfig stdin stdout stderr 465setChildGroupInherit pc = pc { pcChildGroup = Nothing } 466 467-- | Set the child process's user ID with the POSIX @setuid@ syscall, 468-- does nothing on non-POSIX. See 'P.child_user'. 469-- 470-- Default: False 471-- 472-- @since 0.1.0.0 473setChildUser 474 :: UserID 475 -> ProcessConfig stdin stdout stderr 476 -> ProcessConfig stdin stdout stderr 477setChildUser x pc = pc { pcChildUser = Just x } 478 479-- | Inherit the user from the parent process. 480-- 481-- @since 0.2.2.0 482setChildUserInherit 483 :: ProcessConfig stdin stdout stderr 484 -> ProcessConfig stdin stdout stderr 485setChildUserInherit pc = pc { pcChildUser = Nothing } 486#endif 487 488-- | Create a new 'StreamSpec' from the given 'P.StdStream' and a 489-- helper function. This function: 490-- 491-- * Takes as input the raw @Maybe Handle@ returned by the 492-- 'P.createProcess' function. This will be determined by the 493-- 'P.StdStream' argument. 494-- 495-- * Returns the actual stream value @a@, as well as a cleanup 496-- * function to be run when calling 'stopProcess'. 497-- 498-- @since 0.1.0.0 499mkStreamSpec :: P.StdStream 500 -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())) 501 -> StreamSpec streamType a 502mkStreamSpec ss f = mkManagedStreamSpec ($ ss) f 503 504-- | Create a new 'StreamSpec' from a function that accepts a 505-- 'P.StdStream' and a helper function. This function is the same as 506-- the helper in 'mkStreamSpec' 507mkManagedStreamSpec :: (forall b. (P.StdStream -> IO b) -> IO b) 508 -> (ProcessConfig () () () -> Maybe Handle -> IO (a, IO ())) 509 -> StreamSpec streamType a 510mkManagedStreamSpec ss f = StreamSpec ss (\pc mh -> Cleanup (f pc mh)) 511 512-- | A stream spec which simply inherits the stream of the parent 513-- process. 514-- 515-- @since 0.1.0.0 516inherit :: StreamSpec anyStreamType () 517inherit = mkStreamSpec P.Inherit (\_ Nothing -> pure ((), return ())) 518 519-- | A stream spec which is empty when used for for input and discards 520-- output. Note this requires your platform's null device to be 521-- available when the process is started. 522-- 523-- @since 0.2.5.0 524nullStream :: StreamSpec anyStreamType () 525nullStream = mkManagedStreamSpec opener cleanup 526 where 527 opener f = 528 withBinaryFile nullDevice ReadWriteMode $ \handle -> 529 f (P.UseHandle handle) 530 cleanup _ _ = 531 pure ((), return ()) 532 533-- | A stream spec which will close the stream for the child process. 534-- You usually do not want to use this, as it will leave the 535-- corresponding file descriptor unassigned and hence available for 536-- re-use in the child process. Prefer 'nullStream' unless you're 537-- certain you want this behavior. 538-- 539-- @since 0.1.0.0 540closed :: StreamSpec anyStreamType () 541#if MIN_VERSION_process(1, 4, 0) 542closed = mkStreamSpec P.NoStream (\_ Nothing -> pure ((), return ())) 543#else 544closed = mkStreamSpec P.CreatePipe (\_ (Just h) -> ((), return ()) <$ hClose h) 545#endif 546 547-- | An input stream spec which sets the input to the given 548-- 'L.ByteString'. A separate thread will be forked to write the 549-- contents to the child process. 550-- 551-- @since 0.1.0.0 552byteStringInput :: L.ByteString -> StreamSpec 'STInput () 553byteStringInput lbs = mkStreamSpec P.CreatePipe $ \_ (Just h) -> do 554 void $ async $ do 555 L.hPut h lbs 556 hClose h 557 return ((), hClose h) 558 559-- | Capture the output of a process in a 'L.ByteString'. 560-- 561-- This function will fork a separate thread to consume all input from 562-- the process, and will only make the results available when the 563-- underlying 'Handle' is closed. As this is provided as an 'STM' 564-- action, you can either check if the result is available, or block 565-- until it's ready. 566-- 567-- In the event of any exception occurring when reading from the 568-- 'Handle', the 'STM' action will throw a 569-- 'ByteStringOutputException'. 570-- 571-- @since 0.1.0.0 572byteStringOutput :: StreamSpec 'STOutput (STM L.ByteString) 573byteStringOutput = mkStreamSpec P.CreatePipe $ \pc (Just h) -> byteStringFromHandle pc h 574 575-- | Helper function (not exposed) for both 'byteStringOutput' and 576-- 'withProcessInterleave'. This will consume all of the output from 577-- the given 'Handle' in a separate thread and provide access to the 578-- resulting 'L.ByteString' via STM. Second action will close the 579-- reader handle. 580byteStringFromHandle 581 :: ProcessConfig () () () 582 -> Handle -- ^ reader handle 583 -> IO (STM L.ByteString, IO ()) 584byteStringFromHandle pc h = do 585 mvar <- newEmptyTMVarIO 586 587 void $ async $ do 588 let loop front = do 589 bs <- S.hGetSome h defaultChunkSize 590 if S.null bs 591 then atomically $ putTMVar mvar $ Right $ L.fromChunks $ front [] 592 else loop $ front . (bs:) 593 loop id `catch` \e -> do 594 atomically $ void $ tryPutTMVar mvar $ Left $ ByteStringOutputException e pc 595 throwIO e 596 597 return (readTMVar mvar >>= either throwSTM return, hClose h) 598 599-- | Create a new pipe between this process and the child, and return 600-- a 'Handle' to communicate with the child. 601-- 602-- @since 0.1.0.0 603createPipe :: StreamSpec anyStreamType Handle 604createPipe = mkStreamSpec P.CreatePipe $ \_ (Just h) -> return (h, hClose h) 605 606-- | Use the provided 'Handle' for the child process, and when the 607-- process exits, do /not/ close it. This is useful if, for example, 608-- you want to have multiple processes write to the same log file 609-- sequentially. 610-- 611-- @since 0.1.0.0 612useHandleOpen :: Handle -> StreamSpec anyStreamType () 613useHandleOpen h = mkStreamSpec (P.UseHandle h) $ \_ Nothing -> return ((), return ()) 614 615-- | Use the provided 'Handle' for the child process, and when the 616-- process exits, close it. If you have no reason to keep the 'Handle' 617-- open, you should use this over 'useHandleOpen'. 618-- 619-- @since 0.1.0.0 620useHandleClose :: Handle -> StreamSpec anyStreamType () 621useHandleClose h = mkStreamSpec (P.UseHandle h) $ \_ Nothing -> return ((), hClose h) 622 623-- | Launch a process based on the given 'ProcessConfig'. You should 624-- ensure that you close 'stopProcess' on the result. It's usually 625-- better to use one of the functions in this module which ensures 626-- 'stopProcess' is called, such as 'withProcess'. 627-- 628-- @since 0.1.0.0 629startProcess :: MonadIO m 630 => ProcessConfig stdin stdout stderr 631 -> m (Process stdin stdout stderr) 632startProcess pConfig'@ProcessConfig {..} = liftIO $ do 633 ssStream pcStdin $ \realStdin -> 634 ssStream pcStdout $ \realStdout -> 635 ssStream pcStderr $ \realStderr -> do 636 637 let cp0 = 638 case pcCmdSpec of 639 P.ShellCommand cmd -> P.shell cmd 640 P.RawCommand cmd args -> P.proc cmd args 641 cp = cp0 642 { P.std_in = realStdin 643 , P.std_out = realStdout 644 , P.std_err = realStderr 645 , P.cwd = pcWorkingDir 646 , P.env = pcEnv 647 , P.close_fds = pcCloseFds 648 , P.create_group = pcCreateGroup 649 , P.delegate_ctlc = pcDelegateCtlc 650 651#if MIN_VERSION_process(1, 3, 0) 652 , P.detach_console = pcDetachConsole 653 , P.create_new_console = pcCreateNewConsole 654 , P.new_session = pcNewSession 655#endif 656 657#if MIN_VERSION_process(1, 4, 0) && !WINDOWS 658 , P.child_group = pcChildGroup 659 , P.child_user = pcChildUser 660#endif 661 662 } 663 664 (minH, moutH, merrH, pHandle) <- P.createProcess_ "startProcess" cp 665 666 ((pStdin, pStdout, pStderr), pCleanup1) <- runCleanup $ (,,) 667 <$> ssCreate pcStdin pConfig minH 668 <*> ssCreate pcStdout pConfig moutH 669 <*> ssCreate pcStderr pConfig merrH 670 671 pExitCode <- newEmptyTMVarIO 672 waitingThread <- asyncWithUnmask $ \unmask -> do 673 ec <- unmask $ -- make sure the masking state from a bracket isn't inherited 674 if multiThreadedRuntime 675 then P.waitForProcess pHandle 676 else do 677 switchTime <- fromIntegral . (`div` 1000) . ctxtSwitchTime 678 <$> getConcFlags 679 let minDelay = 1 680 maxDelay = max minDelay switchTime 681 loop delay = do 682 threadDelay delay 683 mec <- P.getProcessExitCode pHandle 684 case mec of 685 Nothing -> loop $ min maxDelay (delay * 2) 686 Just ec -> pure ec 687 loop minDelay 688 atomically $ putTMVar pExitCode ec 689 return ec 690 691 let pCleanup = pCleanup1 `finally` do 692 -- First: stop calling waitForProcess, so that we can 693 -- avoid race conditions where the process is removed from 694 -- the system process table while we're trying to 695 -- terminate it. 696 cancel waitingThread 697 698 -- Now check if the process had already exited 699 eec <- waitCatch waitingThread 700 701 case eec of 702 -- Process already exited, nothing to do 703 Right _ec -> return () 704 705 -- Process didn't exit yet, let's terminate it and 706 -- then call waitForProcess ourselves 707 Left _ -> do 708 eres <- try $ P.terminateProcess pHandle 709 ec <- 710 case eres of 711 Left e 712 -- On Windows, with the single-threaded runtime, it 713 -- seems that if a process has already exited, the 714 -- call to terminateProcess will fail with a 715 -- permission denied error. To work around this, we 716 -- catch this exception and then immediately 717 -- waitForProcess. There's a chance that there may be 718 -- other reasons for this permission error to appear, 719 -- in which case this code may allow us to wait too 720 -- long for a child process instead of erroring out. 721 -- Recommendation: always use the multi-threaded 722 -- runtime! 723 | isPermissionError e && not multiThreadedRuntime && isWindows -> 724 P.waitForProcess pHandle 725 | otherwise -> throwIO e 726 Right () -> P.waitForProcess pHandle 727 success <- atomically $ tryPutTMVar pExitCode ec 728 evaluate $ assert success () 729 730 return Process {..} 731 where 732 pConfig = clearStreams pConfig' 733 734foreign import ccall unsafe "rtsSupportsBoundThreads" 735 multiThreadedRuntime :: Bool 736 737isWindows :: Bool 738#if WINDOWS 739isWindows = True 740#else 741isWindows = False 742#endif 743 744-- | Close a process and release any resources acquired. This will 745-- ensure 'P.terminateProcess' is called, wait for the process to 746-- actually exit, and then close out resources allocated for the 747-- streams. In the event of any cleanup exceptions being thrown this 748-- will throw an exception. 749-- 750-- @since 0.1.0.0 751stopProcess :: MonadIO m 752 => Process stdin stdout stderr 753 -> m () 754stopProcess = liftIO . pCleanup 755 756-- | Uses the bracket pattern to call 'startProcess' and ensures that 757-- 'stopProcess' is called. 758-- 759-- This function is usually /not/ what you want. You're likely better 760-- off using 'withProcessWait'. See 761-- <https://github.com/fpco/typed-process/issues/25>. 762-- 763-- @since 0.2.5.0 764withProcessTerm :: (MonadUnliftIO m) 765 => ProcessConfig stdin stdout stderr 766 -> (Process stdin stdout stderr -> m a) 767 -> m a 768withProcessTerm config = bracket (startProcess config) stopProcess 769 770-- | Uses the bracket pattern to call 'startProcess'. Unlike 771-- 'withProcessTerm', this function will wait for the child process to 772-- exit, and only kill it with 'stopProcess' in the event that the 773-- inner function throws an exception. 774-- 775-- @since 0.2.5.0 776withProcessWait :: (MonadUnliftIO m) 777 => ProcessConfig stdin stdout stderr 778 -> (Process stdin stdout stderr -> m a) 779 -> m a 780withProcessWait config f = 781 bracket 782 (startProcess config) 783 stopProcess 784 (\p -> f p <* waitExitCode p) 785 786-- | Deprecated synonym for 'withProcessTerm'. 787-- 788-- @since 0.1.0.0 789withProcess :: (MonadUnliftIO m) 790 => ProcessConfig stdin stdout stderr 791 -> (Process stdin stdout stderr -> m a) 792 -> m a 793withProcess = withProcessTerm 794{-# DEPRECATED withProcess "Please consider using withProcessWait, or instead use withProcessTerm" #-} 795 796-- | Same as 'withProcessTerm', but also calls 'checkExitCode' 797-- 798-- @since 0.2.5.0 799withProcessTerm_ :: (MonadUnliftIO m) 800 => ProcessConfig stdin stdout stderr 801 -> (Process stdin stdout stderr -> m a) 802 -> m a 803withProcessTerm_ config = bracket 804 (startProcess config) 805 (\p -> stopProcess p `finally` checkExitCode p) 806 807-- | Same as 'withProcessWait', but also calls 'checkExitCode' 808-- 809-- @since 0.2.5.0 810withProcessWait_ :: (MonadUnliftIO m) 811 => ProcessConfig stdin stdout stderr 812 -> (Process stdin stdout stderr -> m a) 813 -> m a 814withProcessWait_ config f = bracket 815 (startProcess config) 816 stopProcess 817 (\p -> f p <* checkExitCode p) 818 819-- | Deprecated synonym for 'withProcessTerm_'. 820-- 821-- @since 0.1.0.0 822withProcess_ :: (MonadUnliftIO m) 823 => ProcessConfig stdin stdout stderr 824 -> (Process stdin stdout stderr -> m a) 825 -> m a 826withProcess_ = withProcessTerm_ 827{-# DEPRECATED withProcess_ "Please consider using withProcessWait_, or instead use withProcessTerm_" #-} 828 829-- | Run a process, capture its standard output and error as a 830-- 'L.ByteString', wait for it to complete, and then return its exit 831-- code, output, and error. 832-- 833-- Note that any previously used 'setStdout' or 'setStderr' will be 834-- overridden. 835-- 836-- @since 0.1.0.0 837readProcess :: MonadIO m 838 => ProcessConfig stdin stdoutIgnored stderrIgnored 839 -> m (ExitCode, L.ByteString, L.ByteString) 840readProcess pc = 841 liftIO $ withProcess pc' $ \p -> atomically $ (,,) 842 <$> waitExitCodeSTM p 843 <*> getStdout p 844 <*> getStderr p 845 where 846 pc' = setStdout byteStringOutput 847 $ setStderr byteStringOutput pc 848 849-- | Same as 'readProcess', but instead of returning the 'ExitCode', 850-- checks it with 'checkExitCode'. 851-- 852-- Exceptions thrown by this function will include stdout and stderr. 853-- 854-- @since 0.1.0.0 855readProcess_ :: MonadIO m 856 => ProcessConfig stdin stdoutIgnored stderrIgnored 857 -> m (L.ByteString, L.ByteString) 858readProcess_ pc = 859 liftIO $ withProcess pc' $ \p -> atomically $ do 860 stdout <- getStdout p 861 stderr <- getStderr p 862 checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece 863 { eceStdout = stdout 864 , eceStderr = stderr 865 } 866 return (stdout, stderr) 867 where 868 pc' = setStdout byteStringOutput 869 $ setStderr byteStringOutput pc 870 871-- | Same as 'readProcess', but only read the stdout of the process. Original settings for stderr remain. 872-- 873-- @since 0.2.1.0 874readProcessStdout 875 :: MonadIO m 876 => ProcessConfig stdin stdoutIgnored stderr 877 -> m (ExitCode, L.ByteString) 878readProcessStdout pc = 879 liftIO $ withProcess pc' $ \p -> atomically $ (,) 880 <$> waitExitCodeSTM p 881 <*> getStdout p 882 where 883 pc' = setStdout byteStringOutput pc 884 885-- | Same as 'readProcessStdout', but instead of returning the 886-- 'ExitCode', checks it with 'checkExitCode'. 887-- 888-- Exceptions thrown by this function will include stdout. 889-- 890-- @since 0.2.1.0 891readProcessStdout_ 892 :: MonadIO m 893 => ProcessConfig stdin stdoutIgnored stderr 894 -> m L.ByteString 895readProcessStdout_ pc = 896 liftIO $ withProcess pc' $ \p -> atomically $ do 897 stdout <- getStdout p 898 checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece 899 { eceStdout = stdout 900 } 901 return stdout 902 where 903 pc' = setStdout byteStringOutput pc 904 905-- | Same as 'readProcess', but only read the stderr of the process. 906-- Original settings for stdout remain. 907-- 908-- @since 0.2.1.0 909readProcessStderr 910 :: MonadIO m 911 => ProcessConfig stdin stdout stderrIgnored 912 -> m (ExitCode, L.ByteString) 913readProcessStderr pc = 914 liftIO $ withProcess pc' $ \p -> atomically $ (,) 915 <$> waitExitCodeSTM p 916 <*> getStderr p 917 where 918 pc' = setStderr byteStringOutput pc 919 920-- | Same as 'readProcessStderr', but instead of returning the 921-- 'ExitCode', checks it with 'checkExitCode'. 922-- 923-- Exceptions thrown by this function will include stderr. 924-- 925-- @since 0.2.1.0 926readProcessStderr_ 927 :: MonadIO m 928 => ProcessConfig stdin stdout stderrIgnored 929 -> m L.ByteString 930readProcessStderr_ pc = 931 liftIO $ withProcess pc' $ \p -> atomically $ do 932 stderr <- getStderr p 933 checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece 934 { eceStderr = stderr 935 } 936 return stderr 937 where 938 pc' = setStderr byteStringOutput pc 939 940withProcessInterleave :: (MonadUnliftIO m) 941 => ProcessConfig stdin stdoutIgnored stderrIgnored 942 -> (Process stdin (STM L.ByteString) () -> m a) 943 -> m a 944withProcessInterleave pc inner = 945 -- Create a pipe to be shared for both stdout and stderr 946 bracket P.createPipe (\(r, w) -> hClose r >> hClose w) $ \(readEnd, writeEnd) -> do 947 -- Use the writer end of the pipe for both stdout and stderr. For 948 -- the stdout half, use byteStringFromHandle to read the data into 949 -- a lazy ByteString in memory. 950 let pc' = setStdout (mkStreamSpec (P.UseHandle writeEnd) (\pc'' Nothing -> byteStringFromHandle pc'' readEnd)) 951 $ setStderr (useHandleOpen writeEnd) 952 pc 953 withProcess pc' $ \p -> do 954 -- Now that the process is forked, close the writer end of this 955 -- pipe, otherwise the reader end will never give an EOF. 956 liftIO $ hClose writeEnd 957 inner p 958 959-- | Same as 'readProcess', but interleaves stderr with stdout. 960-- 961-- Motivation: Use this function if you need stdout interleaved with stderr 962-- output (e.g. from an HTTP server) in order to debug failures. 963-- 964-- @since 0.2.4.0 965readProcessInterleaved 966 :: MonadIO m 967 => ProcessConfig stdin stdoutIgnored stderrIgnored 968 -> m (ExitCode, L.ByteString) 969readProcessInterleaved pc = 970 liftIO $ 971 withProcessInterleave pc $ \p -> 972 atomically $ (,) 973 <$> waitExitCodeSTM p 974 <*> getStdout p 975 976-- | Same as 'readProcessInterleaved', but instead of returning the 'ExitCode', 977-- checks it with 'checkExitCode'. 978-- 979-- Exceptions thrown by this function will include stdout. 980-- 981-- @since 0.2.4.0 982readProcessInterleaved_ 983 :: MonadIO m 984 => ProcessConfig stdin stdoutIgnored stderrIgnored 985 -> m L.ByteString 986readProcessInterleaved_ pc = 987 liftIO $ 988 withProcessInterleave pc $ \p -> atomically $ do 989 stdout' <- getStdout p 990 checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece 991 { eceStdout = stdout' 992 } 993 return stdout' 994 995-- | Run the given process, wait for it to exit, and returns its 996-- 'ExitCode'. 997-- 998-- @since 0.1.0.0 999runProcess :: MonadIO m 1000 => ProcessConfig stdin stdout stderr 1001 -> m ExitCode 1002runProcess pc = liftIO $ withProcess pc waitExitCode 1003 1004-- | Same as 'runProcess', but instead of returning the 1005-- 'ExitCode', checks it with 'checkExitCode'. 1006-- 1007-- @since 0.1.0.0 1008runProcess_ :: MonadIO m 1009 => ProcessConfig stdin stdout stderr 1010 -> m () 1011runProcess_ pc = liftIO $ withProcess pc checkExitCode 1012 1013-- | Wait for the process to exit and then return its 'ExitCode'. 1014-- 1015-- @since 0.1.0.0 1016waitExitCode :: MonadIO m => Process stdin stdout stderr -> m ExitCode 1017waitExitCode = liftIO . atomically . waitExitCodeSTM 1018 1019-- | Same as 'waitExitCode', but in 'STM'. 1020-- 1021-- @since 0.1.0.0 1022waitExitCodeSTM :: Process stdin stdout stderr -> STM ExitCode 1023waitExitCodeSTM = readTMVar . pExitCode 1024 1025-- | Check if a process has exited and, if so, return its 'ExitCode'. 1026-- 1027-- @since 0.1.0.0 1028getExitCode :: MonadIO m => Process stdin stdout stderr -> m (Maybe ExitCode) 1029getExitCode = liftIO . atomically . getExitCodeSTM 1030 1031-- | Same as 'getExitCode', but in 'STM'. 1032-- 1033-- @since 0.1.0.0 1034getExitCodeSTM :: Process stdin stdout stderr -> STM (Maybe ExitCode) 1035getExitCodeSTM = tryReadTMVar . pExitCode 1036 1037-- | Wait for a process to exit, and ensure that it exited 1038-- successfully. If not, throws an 'ExitCodeException'. 1039-- 1040-- Exceptions thrown by this function will not include stdout or stderr (This prevents unbounded memory usage from reading them into memory). 1041-- However, some callers such as 'readProcess_' catch the exception, add the stdout and stderr, and rethrow. 1042-- 1043-- @since 0.1.0.0 1044checkExitCode :: MonadIO m => Process stdin stdout stderr -> m () 1045checkExitCode = liftIO . atomically . checkExitCodeSTM 1046 1047-- | Same as 'checkExitCode', but in 'STM'. 1048-- 1049-- @since 0.1.0.0 1050checkExitCodeSTM :: Process stdin stdout stderr -> STM () 1051checkExitCodeSTM p = do 1052 ec <- readTMVar (pExitCode p) 1053 case ec of 1054 ExitSuccess -> return () 1055 _ -> throwSTM ExitCodeException 1056 { eceExitCode = ec 1057 , eceProcessConfig = clearStreams (pConfig p) 1058 , eceStdout = L.empty 1059 , eceStderr = L.empty 1060 } 1061 1062-- | Internal 1063clearStreams :: ProcessConfig stdin stdout stderr -> ProcessConfig () () () 1064clearStreams pc = pc 1065 { pcStdin = inherit 1066 , pcStdout = inherit 1067 , pcStderr = inherit 1068 } 1069 1070-- | Get the child's standard input stream value. 1071-- 1072-- @since 0.1.0.0 1073getStdin :: Process stdin stdout stderr -> stdin 1074getStdin = pStdin 1075 1076-- | Get the child's standard output stream value. 1077-- 1078-- @since 0.1.0.0 1079getStdout :: Process stdin stdout stderr -> stdout 1080getStdout = pStdout 1081 1082-- | Get the child's standard error stream value. 1083-- 1084-- @since 0.1.0.0 1085getStderr :: Process stdin stdout stderr -> stderr 1086getStderr = pStderr 1087 1088-- | Exception thrown by 'checkExitCode' in the event of a non-success 1089-- exit code. Note that 'checkExitCode' is called by other functions 1090-- as well, like 'runProcess_' or 'readProcess_'. 1091-- 1092-- Note that several functions that throw an 'ExitCodeException' intentionally do not populate 'eceStdout' or 'eceStderr'. 1093-- This prevents unbounded memory usage for large stdout and stderrs. 1094-- 1095-- @since 0.1.0.0 1096data ExitCodeException = ExitCodeException 1097 { eceExitCode :: ExitCode 1098 , eceProcessConfig :: ProcessConfig () () () 1099 , eceStdout :: L.ByteString 1100 , eceStderr :: L.ByteString 1101 } 1102 deriving Typeable 1103instance Exception ExitCodeException 1104instance Show ExitCodeException where 1105 show ece = concat 1106 [ "Received " 1107 , show (eceExitCode ece) 1108 , " when running\n" 1109 -- Too much output for an exception if we show the modified 1110 -- environment, so hide it 1111 , show (eceProcessConfig ece) { pcEnv = Nothing } 1112 , if L.null (eceStdout ece) 1113 then "" 1114 else "Standard output:\n\n" ++ L8.unpack (eceStdout ece) 1115 , if L.null (eceStderr ece) 1116 then "" 1117 else "Standard error:\n\n" ++ L8.unpack (eceStderr ece) 1118 ] 1119 1120-- | Wrapper for when an exception is thrown when reading from a child 1121-- process, used by 'byteStringOutput'. 1122-- 1123-- @since 0.1.0.0 1124data ByteStringOutputException = ByteStringOutputException SomeException (ProcessConfig () () ()) 1125 deriving (Show, Typeable) 1126instance Exception ByteStringOutputException 1127 1128-- | Take 'System.Process.ProcessHandle' out of the 'Process'. 1129-- This method is needed in cases one need to use low level functions 1130-- from the @process@ package. Use cases for this method are: 1131-- 1132-- 1. Send a special signal to the process. 1133-- 2. Terminate the process group instead of terminating single process. 1134-- 3. Use platform specific API on the underlying process. 1135-- 1136-- This method is considered unsafe because the actions it performs on 1137-- the underlying process may overlap with the functionality that 1138-- @typed-process@ provides. For example the user should not call 1139-- 'System.Process.waitForProcess' on the process handle as eiter 1140-- 'System.Process.waitForProcess' or 'stopProcess' will lock. 1141-- Additionally, even if process was terminated by the 1142-- 'System.Process.terminateProcess' or by sending signal, 1143-- 'stopProcess' should be called either way in order to cleanup resources 1144-- allocated by the @typed-process@. 1145-- 1146-- @since 0.1.1 1147unsafeProcessHandle :: Process stdin stdout stderr -> P.ProcessHandle 1148unsafeProcessHandle = pHandle 1149 1150bracket :: MonadUnliftIO m => IO a -> (a -> IO b) -> (a -> m c) -> m c 1151bracket before after thing = withRunInIO $ \run -> E.bracket before after (run . thing) 1152 1153finally :: MonadUnliftIO m => m a -> IO () -> m a 1154finally thing after = withRunInIO $ \run -> E.finally (run thing) after 1155