summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/CmdLine.hs39
-rw-r--r--src/Propellor/Property/File.hs6
-rw-r--r--src/Propellor/Spin.hs7
3 files changed, 28 insertions, 24 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index a0ae9cb5..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
@@ -125,12 +127,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
@@ -149,6 +147,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 +157,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 +183,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
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.
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