module ProcessUtils ( ExitCode(ExitFailure,ExitSuccess) , systemEnv ) where import GHC.IO.Exception ( ioException, IOErrorType(..) ) import System.Process import System.Posix.Signals import System.Process.Internals (runGenProcess_,defaultSignal) import System.Environment import Data.Maybe ( isNothing ) import System.IO.Error ( mkIOError, ioeSetErrorString ) import System.Exit ( ExitCode(..) ) import System.IO -- | systemEnv -- This is like System.Process.system except that it lets you set -- some environment variables. systemEnv :: [(String, String)] -> String -> IO ExitCode systemEnv _ "" = ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command") systemEnv vars cmd = do env0 <- getEnvironment let env1 = filter (isNothing . flip lookup vars . fst) env0 env = vars ++ env1 syncProcess "system" $ (shell cmd) {env=Just env} where -- This is a non-exported function from System.Process syncProcess fun c = do -- The POSIX version of system needs to do some manipulation of signal -- handlers. Since we're going to be synchronously waiting for the child, -- we want to ignore ^C in the parent, but handle it the default way -- in the child (using SIG_DFL isn't really correct, it should be the -- original signal handler, but the GHC RTS will have already set up -- its own handler and we don't want to use that). old_int <- installHandler sigINT Ignore Nothing old_quit <- installHandler sigQUIT Ignore Nothing (_,_,_,p) <- runGenProcess_ fun c (Just defaultSignal) (Just defaultSignal) r <- waitForProcess p _ <- installHandler sigINT old_int Nothing _ <- installHandler sigQUIT old_quit Nothing return r -- | readPipe -- -- This is like System.Process.readProcess but instead of a single -- command with arguments, you pass it a list which it then executes -- piping the the output from the prior command into the input for -- the next command. Like readProcess the next parameter is a string -- which is sent as input into the initial standard in. -- -- > readPipe [("grep",["HostConfig"]),("wc",["-l"]) =<< readFile "input" -- -- is equivalent to shell code: -- -- > grep HostConfig input | wc -l -- readPipe :: [(FilePath,[String])] -> String -> IO String readPipe [(cmd,args)] input = readProcess cmd args input readPipe ((cmd,args):xs) stdin0 = do let p = (shell cmd) { std_in = CreatePipe , std_out = CreatePipe , std_err = CreatePipe , cmdspec = RawCommand cmd args } (Just sinh,Just sout,Just serr, ph) <- createProcess p hPutStr sinh stdin0 hClose sinh readPipe0 xs sout where readPipe0 :: [(FilePath,[String])] -> Handle -> IO String readPipe0 ((cmd,args):xs) stdin0 = do let p = (shell cmd) { std_in = UseHandle stdin0 , std_out = CreatePipe , std_err = CreatePipe , cmdspec = RawCommand cmd args } (Nothing,Just sout,Just serr, ph) <- createProcess p readPipe0 xs sout readPipe0 [] h = hGetContents h