diff options
author | 2012-07-18 15:30:26 -0400 | |
---|---|---|
committer | 2012-07-18 18:00:24 -0400 | |
commit | d1da9cf221aeea5c7ac8a313a18b559791a04f12 (patch) | |
tree | fe8d7e42efb89441d14ab8d5d71bb8f0f007330b /Utility/SafeCommand.hs | |
parent | fc5652c811a9a644bb8964b3b8c13df24f2ec7c7 (diff) |
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.
Diffstat (limited to 'Utility/SafeCommand.hs')
-rw-r--r-- | Utility/SafeCommand.hs | 49 |
1 files changed, 9 insertions, 40 deletions
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index 5f6a53e71..47280a40b 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -1,6 +1,6 @@ {- safely running shell commands - - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -8,11 +8,8 @@ module Utility.SafeCommand where import System.Exit -import qualified System.Posix.Process -import System.Posix.Process hiding (executeFile) -import System.Posix.Signals +import System.Process import Data.String.Utils -import System.Log.Logger import Control.Applicative {- A type for parameters passed to a shell command. A command can @@ -42,7 +39,7 @@ boolSystem :: FilePath -> [CommandParam] -> IO Bool boolSystem command params = boolSystemEnv command params Nothing boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool -boolSystemEnv command params env = dispatch <$> safeSystemEnv command params env +boolSystemEnv command params environ = dispatch <$> safeSystemEnv command params environ where dispatch ExitSuccess = True dispatch _ = False @@ -51,41 +48,13 @@ boolSystemEnv command params env = dispatch <$> safeSystemEnv command params env safeSystem :: FilePath -> [CommandParam] -> IO ExitCode safeSystem command params = safeSystemEnv command params Nothing -{- SIGINT(ctrl-c) is allowed to propigate and will terminate the program. -} +{- Unlike many implementations of system, SIGINT(ctrl-c) is allowed + - to propigate and will terminate the program. -} safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode -safeSystemEnv command params env = do - putStrLn "safeSystemEnv start" - -- Going low-level because all the high-level system functions - -- block SIGINT etc. We need to block SIGCHLD, but allow - -- SIGINT to do its default program termination. - let sigset = addSignal sigCHLD emptySignalSet - oldint <- installHandler sigINT Default Nothing - oldset <- getSignalMask - blockSignals sigset - childpid <- forkProcess $ childaction oldint oldset - mps <- getProcessStatus True False childpid - restoresignals oldint oldset - case mps of - Just (Exited code) -> do - putStrLn "safeSystemEnv end" - return code - _ -> error $ "unknown error running " ++ command - where - restoresignals oldint oldset = do - _ <- installHandler sigINT oldint Nothing - setSignalMask oldset - childaction oldint oldset = do - restoresignals oldint oldset - executeFile command True (toCommand params) env - -{- executeFile with debug logging -} -executeFile :: FilePath -> Bool -> [String] -> Maybe [(String, String)] -> IO () -executeFile c path p e = do - putStrLn "executeFile start" - --debugM "Utility.SafeCommand.executeFile" $ - -- "Running: " ++ c ++ " " ++ show p ++ " " ++ maybe "" show e - System.Posix.Process.executeFile c path p e - putStrLn "executeFile end" +safeSystemEnv command params environ = do + (_, _, _, pid) <- createProcess (proc command $ toCommand params) + { env = environ } + waitForProcess pid {- Escapes a filename or other parameter to be safely able to be exposed to - the shell. -} |