From d1da9cf221aeea5c7ac8a313a18b559791a04f12 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 18 Jul 2012 15:30:26 -0400 Subject: switch from System.Cmd.Utils to System.Process Test suite now passes with -threaded! I traced back all the hangs with -threaded to System.Cmd.Utils. It seems it's just crappy/unsafe/outdated, and should not be used. System.Process seems to be the cool new thing, so converted all the code to use it instead. In the process, --debug stopped printing commands it runs. I may try to bring that back later. Note that even SafeSystem was switched to use System.Process. Since that was a modified version of code from System.Cmd.Utils, it needed to be converted too. I also got rid of nearly all calls to forkProcess, and all calls to executeFile, which I'm also doubtful about working well with -threaded. --- Utility/Process.hs | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 Utility/Process.hs (limited to 'Utility/Process.hs') diff --git a/Utility/Process.hs b/Utility/Process.hs new file mode 100644 index 000000000..9f79efa81 --- /dev/null +++ b/Utility/Process.hs @@ -0,0 +1,40 @@ +{- System.Process enhancements + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Process where + +import System.Process +import System.Exit +import System.IO + +import Utility.Misc + +{- Waits for a ProcessHandle, and throws an exception if the process + - did not exit successfully. -} +forceSuccessProcess :: ProcessHandle -> String -> [String] -> IO () +forceSuccessProcess pid cmd args = do + code <- waitForProcess pid + case code of + ExitSuccess -> return () + ExitFailure n -> error $ + cmd ++ " " ++ show args ++ " exited " ++ show n + +{- Like readProcess, but allows specifying the environment, and does + - not mess with stdin. -} +readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String +readProcessEnv cmd args environ = do + (_, Just h, _, pid) + <- createProcess (proc cmd args) + { std_in = Inherit + , std_out = CreatePipe + , std_err = Inherit + , env = environ + } + output <- hGetContentsStrict h + hClose h + forceSuccessProcess pid cmd args + return output -- cgit v1.2.3