From 632137836b39462883483a621f9dd696ce1d73cc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 13 Jul 2017 11:04:14 -0400 Subject: disable buffering earlier The "fatal: Couldn't find remote ref HEAD" persists, and is intermittent so hard to be sure but it seemed that disabling buffering earlier avoided it. Now done first thing on start. I was not able to find anything that reads from stdin other than getMarked, but perhaps there is something.. --- src/Propellor/Protocol.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) (limited to 'src/Propellor/Protocol.hs') diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index ae7e0404..bc8d9327 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -53,11 +53,7 @@ sendMarked' h marker s = do hFlush h getMarked :: Handle -> Marker -> IO (Maybe String) -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) +getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing go (Just l) = case fromMarked marker l of -- cgit v1.2.3 From 043cd2218efb8e3d2f04ae2faff38293a01ed0c5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 13 Jul 2017 11:10:27 -0400 Subject: Revert "disable buffering earlier" This reverts commit 632137836b39462883483a621f9dd696ce1d73cc. Still failing :( Seems that disabling buffering is not the solution. --- src/Propellor/CmdLine.hs | 1 - src/Propellor/Protocol.hs | 6 +++++- src/Propellor/Spin.hs | 13 +++---------- 3 files changed, 8 insertions(+), 12 deletions(-) (limited to 'src/Propellor/Protocol.hs') diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 70bb0bf8..a36ec7f5 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -111,7 +111,6 @@ data CanRebuild = CanRebuild | NoRebuild defaultMain :: [Host] -> IO () defaultMain hostlist = withConcurrentOutput $ do useFileSystemEncoding - updatePrepare Shim.cleanEnv checkDebugMode cmdline <- processCmdLine diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index bc8d9327..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 diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 732ec9b7..7146ad4c 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -5,7 +5,6 @@ module Propellor.Spin ( spin, spin', update, - updatePrepare, gitPushHelper, mergeSpin, ) where @@ -350,20 +349,14 @@ findLastNonSpinCommit = do spinCommitMessage :: String spinCommitMessage = "propellor spin" --- Avoid buffering anything read from stdin, so that --- when gitPullFromUpdateServer runs git fetch, it sees all the data --- it expects to. --- --- Should be called very early in propellor start, before anything reads --- from stdin. -updatePrepare :: IO () -updatePrepare = hSetBuffering stdin NoBuffering - -- Stdin and stdout are connected to the updateServer over ssh. -- Request that it run git upload-pack, and connect that up to a git fetch -- to receive the data. gitPullFromUpdateServer :: IO () 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 -- cgit v1.2.3 From 1555c6f88a0446d3e29149eff8315817696731e1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 13 Jul 2017 11:23:04 -0400 Subject: trying the pipe trick again With some small changes, and debugging. --- src/Propellor/Protocol.hs | 10 +++------- src/Propellor/Spin.hs | 38 ++++++++++++++++++++++++++++++-------- 2 files changed, 33 insertions(+), 15 deletions(-) (limited to 'src/Propellor/Protocol.hs') diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs index ae7e0404..e90155f3 100644 --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -53,11 +53,7 @@ sendMarked' h marker s = do hFlush h getMarked :: Handle -> Marker -> IO (Maybe String) -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) +getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing go (Just l) = case fromMarked marker l of @@ -69,8 +65,8 @@ getMarked h marker = do debug ["received marked", marker] return (Just v) -reqMarked :: Stage -> Marker -> (String -> IO ()) -> IO () -reqMarked stage marker a = do +req :: Stage -> Marker -> (String -> IO ()) -> IO () +req 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 7146ad4c..6b6c6d69 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -181,11 +181,11 @@ getSshTarget target hst update :: Maybe HostName -> IO () update forhost = do whenM hasGitRepo $ - reqMarked NeedRepoUrl repoUrlMarker setRepoUrl + req NeedRepoUrl repoUrlMarker setRepoUrl makePrivDataDir createDirectoryIfMissing True (takeDirectory privfile) - reqMarked NeedPrivData privDataMarker $ + req NeedPrivData privDataMarker $ writeFileProtected privfile whenM hasGitRepo $ @@ -353,18 +353,25 @@ 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 = 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 +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 + forwarder <- async $ stdin *>*! hwrite + let hin = pread hout <- dup stdOutput - hClose stdin hClose stdout -- Not using git pull because git 2.5.0 badly -- broke its option parser. unlessM (boolSystemNonConcurrent "git" (fetchparams hin hout)) $ errorMessage "git fetch from client failed" + wait forwarder unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ errorMessage "git merge from client failed" where @@ -401,3 +408,18 @@ fromh *>* toh = do B.hPut toh b hFlush toh fromh *>* toh + +(*>*!) :: Handle -> Handle -> IO () +fromh *>*! toh = do + b <- B.hGetSome fromh 40960 + if B.null b + then do + hPutStrLn stderr "EOF on forwarded input" + hClose fromh + hClose toh + else do + hPutStrLn stderr "forwarding input:" + B.hPut stderr b + B.hPut toh b + hFlush toh + fromh *>*! toh -- cgit v1.2.3