summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Protocol.hs10
-rw-r--r--src/Propellor/Spin.hs22
2 files changed, 15 insertions, 17 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
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index cc5fa0e8..cd964e16 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -178,11 +178,11 @@ getSshTarget target hst
update :: Maybe HostName -> IO ()
update forhost = do
whenM hasGitRepo $
- req NeedRepoUrl repoUrlMarker setRepoUrl
+ reqMarked NeedRepoUrl repoUrlMarker setRepoUrl
makePrivDataDir
createDirectoryIfMissing True (takeDirectory privfile)
- req NeedPrivData privDataMarker $
+ reqMarked NeedPrivData privDataMarker $
writeFileProtected privfile
whenM hasGitRepo $
@@ -350,19 +350,13 @@ spinCommitMessage = "propellor spin"
-- Request that it run git upload-pack, and connect that up to a git fetch
-- to receive the data.
gitPullFromUpdateServer :: IO ()
-gitPullFromUpdateServer = req NeedGitPush gitPushMarker $ \_ -> do
- -- IO involving stdin can cause data to be buffered in the Handle
- -- (even when it's set NoBuffering), but we need to pass a FD to
- -- git fetch containing all of stdin after the gitPushMarker,
- -- including any that has been buffered.
- --
- -- To do so, create a pipe, and forward stdin, including any
- -- buffered part, through it.
- (pread, pwrite) <- System.Posix.IO.createPipe
- hwrite <- fdToHandle pwrite
- _ <- async $ stdin *>* hwrite
- let hin = pread
+gitPullFromUpdateServer = reqMarked NeedGitPush gitPushMarker $ \_ -> do
+ -- Note that this relies on data not being buffered in the stdin
+ -- Handle, since such buffered data would not be available in the
+ -- FD passed to git fetch.
+ hin <- dup stdInput
hout <- dup stdOutput
+ hClose stdin
hClose stdout
-- Not using git pull because git 2.5.0 badly
-- broke its option parser.