From 46076e9a37efad076125f1a8d3c4eff745f6fde9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 13:29:50 -0400
Subject: reorg and clean up bootstrap protocol

---
 src/Propellor/Protocol.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)
 create mode 100644 src/Propellor/Protocol.hs

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
new file mode 100644
index 00000000..a1643187
--- /dev/null
+++ b/src/Propellor/Protocol.hs
@@ -0,0 +1,47 @@
+-- | 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.
+
+module Propellor.Protocol where
+
+import Data.List
+
+import Propellor
+
+data BootStrapStatus = Ready | NeedGitClone
+	deriving (Read, Show, Eq)
+
+type Marker = String
+type Marked = String
+
+statusMarker :: Marker
+statusMarker = "STATUS"
+
+privDataMarker :: String
+privDataMarker = "PRIVDATA "
+
+toMarked :: Marker -> String -> String
+toMarked marker = intercalate "\n" . map (marker ++) . lines
+
+sendMarked :: Handle -> Marker -> String -> IO ()
+sendMarked h marker s = do
+	-- Prefix string with newline because sometimes a
+	-- incomplete line is output.
+	hPutStrLn h ("\n" ++ toMarked marker s)
+	hFlush h
+
+fromMarked :: Marker -> Marked -> Maybe String
+fromMarked marker s
+	| marker `isPrefixOf` s = Just $ drop (length marker) s
+	| otherwise = Nothing
+
+getMarked :: Handle -> Marker -> IO (Maybe String)
+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
+		Just v -> return (Just v)
-- 
cgit v1.3-2-g0d8e


From 9463963d855d6a19d423598f668b8627dd669a30 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 13:32:33 -0400
Subject: reorg

---
 src/Propellor/Protocol.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index a1643187..669f41b6 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -24,18 +24,19 @@ privDataMarker = "PRIVDATA "
 toMarked :: Marker -> String -> String
 toMarked marker = intercalate "\n" . map (marker ++) . lines
 
+fromMarked :: Marker -> Marked -> Maybe String
+fromMarked marker s
+	| marker `isPrefixOf` s = Just $ drop (length marker) s
+	| otherwise = Nothing
+
 sendMarked :: Handle -> Marker -> String -> IO ()
 sendMarked h marker s = do
 	-- Prefix string with newline because sometimes a
-	-- incomplete line is output.
+	-- incomplete line has been output, and the marker needs to
+	-- come at the start of a line.
 	hPutStrLn h ("\n" ++ toMarked marker s)
 	hFlush h
 
-fromMarked :: Marker -> Marked -> Maybe String
-fromMarked marker s
-	| marker `isPrefixOf` s = Just $ drop (length marker) s
-	| otherwise = Nothing
-
 getMarked :: Handle -> Marker -> IO (Maybe String)
 getMarked h marker = go =<< catchMaybeIO (hGetLine h)
   where
-- 
cgit v1.3-2-g0d8e


From 45f8ebf0ef0d152af3b3c77492e4a5e442e304b6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 13:59:50 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs  | 71 ++++++++++++++++++++++++++++++-----------------
 src/Propellor/Protocol.hs |  5 +++-
 2 files changed, 49 insertions(+), 27 deletions(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index c133b7d8..bc420dd9 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -196,22 +196,28 @@ spin hn hst = do
 	hostprivdata = show . filterPrivData hst <$> decryptPrivData
 
 	go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
-		status <- getMarked fromh statusMarker
-		case readish =<< status of
-			Just Ready -> do
-				sendprivdata toh "privdata" privDataMarker privdata
-				hClose toh
-				
-				-- Display remaining output.
-				void $ tryIO $ forever $
-					showremote =<< hGetLine fromh
-				hClose fromh
-			Just NeedGitClone -> do
-				hClose toh
-				hClose fromh
-				sendGitClone hn =<< getUrl
-				go cacheparams privdata
-			Nothing -> error $ "protocol error; received: " ++ show status
+		let comm = do
+			status <- getMarked fromh statusMarker
+			case readish =<< status of
+				Just RepoUrl -> do
+					sendMarked toh repoUrlMarker
+						=<< (fromMaybe "" <$> getRepoUrl)
+					comm
+				Just Ready -> do
+					sendprivdata toh "privdata" privDataMarker privdata
+					hClose toh
+					
+					-- Display remaining output.
+					void $ tryIO $ forever $
+						showremote =<< hGetLine fromh
+					hClose fromh
+				Just NeedGitClone -> do
+					hClose toh
+					hClose fromh
+					sendGitClone hn
+					go cacheparams privdata
+				Nothing -> error $ "protocol error; received: " ++ show status
+		comm
 	
 	user = "root@"++hn
 
@@ -243,8 +249,8 @@ spin hn hst = do
 			return True
 
 -- Initial git clone, used for bootstrapping.
-sendGitClone :: HostName -> String -> IO ()
-sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
+sendGitClone :: HostName -> IO ()
+sendGitClone hn = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
 	branch <- getCurrentBranch
 	cacheparams <- sshCachingParams hn
 	withTmpFile "propellor.git" $ \tmp _ -> allM id
@@ -260,25 +266,38 @@ sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn)
 		, "git checkout -b " ++ branch
 		, "git remote rm origin"
 		, "rm -f " ++ remotebundle
-		, "git remote add origin " ++ url
-		-- same as --set-upstream-to, except origin branch
-		-- may not have been pulled yet
-		, "git config branch."++branch++".remote origin"
-		, "git config branch."++branch++".merge refs/heads/"++branch
 		]
 
+-- Called "boot" for historical reasons, but what this really does is
+-- update the privdata, repo url, and git repo over the ssh connection from the
+-- client that ran propellor --spin.
 boot :: IO ()
 boot = do
+	sendMarked stdout statusMarker (show RepoUrl)
+	maybe noop setRepoUrl
+		=<< getMarked stdin repoUrlMarker
 	sendMarked stdout statusMarker (show Ready)
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal)
 		=<< getMarked stdin privDataMarker
 
-getUrl :: IO String
-getUrl = maybe nourl return =<< getM get urls
+setRepoUrl :: String -> IO ()
+setRepoUrl "" = return ()
+setRepoUrl url = do
+	rs <- lines <$> readProcess "git" ["remote"]
+	let subcmd = if "origin" `elem` rs then "set-url" else "add"
+	void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]
+	-- same as --set-upstream-to, except origin branch
+	-- may not have been pulled yet
+	branch <- getCurrentBranch
+	let branchval s = "branch." ++ branch ++ "." ++ s
+	void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
+	void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
+
+getRepoUrl :: IO (Maybe String)
+getRepoUrl = getM get urls
   where
 	urls = ["remote.deploy.url", "remote.origin.url"]
-	nourl = errorMessage $ "Cannot find deploy url in " ++ show urls
 	get u = do
 		v <- catchMaybeIO $ 
 			takeWhile (/= '\n') 
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index 669f41b6..4dc7e6bb 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -9,7 +9,7 @@ import Data.List
 
 import Propellor
 
-data BootStrapStatus = Ready | NeedGitClone
+data BootStrapStatus = Ready | NeedGitClone | RepoUrl
 	deriving (Read, Show, Eq)
 
 type Marker = String
@@ -21,6 +21,9 @@ statusMarker = "STATUS"
 privDataMarker :: String
 privDataMarker = "PRIVDATA "
 
+repoUrlMarker :: String
+repoUrlMarker = "REPOURL "
+
 toMarked :: Marker -> String -> String
 toMarked marker = intercalate "\n" . map (marker ++) . lines
 
-- 
cgit v1.3-2-g0d8e


From aa9aa832d216db71f363ad71a1ee13b5d8eaec5a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 14:09:18 -0400
Subject: refactor

---
 src/Propellor/CmdLine.hs  | 41 ++++++++++++++++++++++-------------------
 src/Propellor/Protocol.hs |  7 ++++++-
 2 files changed, 28 insertions(+), 20 deletions(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index bc420dd9..47df9f99 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -196,28 +196,34 @@ spin hn hst = do
 	hostprivdata = show . filterPrivData hst <$> decryptPrivData
 
 	go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
-		let comm = do
+		let loop = do
 			status <- getMarked fromh statusMarker
 			case readish =<< status of
-				Just RepoUrl -> do
+				Just NeedRepoUrl -> do
 					sendMarked toh repoUrlMarker
 						=<< (fromMaybe "" <$> getRepoUrl)
-					comm
+					loop
+				Just NeedPrivData -> do
+					sendprivdata toh privdata
+					loop
+				Just NeedGitClone -> do
+					hClose toh
+					hClose fromh
+					sendGitClone hn
+					go cacheparams privdata
+				-- Ready is only sent by old versions of
+				-- propellor. They expect to get privdata,
+				-- and then no more protocol communication.
 				Just Ready -> do
-					sendprivdata toh "privdata" privDataMarker privdata
+					sendprivdata toh privdata
 					hClose toh
 					
 					-- Display remaining output.
 					void $ tryIO $ forever $
 						showremote =<< hGetLine fromh
 					hClose fromh
-				Just NeedGitClone -> do
-					hClose toh
-					hClose fromh
-					sendGitClone hn
-					go cacheparams privdata
 				Nothing -> error $ "protocol error; received: " ++ show status
-		comm
+		loop
 	
 	user = "root@"++hn
 
@@ -243,9 +249,9 @@ spin hn hst = do
 
 	showremote s = putStrLn s
 
-	sendprivdata toh desc marker s = void $
-		actionMessage ("Sending " ++ desc ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do
-			sendMarked toh marker s
+	sendprivdata toh privdata = void $
+		actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do
+			sendMarked toh privDataMarker privdata
 			return True
 
 -- Initial git clone, used for bootstrapping.
@@ -273,13 +279,10 @@ sendGitClone hn = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
 -- client that ran propellor --spin.
 boot :: IO ()
 boot = do
-	sendMarked stdout statusMarker (show RepoUrl)
-	maybe noop setRepoUrl
-		=<< getMarked stdin repoUrlMarker
-	sendMarked stdout statusMarker (show Ready)
+	req NeedRepoUrl repoUrlMarker setRepoUrl
 	makePrivDataDir
-	maybe noop (writeFileProtected privDataLocal)
-		=<< getMarked stdin privDataMarker
+	req NeedPrivData privDataMarker $
+		writeFileProtected privDataLocal
 
 setRepoUrl :: String -> IO ()
 setRepoUrl "" = return ()
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index 4dc7e6bb..164f6db6 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -9,7 +9,7 @@ import Data.List
 
 import Propellor
 
-data BootStrapStatus = Ready | NeedGitClone | RepoUrl
+data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData
 	deriving (Read, Show, Eq)
 
 type Marker = String
@@ -49,3 +49,8 @@ getMarked h marker = go =<< catchMaybeIO (hGetLine h)
 			putStrLn l
 			getMarked h marker
 		Just v -> return (Just v)
+
+req :: Stage -> Marker -> (String -> IO ()) -> IO ()
+req stage marker a = do
+	sendMarked stdout statusMarker (show stage)
+	maybe noop a =<< getMarked stdin marker
-- 
cgit v1.3-2-g0d8e


From bad6a8c3e641894c900f195c23092a528853c904 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 15:05:15 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs  | 32 ++++++++++++++++++++++++++++++++
 src/Propellor/Protocol.hs |  5 ++++-
 src/Propellor/Types.hs    |  2 ++
 3 files changed, 38 insertions(+), 1 deletion(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 21ae1c42..49c1dc4d 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -11,6 +11,8 @@ import System.PosixCompat
 import Control.Exception (bracket)
 import System.Posix.IO
 import Data.Time.Clock.POSIX
+import Control.Concurrent.Async
+import qualified Data.ByteString as B
 
 import Propellor
 import Propellor.Protocol
@@ -54,6 +56,7 @@ processCmdLine = go =<< getArgs
 		Nothing -> errorMessage "--continue serialization failure"
 	go ("--chain":h:[]) = return $ Chain h
 	go ("--docker":h:[]) = return $ Docker h
+	go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout)
 	go (h:[])
 		| "--" `isPrefixOf` h = usage
 		| otherwise = return $ Run h
@@ -86,6 +89,7 @@ defaultMain hostlist = do
 		r <- runPropellor h $ ensureProperties $ hostProperties h
 		putStrLn $ "\n" ++ show r
 	go _ (Docker hn) = Docker.chain hn
+	go _ (GitPush fin fout) = gitPush fin fout
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
 	go False (Spin hn) = withhost hn $ spin hn
@@ -206,6 +210,12 @@ spin hn hst = do
 				Just NeedPrivData -> do
 					sendprivdata toh privdata
 					loop
+				Just NeedGitPush -> do
+					sendMarked toh gitPushMarker ""
+					unlessM (boolSystem "git" [Param "send-pack", Param "--thin", Param "."]) $
+						warningMessage "git send-pack failed"
+					-- no more protocol possible after
+					-- git push
 				Just NeedGitClone -> do
 					hClose toh
 					hClose fromh
@@ -283,6 +293,28 @@ boot = do
 	makePrivDataDir
 	req NeedPrivData privDataMarker $
 		writeFileProtected privDataLocal
+	req NeedGitPush gitPushMarker $ \_ -> do
+		hin <- dup stdInput
+		hClose stdin
+		hout <- dup stdOutput
+		hClose stdout
+		unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $
+			warningMessage "git pull from client failed"
+
+-- Shim for git push over the propellor ssh channel.
+-- Reads from stdin and sends it to the first fd;
+-- reads from the second fd and sends it to stdout.
+gitPush :: Fd -> Fd -> IO ()
+gitPush hin hout = do
+	print ("gitPush", hin, hout)
+	void $ fromstdin `concurrently` tostdout
+  where
+	fromstdin = do
+		h <- fdToHandle hin
+		B.getContents >>= B.hPut h
+	tostdout = do
+		h <- fdToHandle hout
+		B.hGetContents h >>= B.putStr
 
 setRepoUrl :: String -> IO ()
 setRepoUrl "" = return ()
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index 164f6db6..c5ebaab9 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -9,7 +9,7 @@ import Data.List
 
 import Propellor
 
-data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData
+data Stage = Ready | NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush
 	deriving (Read, Show, Eq)
 
 type Marker = String
@@ -24,6 +24,9 @@ privDataMarker = "PRIVDATA "
 repoUrlMarker :: String
 repoUrlMarker = "REPOURL "
 
+gitPushMarker :: String
+gitPushMarker = "GITPUSH"
+
 toMarked :: Marker -> String -> String
 toMarked marker = intercalate "\n" . map (marker ++) . lines
 
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index cf16099a..72ccd228 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -28,6 +28,7 @@ module Propellor.Types
 import Data.Monoid
 import Control.Applicative
 import System.Console.ANSI
+import System.Posix.Types
 import "mtl" Control.Monad.Reader
 import "MonadCatchIO-transformers" Control.Monad.CatchIO
 
@@ -146,4 +147,5 @@ data CmdLine
 	| Chain HostName
 	| Boot HostName
 	| Docker HostName
+	| GitPush Fd Fd
 	deriving (Read, Show, Eq)
-- 
cgit v1.3-2-g0d8e


From 781e35a333d1ca930f9d94c716104c90bf28970d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 15:13:37 -0400
Subject: protocol is one line response, not multiline

The privdata is shown, so contains no literal newlines, so that's ok.
---
 src/Propellor/Protocol.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index c5ebaab9..6394fc71 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -28,7 +28,7 @@ gitPushMarker :: String
 gitPushMarker = "GITPUSH"
 
 toMarked :: Marker -> String -> String
-toMarked marker = intercalate "\n" . map (marker ++) . lines
+toMarked marker = ++
 
 fromMarked :: Marker -> Marked -> Maybe String
 fromMarked marker s
-- 
cgit v1.3-2-g0d8e


From 9dfae00bd3949e4e23d4c24c7aa7375fdff4c9fb Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 15:15:56 -0400
Subject: propellor spin

---
 src/Propellor/Protocol.hs | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index 6394fc71..bdea7d10 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -28,7 +28,7 @@ gitPushMarker :: String
 gitPushMarker = "GITPUSH"
 
 toMarked :: Marker -> String -> String
-toMarked marker = ++
+toMarked = (++)
 
 fromMarked :: Marker -> Marked -> Maybe String
 fromMarked marker s
@@ -47,11 +47,13 @@ getMarked :: Handle -> Marker -> IO (Maybe String)
 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
-		Just v -> return (Just v)
+	go (Just l) = do
+		hPutStrLn stderr $ show ("got ", l)
+		case fromMarked marker l of
+			Nothing -> do
+				putStrLn l
+				getMarked h marker
+			Just v -> return (Just v)
 
 req :: Stage -> Marker -> (String -> IO ()) -> IO ()
 req stage marker a = do
-- 
cgit v1.3-2-g0d8e


From 573c6ab4b8800e40bb749aa25eef9bc5fd2132c6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 15:17:12 -0400
Subject: propellor spin

---
 src/Propellor/CmdLine.hs  |  3 +--
 src/Propellor/Protocol.hs | 12 +++++-------
 2 files changed, 6 insertions(+), 9 deletions(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 744a97ad..95387b83 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -202,7 +202,6 @@ spin hn hst = do
 	go cacheparams privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
 		let loop = do
 			status <- getMarked fromh statusMarker
-			print (">>", status)
 			case readish =<< status of
 				Just NeedRepoUrl -> do
 					sendMarked toh repoUrlMarker
@@ -299,7 +298,7 @@ boot = do
 		hClose stdin
 		hout <- dup stdOutput
 		hClose stdout
-		unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $
+		unlessM (boolSystem "git" [Param "pull", Param $ "--upload=pack=./propellor --gitpush " ++ show hin ++ " " ++ show hout, Param "."]) $
 			warningMessage "git pull from client failed"
 
 -- Shim for git push over the propellor ssh channel.
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index bdea7d10..7bbf472d 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -47,13 +47,11 @@ getMarked :: Handle -> Marker -> IO (Maybe String)
 getMarked h marker = go =<< catchMaybeIO (hGetLine h)
   where
 	go Nothing = return Nothing
-	go (Just l) = do
-		hPutStrLn stderr $ show ("got ", l)
-		case fromMarked marker l of
-			Nothing -> do
-				putStrLn l
-				getMarked h marker
-			Just v -> return (Just v)
+	go (Just l) = case fromMarked marker l of
+		Nothing -> do
+			putStrLn l
+			getMarked h marker
+		Just v -> return (Just v)
 
 req :: Stage -> Marker -> (String -> IO ()) -> IO ()
 req stage marker a = do
-- 
cgit v1.3-2-g0d8e


From 511a728b388860e1efe238a5b3dd12f914db2846 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 16:52:01 -0400
Subject: finally cracked it!

A newline was slipping in and messing up the git protocol.
---
 src/Propellor/CmdLine.hs  | 5 -----
 src/Propellor/Protocol.hs | 6 ++----
 2 files changed, 2 insertions(+), 9 deletions(-)

(limited to 'src/Propellor/Protocol.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 0711064d..1345a298 100644
--- a/src/Propellor/CmdLine.hs
+++ b/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
diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index 7bbf472d..99afb31f 100644
--- a/src/Propellor/Protocol.hs
+++ b/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 ()
-- 
cgit v1.3-2-g0d8e