From 7899f23d991aa901c110b5bf276c0c7fb165799a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 18:03:50 -0400 Subject: refactor and propigate failure after re-running propellor --- src/Propellor/CmdLine.hs | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index a0ae9cb5..5e6769c9 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -149,6 +149,9 @@ unknownhost h hosts = errorMessage $ unlines , "Known hosts: " ++ unwords (map hostName hosts) ] +-- Builds propellor (when allowed) and if it looks like a new binary, +-- re-execs it to continue. +-- Otherwise, runs the IO action to continue. buildFirst :: CanRebuild -> CmdLine -> IO () -> IO () buildFirst CanRebuild cmdline next = do oldtime <- getmtime @@ -156,14 +159,20 @@ buildFirst CanRebuild cmdline next = do newtime <- getmtime if newtime == oldtime then next - else void $ boolSystem "./propellor" - [ Param "--continue" - , Param (show cmdline) - ] + else continueAfterBuild cmdline where getmtime = catchMaybeIO $ getModificationTime "propellor" buildFirst NoRebuild _ next = next +continueAfterBuild :: CmdLine -> IO a +continueAfterBuild cmdline = go =<< boolSystem "./propellor" + [ Param "--continue" + , Param (show cmdline) + ] + where + go True = exitSuccess + go False = exitWith (ExitFailure 1) + fetchFirst :: IO () -> IO () fetchFirst next = do whenM hasOrigin $ @@ -176,14 +185,14 @@ updateFirst canrebuild cmdline next = ifM hasOrigin , next ) +-- If changes can be fetched from origin, Builds propellor (when allowed) +-- and re-execs the updated propellor binary to continue. +-- Otherwise, runs the IO action to continue. updateFirst' :: CanRebuild -> CmdLine -> IO () -> IO () updateFirst' CanRebuild cmdline next = ifM fetchOrigin ( do buildPropellor - void $ boolSystem "./propellor" - [ Param "--continue" - , Param (show cmdline) - ] + continueAfterBuild cmdline , next ) updateFirst' NoRebuild _ next = next -- cgit v1.2.3 From 4bbab3db9856b1c3fb4403add8b391179baf29c6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 18:15:00 -0400 Subject: stop using --continue SimpleRun for spin When spinning a remote host, we do want to rebuild propellor on it, and this use of --continue that did a rebuild was different from all the other uses of --continue that avoided a rebuild. This fixes a build loop involving that special case. When --continue SimpleRun ran a rebuild, it re-execed propellor with --continue SimpleRun, and so would rebuild again, and re-exec again if the binary kept changing. Backwards compatability should be ok; old versions of propellor, when run with --serialized SimpleRun by the new version, do a buildFirst, followed by another (redundant) buildFirst, and then run. The one redundant buildFirst is not a problem in the upgrade scenario. (Unfortunately, I can't rename SimpleRun to something nicer despite only spin using it; backwards compatability does prevent that.) --- src/Propellor/CmdLine.hs | 8 ++------ src/Propellor/Spin.hs | 7 ++++--- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 5e6769c9..f708c1d9 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -125,12 +125,8 @@ defaultMain hostlist = withConcurrentOutput $ do ( runhost hn , go cr (Spin [hn] Nothing) ) - go _ (SimpleRun hn) = runhost hn - go cr (Continue cmdline@(SimpleRun hn)) = - -- --continue SimpleRun is used by --spin, - -- and unlike all other uses of --continue, this legacy one - -- wants a build first - forceConsole >> fetchFirst (buildFirst cr cmdline (runhost hn)) + go cr cmdline@(SimpleRun hn) = forceConsole >> + fetchFirst (buildFirst cr cmdline (runhost hn)) -- When continuing after a rebuild, don't want to rebuild again. go _ (Continue cmdline) = go NoRebuild cmdline diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 6246b04f..495ebaf4 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -112,9 +112,10 @@ spin' mprivdata relay target hst = do ] runcmd = "cd " ++ localdir ++ " && ./propellor " ++ cmd - cmd = if viarelay - then "--serialized " ++ shellEscape (show (Spin [target] (Just target))) - else "--continue " ++ shellEscape (show (SimpleRun target)) + cmd = "--serialized " ++ shellEscape (show cmdline) + cmdline + | viarelay = Spin [target] (Just target) + | otherwise = SimpleRun target getprivdata = case mprivdata of Nothing -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From dc2c3217f5916e55a7bbba4c459d4e41cbca2d21 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 18:26:38 -0400 Subject: eek, nasty debug left in --- src/Propellor/Property/File.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index e3732c9f..3021617c 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -92,11 +92,7 @@ fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f) let new = unlines (a (lines old)) if old == new then noChange - else makeChange $ do - writeFile "/tmp/a" old - writeFile "/tmp/b" new - print ("MAKE CHANGE", f) - updatefile new `viaStableTmp` f + else makeChange $ updatefile new `viaStableTmp` f go False = makeChange $ writer f (unlines $ a []) -- Replicate the original file's owner and mode. -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 -- cgit v1.2.3 From 565ab958723a29e31427ac29a4ce8e0465a83bbc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 18:44:43 -0400 Subject: propellor spin --- config-joey.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config-joey.hs b/config-joey.hs index 12846d36..03efed22 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -44,7 +44,7 @@ main = defaultMain hosts -- / \___-=O`/|O`/__| (____.' Deployed -} -- `/-==__ _/__|/__=-| ( \_ hosts :: [Host] -- * \ | | '--------' hosts = -- (o) ` - [ darkstar + [ darkstar , gnu , clam , mayfly -- cgit v1.2.3 From 5be7972fa1a4f1853ad4113d54b9a42cea730b76 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 18:46:20 -0400 Subject: propellor spin --- config-joey.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config-joey.hs b/config-joey.hs index 03efed22..84db2155 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -45,7 +45,7 @@ main = defaultMain hosts -- / \___-=O`/|O`/__| (____.' hosts :: [Host] -- * \ | | '--------' hosts = -- (o) ` [ darkstar - , gnu + , gnu , clam , mayfly , oyster -- cgit v1.2.3 From 463418726ad8d8b80b5f0aae302c18c1516774f8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 18:55:27 -0400 Subject: propellor spin --- config-joey.hs | 4 ++-- src/Propellor/CmdLine.hs | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/config-joey.hs b/config-joey.hs index 84db2155..12846d36 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -44,8 +44,8 @@ main = defaultMain hosts -- / \___-=O`/|O`/__| (____.' Deployed -} -- `/-==__ _/__|/__=-| ( \_ hosts :: [Host] -- * \ | | '--------' hosts = -- (o) ` - [ darkstar - , gnu + [ darkstar + , gnu , clam , mayfly , oyster diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index f708c1d9..5dbc5836 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -113,8 +113,10 @@ defaultMain hostlist = withConcurrentOutput $ do go _ (DockerChain hn cid) = Docker.chain hostlist hn cid go _ (DockerInit hn) = Docker.init hn go _ (GitPush fin fout) = gitPushHelper fin fout - go cr (Relay h) = forceConsole >> updateFirst cr (Update (Just h)) (update (Just h)) - go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing)) + go cr (Relay h) = forceConsole >> + updateFirst cr (Update (Just h)) (update (Just h)) + go _ (Update Nothing) = forceConsole >> + fetchFirst (onlyprocess (update Nothing)) go _ (Update (Just h)) = update (Just h) go _ Merge = mergeSpin go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do -- cgit v1.2.3