From bb1a6594475d3d2dd2f40f4363b650bd276a157e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 17 Jun 2017 09:18:22 -0400 Subject: use stretch in debian stable examples --- src/Propellor/Info.hs | 4 ++-- src/Propellor/Types/OS.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index 49ca689f..ed6c2d85 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -84,13 +84,13 @@ askInfo = asks (fromInfo . hostInfo) -- It also lets the type checker know that all the properties of the -- host must support Debian. -- --- > & osDebian (Stable "jessie") X86_64 +-- > & osDebian (Stable "stretch") X86_64 osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian) osDebian = osDebian' Linux -- Use to specify a different `DebianKernel` than the default `Linux` -- --- > & osDebian' KFreeBSD (Stable "jessie") X86_64 +-- > & osDebian' KFreeBSD (Stable "stretch") X86_64 osDebian' :: DebianKernel -> DebianSuite -> Architecture -> Property (HasInfo + Debian) osDebian' kernel suite arch = tightenTargets $ os (System (Debian kernel suite) arch) diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 41f839f1..01d777a4 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -59,7 +59,7 @@ data DebianKernel = Linux | KFreeBSD | Hurd deriving (Show, Eq) -- | Debian has several rolling suites, and a number of stable releases, --- such as Stable "jessie". +-- such as Stable "stretch". data DebianSuite = Experimental | Unstable | Testing | Stable Release deriving (Show, Eq) -- cgit v1.3-2-g0d8e From 86232b50062b7129da0cac2dd2059fce3db9276b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 18 Jun 2017 16:20:12 -0400 Subject: Display error and warning messages to stderr, not stdout. --- debian/changelog | 6 ++++++ src/Propellor/Message.hs | 4 ++-- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index a662c5c6..d26e007c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +propellor (4.0.6) UNRELEASED; urgency=medium + + * Display error and warning messages to stderr, not stdout. + + -- Joey Hess Sun, 18 Jun 2017 16:19:41 -0400 + propellor (4.0.5) unstable; urgency=medium * Switch cabal file from Extensions to Default-Extensions to fix diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index 97573516..c56f0c5a 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -102,7 +102,7 @@ actionMessage' mhn desc a = do warningMessage :: MonadIO m => String -> m () warningMessage s = liftIO $ - outputConcurrent =<< colorLine Vivid Magenta ("** warning: " ++ s) + errorConcurrent =<< colorLine Vivid Magenta ("** warning: " ++ s) infoMessage :: MonadIO m => [String] -> m () infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls @@ -113,7 +113,7 @@ infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls -- property fail. Propellor will continue to the next property. errorMessage :: MonadIO m => String -> m a errorMessage s = liftIO $ do - outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s) + errorConcurrent =<< colorLine Vivid Red ("** error: " ++ s) -- Normally this exception gets caught and is not displayed, -- and propellor continues. So it's only displayed if not -- caught, and so we say, cannot continue. -- cgit v1.3-2-g0d8e From 9b457ae66d5c5143f5896156cc4af8d5a0bc0ddc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 18 Jun 2017 16:57:38 -0400 Subject: remove unnecessary binary mode setting This is using ByteString, so the handle IO discipline is irrelevant. --- src/Propellor/Spin.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 3b3729f9..d0ce4d03 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -349,8 +349,6 @@ gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout h <- fdToHandle hin connect h stdout connect fromh toh = do - hSetBinaryMode fromh True - hSetBinaryMode toh True b <- B.hGetSome fromh 40960 if B.null b then do -- cgit v1.3-2-g0d8e From 01fc1375cece096ab2dec480b843ecdbc4f0d94e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 18 Jun 2017 18:24:05 -0400 Subject: Fix bug that sometimes made --spin fail with "fatal: Couldn't find remote ref HEAD" Tricky stdin buffering problem. An easier fix would have been: hSetBuffering stdin NoBuffering But that approach is less robust; even with NoBuffering, anything that uses hLookAhead causes 1 byte of buffering. And, any reads from stdin before hSetBuffering would still cause the problem. Instead, I used a bigger hammer that will always work. It involves a bit more CPU work, but this is data that is already being fed through ssh; copying it one more time won't cause a measurable performance impact. This commit was sponsored by Jack Hill on Patreon. --- debian/changelog | 2 + doc/todo/spin_failure_HEAD.mdwn | 33 +++++++++++-- src/Propellor/Spin.hs | 102 +++++++++++++++++++++++----------------- 3 files changed, 92 insertions(+), 45 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index d26e007c..086c82c0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,5 +1,7 @@ propellor (4.0.6) UNRELEASED; urgency=medium + * Fix bug that sometimes made --spin fail with + "fatal: Couldn't find remote ref HEAD" * Display error and warning messages to stderr, not stdout. -- Joey Hess Sun, 18 Jun 2017 16:19:41 -0400 diff --git a/doc/todo/spin_failure_HEAD.mdwn b/doc/todo/spin_failure_HEAD.mdwn index af525f61..f838e469 100644 --- a/doc/todo/spin_failure_HEAD.mdwn +++ b/doc/todo/spin_failure_HEAD.mdwn @@ -51,7 +51,6 @@ Sending privdata (73139 bytes) to kite.kitenet.net ... done [2017-06-18 16:27:13 EDT] received marked GITPUSH [2017-06-18 16:27:13 EDT] command line: GitPush 11 12 16:27:13.953638 pkt-line.c:80 packet: fetch< 3a3c8a731d169a2768dd243581803dcb7b275049 HEAD\0multi_ack thin-pack side-band side-band-64k ofs-delta shallow deepen-since deepen-not deepen-relative no-progress include-tag multi_ack_detailed symref=HEAD:refs/heads/joeyconfig agent=git/2.11.0 -16:27:13.953638 pkt-line.c:80 packet: fetch< 3a3c8a731d169a2768dd243581803dcb7b275049 HEAD\0multi_ack thin-pack side-band side-band-64k ofs-delta shallow deepen-since deepen-not deepen-relative no-progress include-tag multi_ack_detailed symref=HEAD:refs/heads/joeyconfig agent=git/2.11.0 16:27:13.953781 pkt-line.c:80 packet: fetch< 86b077b7a21efd5484dfaeee3c31fc5f3c151f6c refs/heads/confpairs 16:27:13.953789 pkt-line.c:80 packet: fetch< e03e4bf0f1e557f87d1fe7e01a6de7866296fce6 refs/heads/d-i 16:27:13.953795 pkt-line.c:80 packet: fetch< 3a3c8a731d169a2768dd243581803dcb7b275049 refs/heads/joeyconfig @@ -94,7 +93,35 @@ Sending privdata (73139 bytes) to kite.kitenet.net ... done > > * Could be in gitPushHelper, perhaps it's failing to write > > some of the first lines somehow? > > * Could be something on the remote side is consuming stdin -> > that is not supposed to, and eats some of the protocol.a +> > that is not supposed to, and eats some of the protocol. +> > > > > > I added debug dumping to gitPushHelper, and it seems to be -> > reading the same truncated data. +> > reading the same truncated data, so it seems the problem is not there. +> > +> > Aha! The problem comes from stdin/stdInput confusion here: + + req NeedGitPush gitPushMarker $ \_ -> do + hin <- dup stdInput + hout <- dup stdOutput + hClose stdin + hClose stdout + +> > A line read from stdin just before the dup gets the first line of the protocol +> > as expected. But reading from stdInput starts with a later line. +> > Apparently data is being buffered in the stdin Handle, so gitPushHelper, +> > which reads from the Fd, does not see it. +> > +> > Here's a simple test case. Feeding this 2 lines on stdin will +> > print the first and then fail with "hGetLine: end of file". +> > The second line is lost in the buffer. This test case behaves +> > like that reliably, so I'm surprised propellor only fails sometimes. + + main = do + l <- hGetLine stdin + print l + bob <- fdToHandle stdInput + l2 <- hGetLine bob + print l2 + +> > [[fixed|done]] --[[Joey]] diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index d0ce4d03..cc5fa0e8 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -186,26 +186,8 @@ update forhost = do writeFileProtected privfile whenM hasGitRepo $ - req NeedGitPush gitPushMarker $ \_ -> do - hin <- dup stdInput - hout <- dup stdOutput - hClose stdin - hClose stdout - -- Not using git pull because git 2.5.0 badly - -- broke its option parser. - unlessM (boolSystemNonConcurrent "git" (pullparams hin hout)) $ - errorMessage "git fetch from client failed" - unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ - errorMessage "git merge from client failed" + gitPullFromUpdateServer where - pullparams hin hout = - [ Param "fetch" - , Param "--progress" - , Param "--upload-pack" - , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout - , Param "." - ] - -- When --spin --relay is run, get a privdata file -- to be relayed to the target host. privfile = maybe privDataLocal privDataRelay forhost @@ -336,29 +318,6 @@ sendPrecompiled hn = void $ actionMessage "Uploading locally compiled propellor , "rm -f " ++ remotetarball ] --- Shim for git push over the propellor ssh channel. --- Reads from stdin and sends it to hout; --- reads from hin and sends it to stdout. -gitPushHelper :: Fd -> Fd -> IO () -gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout - where - fromstdin = do - h <- fdToHandle hout - connect stdin h - tostdout = do - h <- fdToHandle hin - connect h stdout - connect fromh toh = do - b <- B.hGetSome fromh 40960 - if B.null b - then do - hClose fromh - hClose toh - else do - B.hPut toh b - hFlush toh - connect fromh toh - mergeSpin :: IO () mergeSpin = do branch <- getCurrentBranch @@ -386,3 +345,62 @@ findLastNonSpinCommit = do spinCommitMessage :: String spinCommitMessage = "propellor spin" + +-- 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 = 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 + hout <- dup stdOutput + 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" + unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ + errorMessage "git merge from client failed" + where + fetchparams hin hout = + [ Param "fetch" + , Param "--progress" + , Param "--upload-pack" + , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout + , Param "." + ] + +-- Shim for git push over the propellor ssh channel. +-- Reads from stdin and sends it to hout; +-- reads from hin and sends it to stdout. +gitPushHelper :: Fd -> Fd -> IO () +gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout + where + fromstdin = do + h <- fdToHandle hout + stdin *>* h + tostdout = do + h <- fdToHandle hin + h *>* stdout + +-- Forward data from one handle to another. +(*>*) :: Handle -> Handle -> IO () +fromh *>* toh = do + b <- B.hGetSome fromh 40960 + if B.null b + then do + hClose fromh + hClose toh + else do + B.hPut toh b + hFlush toh + fromh *>* toh -- cgit v1.3-2-g0d8e From 217f787df9d6474c9a57fd29b6b2fa29bef64a8a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 18 Jun 2017 18:57:41 -0400 Subject: 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. --- src/Propellor/Protocol.hs | 10 +++++++--- src/Propellor/Spin.hs | 22 ++++++++-------------- 2 files changed, 15 insertions(+), 17 deletions(-) (limited to 'src') 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. -- cgit v1.3-2-g0d8e