my pipe trick didn't work; fallback to NoBuffering

Not sure what the problem was, but it hung. Also though, I noticed that
stdin was still open when git fetch was run, so if git fetch itself
decided to read from stdin, it would mess up the protocol forwarding.
While git fetch should never read from stdin, that was reason enough to
fall back to plan B.

1 files changed, 7 insertions, 3 deletions

diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs
index e90155f3..ae7e0404 100644
--- a/src/Propellor/Protocol.hs
+++ b/src/Propellor/Protocol.hs
@@ -53,7 +53,11 @@ sendMarked' h marker s = do
 	hFlush h
 
 getMarked :: Handle -> Marker -> IO (Maybe String)
-getMarked h marker = go =<< catchMaybeIO (hGetLine h)
+getMarked h marker = do
+	-- Avoid buffering anything in Handle, so that the data after
+	-- the marker will be available to be read from the underlying Fd.
+	hSetBuffering stdin NoBuffering
+	go =<< catchMaybeIO (hGetLine h)
   where
 	go Nothing = return Nothing
 	go (Just l) = case fromMarked marker l of
@@ -65,8 +69,8 @@ getMarked h marker = go =<< catchMaybeIO (hGetLine h)
 			debug ["received marked", marker]
 			return (Just v)
 
-req :: Stage -> Marker -> (String -> IO ()) -> IO ()
-req stage marker a = do
+reqMarked :: Stage -> Marker -> (String -> IO ()) -> IO ()
+reqMarked stage marker a = do
 	debug ["requested marked", marker]
 	sendMarked' stdout statusMarker (show stage)
 	maybe noop a =<< getMarked stdin marker