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:
parent
8ce7e73f74
commit
2934a65ac5
2 changed files with 16 additions and 6 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue