finally cracked it!

A newline was slipping in and messing up the git protocol.

src/Propellor/CmdLine.hs

@@ -216,15 +216,11 @@ spin hn hst = do
 					loop
 				Just NeedGitPush -> do
 					sendMarked toh gitPushMarker ""
-					void $ hGetLine fromh
 					let p = (proc "git" ["upload-pack", "."])
 						{ std_in = UseHandle fromh
 						, std_out = UseHandle toh
 						}
 					(Nothing, Nothing, Nothing, h) <- createProcess p
-					{-forever $ do
-						b <- B.hGetSome fromh 40960
-						hPutStrLn stderr $ show ("<<<", b)-}
 					unlessM ((==) ExitSuccess <$> waitForProcess h) $
 						errorMessage "git upload-pack failed"
 					-- no more protocol possible after
@@ -330,7 +326,6 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout
 		hSetBinaryMode fromh True
 		hSetBinaryMode toh True
 		b <- B.hGetSome fromh 40960
-		hPutStrLn stderr $ show ("from", fromh, "to", toh, b)
 		if B.null b
 			then do
 				hClose fromh

src/Propellor/Protocol.hs

@@ -1,7 +1,7 @@
 -- | This is a simple line-based protocol used for communication between
 -- a local and remote propellor. It's sent over a ssh channel, and lines of
 -- the protocol can be interspersed with other, non-protocol lines
--- that should just be passed through to be displayed.
+-- that should be ignored.
 
 module Propellor.Protocol where
 
@@ -48,9 +48,7 @@ getMarked h marker = go =<< catchMaybeIO (hGetLine h)
   where
 	go Nothing = return Nothing
 	go (Just l) = case fromMarked marker l of
-		Nothing -> do
-			putStrLn l
-			getMarked h marker
+		Nothing -> getMarked h marker
 		Just v -> return (Just v)
 
 req :: Stage -> Marker -> (String -> IO ()) -> IO ()