2 files changed, 42 insertions, 5 deletions
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index c6699961e..ed02f49e 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -18,6 +18,7 @@ module Utility.Process (
 	readProcessEnv,
 	writeReadProcessEnv,
 	forceSuccessProcess,
+	forceSuccessProcess',
 	checkSuccessProcess,
 	ignoreFailureProcess,
 	createProcessSuccess,
@@ -129,11 +130,12 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do
 -- | Waits for a ProcessHandle, and throws an IOError if the process
 -- did not exit successfully.
 forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
-forceSuccessProcess p pid = do
-	code <- waitForProcess pid
-	case code of
-		ExitSuccess -> return ()
-		ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n
+forceSuccessProcess p pid = waitForProcess pid >>= forceSuccessProcess' p
+
+forceSuccessProcess' :: CreateProcess -> ExitCode -> IO ()
+forceSuccessProcess' _ ExitSuccess = return ()
+forceSuccessProcess' p (ExitFailure n) = fail $
+	showCmd p ++ " exited " ++ show n
 
 -- | Waits for a ProcessHandle and returns True if it exited successfully.
 -- Note that using this with createProcessChecked will throw away
diff --git a/src/Utility/Process/NonConcurrent.hs b/src/Utility/Process/NonConcurrent.hs
new file mode 100644
index 00000000..d25d2a24
--- /dev/null
+++ b/src/Utility/Process/NonConcurrent.hs
@@ -0,0 +1,35 @@
+{- Running processes in the foreground, not via the concurrent-output
+ - layer.
+ -
+ - Avoid using this in propellor properties!
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Process.NonConcurrent where
+
+import System.Process
+import System.Exit
+import System.IO
+import Utility.SafeCommand
+import Control.Applicative
+import Prelude
+
+boolSystemNonConcurrent :: String -> [CommandParam] -> IO Bool
+boolSystemNonConcurrent cmd params = do
+	(Nothing, Nothing, Nothing, p) <- createProcessNonConcurrent $
+		proc cmd (toCommand params)
+	dispatch <$> waitForProcessNonConcurrent p
+  where
+	dispatch ExitSuccess = True
+	dispatch _ = False
+
+createProcessNonConcurrent :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
+createProcessNonConcurrent = createProcess
+
+waitForProcessNonConcurrent  :: ProcessHandle -> IO ExitCode
+waitForProcessNonConcurrent  = waitForProcess