summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2016-03-30 15:18:39 -0400
committerJoey Hess2016-03-30 15:18:39 -0400
commit0f410f8acdb9e0b84ae364e80e5ee63adcb2ee50 (patch)
tree19985c15b17b34dfe06105b485ca4547dcd4decc /src
parentb24f20d8cb8b86767d530ce6df83bd14ad950093 (diff)
When new dependencies are added to propellor or the propellor config, try harder to get them installed.
In particular, this makes propellor --spin work when the remote host needs to get dependencies installed in order to build the updated config. Fixes http://propellor.branchable.com/todo/problem_with_spin_after_new_dependencies_added/
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Bootstrap.hs33
-rw-r--r--src/Propellor/CmdLine.hs30
-rw-r--r--src/wrapper.hs2
3 files changed, 40 insertions, 25 deletions
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 2ad0f688..b60dd8c4 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -6,6 +6,7 @@ module Propellor.Bootstrap (
) where
import Propellor.Base
+import Propellor.Types.Info
import System.Posix.Files
import Data.List
@@ -130,22 +131,27 @@ installGitCommand msys = case msys of
, "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git"
]
-buildPropellor :: IO ()
-buildPropellor = unlessM (actionMessage "Propellor build" build) $
+buildPropellor :: Maybe Host -> IO ()
+buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
errorMessage "Propellor build failed!"
+ where
+ msys = case fmap (fromInfo . hostInfo) mh of
+ Just (InfoVal sys) -> Just sys
+ _ -> Nothing
-- Build propellor using cabal, and symlink propellor to where cabal
-- leaves the built binary.
--
-- For speed, only runs cabal configure when it's not been run before.
-- If the build fails cabal may need to have configure re-run.
-build :: IO Bool
-build = catchBoolIO $ do
- make "dist/setup-config" ["propellor.cabal"] $
- cabal ["configure"]
- unlessM (cabal ["build", "propellor-config"]) $ do
- void $ cabal ["configure"]
- unlessM (cabal ["build"]) $
+--
+-- If the cabal configure fails, and a System is provided, installs
+-- dependencies and retries.
+build :: Maybe System -> IO Bool
+build msys = catchBoolIO $ do
+ make "dist/setup-config" ["propellor.cabal"] cabal_configure
+ unlessM cabal_build $
+ unlessM (cabal_configure <&&> cabal_build) $
error "cabal build failed"
-- For safety against eg power loss in the middle of the build,
-- make a copy of the binary, and move it into place atomically.
@@ -165,6 +171,15 @@ build = catchBoolIO $ do
cabalbuiltbin = "dist/build/propellor-config/propellor-config"
safetycopy = cabalbuiltbin ++ ".built"
tmpfor f = f ++ ".propellortmp"
+ cabal_configure = ifM (cabal ["configure"])
+ ( return True
+ , case msys of
+ Nothing -> return False
+ Just sys ->
+ boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))]
+ <&&> cabal ["configure"]
+ )
+ cabal_build = cabal ["build", "propellor-config"]
make :: FilePath -> [FilePath] -> IO Bool -> IO ()
make dest srcs builder = do
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index ee057d05..8fd2bf18 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -114,20 +114,20 @@ defaultMain hostlist = withConcurrentOutput $ do
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))
+ updateFirst Nothing 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
+ go cr cmdline@(Spin hs mrelay) = buildFirst Nothing cr cmdline $ do
unless (isJust mrelay) commitSpin
forM_ hs $ \hn -> withhost hn $ spin mrelay hn
go cr cmdline@(Run hn) = ifM ((==) 0 <$> getRealUserID)
- ( updateFirst cr cmdline $ runhost hn
+ ( updateFirst (findHost hostlist hn) cr cmdline $ runhost hn
, fetchFirst $ go cr (Spin [hn] Nothing)
)
go cr cmdline@(SimpleRun hn) = forceConsole >>
- fetchFirst (buildFirst cr cmdline (runhost hn))
+ fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn))
-- When continuing after a rebuild, don't want to rebuild again.
go _ (Continue cmdline) = go NoRebuild cmdline
@@ -149,17 +149,17 @@ unknownhost h hosts = errorMessage $ unlines
-- 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
+buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+buildFirst h CanRebuild cmdline next = do
oldtime <- getmtime
- buildPropellor
+ buildPropellor h
newtime <- getmtime
if newtime == oldtime
then next
else continueAfterBuild cmdline
where
getmtime = catchMaybeIO $ getModificationTime "propellor"
-buildFirst NoRebuild _ next = next
+buildFirst _ NoRebuild _ next = next
continueAfterBuild :: CmdLine -> IO a
continueAfterBuild cmdline = go =<< boolSystem "./propellor"
@@ -176,23 +176,23 @@ fetchFirst next = do
void fetchOrigin
next
-updateFirst :: CanRebuild -> CmdLine -> IO () -> IO ()
-updateFirst canrebuild cmdline next = ifM hasOrigin
- ( updateFirst' canrebuild cmdline next
+updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst h canrebuild cmdline next = ifM hasOrigin
+ ( updateFirst' h canrebuild cmdline next
, 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
+updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO ()
+updateFirst' h CanRebuild cmdline next = ifM fetchOrigin
( do
- buildPropellor
+ buildPropellor h
continueAfterBuild cmdline
, next
)
-updateFirst' NoRebuild _ next = next
+updateFirst' _ NoRebuild _ next = next
-- Gets the fully qualified domain name, given a string that might be
-- a short name to look up in the DNS.
diff --git a/src/wrapper.hs b/src/wrapper.hs
index a204b60c..289b12b5 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -99,7 +99,7 @@ wrapper args propellordir propellorbin = do
warnoutofdate propellordir True
buildruncfg = do
changeWorkingDirectory propellordir
- buildPropellor
+ buildPropellor Nothing
putStrLn ""
putStrLn ""
chain