From 53a084632c3ce865877aa205580a5697440cdd8b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 May 2015 12:08:26 -0400 Subject: merge from git-annex --- src/Utility/SafeCommand.hs | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index f44112b8..9eaa5308 100644 --- a/src/Utility/SafeCommand.hs +++ b/src/Utility/SafeCommand.hs @@ -1,6 +1,6 @@ {- safely running shell commands - - - Copyright 2010-2013 Joey Hess + - Copyright 2010-2015 Joey Hess - - License: BSD-2-clause -} @@ -44,23 +44,32 @@ toCommand = concatMap unwrap - if it succeeded or failed. -} boolSystem :: FilePath -> [CommandParam] -> IO Bool -boolSystem command params = boolSystemEnv command params Nothing +boolSystem command params = boolSystem' command params id -boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool -boolSystemEnv command params environ = dispatch <$> safeSystemEnv command params environ +boolSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool +boolSystem' command params mkprocess = dispatch <$> safeSystem' command params mkprocess where dispatch ExitSuccess = True dispatch _ = False +boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool +boolSystemEnv command params environ = boolSystem' command params $ + \p -> p { env = environ } + {- Runs a system command, returning the exit status. -} safeSystem :: FilePath -> [CommandParam] -> IO ExitCode -safeSystem command params = safeSystemEnv command params Nothing +safeSystem command params = safeSystem' command params id -safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode -safeSystemEnv command params environ = do - (_, _, _, pid) <- createProcess (proc command $ toCommand params) - { env = environ } +safeSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO ExitCode +safeSystem' command params mkprocess = do + (_, _, _, pid) <- createProcess p waitForProcess pid + where + p = mkprocess $ proc command (toCommand params) + +safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode +safeSystemEnv command params environ = safeSystem' command params $ + \p -> p { env = environ } {- Wraps a shell command line inside sh -c, allowing it to be run in a - login shell that may not support POSIX shell, eg csh. -} -- cgit v1.2.3