add safeSystem

This is more safe than System.Cmd.Utils.safeSystem, since it does not throw
an error on nonzero exit status.
This commit is contained in:
Joey Hess 2011-11-09 17:28:35 -04:00
parent 8ce7e73f74
commit 2934a65ac5
2 changed files with 16 additions and 6 deletions

View file

@ -33,7 +33,7 @@ import Data.String.Utils
import System.Path import System.Path
import System.FilePath import System.FilePath
import System.Directory import System.Directory
import System.Cmd.Utils import System.Cmd.Utils hiding (safeSystem)
import System.IO hiding (FilePath) import System.IO hiding (FilePath)
import System.Posix.Files import System.Posix.Files
import System.Posix.IO import System.Posix.IO

View file

@ -13,6 +13,7 @@ import System.Posix.Process hiding (executeFile)
import System.Posix.Signals import System.Posix.Signals
import Data.String.Utils import Data.String.Utils
import System.Log.Logger import System.Log.Logger
import Control.Applicative
{- A type for parameters passed to a shell command. A command can {- A type for parameters passed to a shell command. A command can
- be passed either some Params (multiple parameters can be included, - be passed either some Params (multiple parameters can be included,
@ -36,14 +37,23 @@ toCommand = (>>= unwrap)
{- Run a system command, and returns True or False {- Run a system command, and returns True or False
- if it succeeded or failed. - if it succeeded or failed.
-
- SIGINT(ctrl-c) is allowed to propigate and will terminate the program.
-} -}
boolSystem :: FilePath -> [CommandParam] -> IO Bool boolSystem :: FilePath -> [CommandParam] -> IO Bool
boolSystem command params = boolSystemEnv command params Nothing boolSystem command params = boolSystemEnv command params Nothing
boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
boolSystemEnv command params env = do boolSystemEnv command params env = dispatch <$> safeSystemEnv command params env
where
dispatch ExitSuccess = True
dispatch _ = False
{- Runs a system command, returning the exit status. -}
safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
safeSystem command params = safeSystemEnv command params Nothing
{- 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
-- Going low-level because all the high-level system functions -- Going low-level because all the high-level system functions
-- block SIGINT etc. We need to block SIGCHLD, but allow -- block SIGINT etc. We need to block SIGCHLD, but allow
-- SIGINT to do its default program termination. -- SIGINT to do its default program termination.
@ -55,8 +65,8 @@ boolSystemEnv command params env = do
mps <- getProcessStatus True False childpid mps <- getProcessStatus True False childpid
restoresignals oldint oldset restoresignals oldint oldset
case mps of case mps of
Just (Exited ExitSuccess) -> return True Just (Exited code) -> return code
_ -> return False _ -> error $ "unknown error running " ++ command
where where
restoresignals oldint oldset = do restoresignals oldint oldset = do
_ <- installHandler sigINT oldint Nothing _ <- installHandler sigINT oldint Nothing