Merge branch 'joeyconfig'

3 files changed, 20 insertions, 23 deletions

diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
index d3550e88..a13734b4 100644
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -6,8 +6,6 @@ import System.Directory
 import Data.Maybe
 import Data.List.Utils
 import Control.Monad
-import System.Console.Concurrent
-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
 import Control.Applicative
 import Prelude
 
@@ -16,6 +14,7 @@ import Propellor.Message
 import Propellor.Git.Config
 import Utility.SafeCommand
 import Utility.Process
+import Utility.Process.NonConcurrent
 import Utility.Monad
 import Utility.Misc
 import Utility.Tmp
@@ -144,12 +143,7 @@ gitCommit msg ps = do
 	let ps' = Param "commit" : ps ++
 		maybe [] (\m -> [Param "-m", Param m]) msg
 	ps'' <- gpgSignParams ps'
-	if isNothing msg
-		then do
-			(_, _, _, ConcurrentProcessHandle p) <- createProcessForeground $
-				proc "git" (toCommand ps'')
-			checkSuccessProcess p
-		else boolSystem "git" ps''
+	boolSystemNonConcurrent "git" ps''
 
 gpgDecrypt :: FilePath -> IO String
 gpgDecrypt f = do
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 2ed75e33..ac7b00d3 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -34,8 +34,6 @@ import "mtl" Control.Monad.Reader
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
-import System.Console.Concurrent
-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
 import Control.Applicative
 import Data.Monoid
 import Prelude
@@ -52,12 +50,12 @@ import Utility.PartialPrelude
 import Utility.Exception
 import Utility.Tmp
 import Utility.SafeCommand
+import Utility.Process.NonConcurrent
 import Utility.Misc
 import Utility.FileMode
 import Utility.Env
 import Utility.Table
 import Utility.FileSystemEncoding
-import Utility.Process
 
 -- | Allows a Property to access the value of a specific PrivDataField,
 -- for use in a specific Context or HostContext.
@@ -196,8 +194,7 @@ editPrivData field context = do
 		hClose th
 		maybe noop (\p -> writeFileProtected' f (`L.hPut` privDataByteString p)) v
 		editor <- getEnvDefault "EDITOR" "vi"
-		(_, _, _, ConcurrentProcessHandle p) <- createProcessForeground $ proc editor [f]
-		unlessM (checkSuccessProcess p) $
+		unlessM (boolSystemNonConcurrent editor [File f]) $
 			error "Editor failed; aborting."
 		PrivData <$> readFile f
 	setPrivDataTo field context v'
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 495ebaf4..83654105 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -30,6 +30,7 @@ import Propellor.Types.Info
 import qualified Propellor.Shim as Shim
 import Utility.FileMode
 import Utility.SafeCommand
+import Utility.Process.NonConcurrent
 
 commitSpin :: IO ()
 commitSpin = do
@@ -59,7 +60,7 @@ commitSpin = do
 	-- us needing to send stuff directly to the remote host.
 	whenM hasOrigin $
 		void $ actionMessage "Push to central git repository" $
-			boolSystem "git" [Param "push"]
+			boolSystemNonConcurrent "git" [Param "push"]
 
 spin :: Maybe HostName -> HostName -> Host -> IO ()
 spin = spin' Nothing
@@ -83,7 +84,7 @@ spin' mprivdata relay target hst = do
 		=<< getprivdata
 
 	-- And now we can run it.
-	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
+	unlessM (boolSystemNonConcurrent "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
 		error "remote propellor failed"
   where
 	hn = fromMaybe target relay
@@ -187,9 +188,9 @@ update forhost = do
 			hClose stdout
 			-- Not using git pull because git 2.5.0 badly
 			-- broke its option parser.
-			unlessM (boolSystem "git" (pullparams hin hout)) $
+			unlessM (boolSystemNonConcurrent "git" (pullparams hin hout)) $
 				errorMessage "git fetch from client failed"
-			unlessM (boolSystem "git" [Param "merge", Param "FETCH_HEAD"]) $
+			unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $
 				errorMessage "git merge from client failed"
   where
 	pullparams hin hout =
@@ -212,8 +213,13 @@ updateServer
 	-> CreateProcess
 	-> PrivMap
 	-> IO ()
-updateServer target relay hst connect haveprecompiled privdata =
-	withIOHandles createProcessSuccess connect go
+updateServer target relay hst connect haveprecompiled privdata = do
+	(Just toh, Just fromh, _, pid) <- createProcessNonConcurrent $ connect
+		{ std_in = CreatePipe
+		, std_out = CreatePipe
+		}
+	go (toh, fromh)
+	forceSuccessProcess' connect =<< waitForProcessNonConcurrent pid
   where
 	hn = fromMaybe target relay
 
@@ -276,8 +282,8 @@ sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
 	cacheparams <- sshCachingParams hn
 	withTmpFile "propellor.git" $ \tmp _ -> allM id
 		[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
-		, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
-		, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
+		, boolSystemNonConcurrent "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
+		, boolSystemNonConcurrent "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
 		]
   where
 	remotebundle = "/usr/local/propellor.git"
@@ -313,8 +319,8 @@ sendPrecompiled hn = void $ actionMessage "Uploading locally compiled propellor
 		withTmpFile "propellor.tar." $ \tarball _ -> allM id
 			[ boolSystem "strip" [File me]
 			, boolSystem "tar" [Param "czf", File tarball, File shimdir]
-			, boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]
-			, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
+			, boolSystemNonConcurrent "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]
+			, boolSystemNonConcurrent "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
 			]
 
 	remotetarball = "/usr/local/propellor.tar"