diff options
| -rw-r--r-- | src/Propellor/CmdLine.hs | 39 | ||||
| -rw-r--r-- | src/Propellor/Property/File.hs | 6 | ||||
| -rw-r--r-- | src/Propellor/Spin.hs | 7 |
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 |