summaryrefslogtreecommitdiff
path: root/Utility/SafeCommand.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-18 15:30:26 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-18 18:00:24 -0400
commitd1da9cf221aeea5c7ac8a313a18b559791a04f12 (patch)
treefe8d7e42efb89441d14ab8d5d71bb8f0f007330b /Utility/SafeCommand.hs
parentfc5652c811a9a644bb8964b3b8c13df24f2ec7c7 (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.hs49
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. -}