summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-16 14:20:13 -0400
committerJoey Hess2015-10-16 14:23:01 -0400
commite66b62f40bcb29ca62c905dabe87cc6e91a6bccd (patch)
treeab317c5bccecfb347c4dc4d9f122334532397fba
parente5b5a190b7de979cd889c92ecff530417534864e (diff)
Added Propellor.Property.Spin, which can be used to make a host be a controller of other hosts.
The hard part of this is avoiding loops of controllers. To make that work, a ControllerChain is passed to the host that's spun, and is added to the Info of the host being spun, where the controller property can check it to detect an avoid a loop. That needed an expansion of the CmdLine data type. I made the new ControlledRun only be used when there is a ControllerChain provided. This avoids breaking backwards compatability with old propellor deployments, as --spin still uses SimpleRun. Note: Making an old propellor deployment be controlled by a controller won't work until it's been updated to this commit, so it knows about the ControlledRun parameter. (Untested)
-rw-r--r--debian/changelog3
-rw-r--r--propellor.cabal7
-rw-r--r--src/Propellor/CmdLine.hs7
-rw-r--r--src/Propellor/Engine.hs11
-rw-r--r--src/Propellor/Info.hs3
-rw-r--r--src/Propellor/Property/Spin.hs52
-rw-r--r--src/Propellor/Spin.hs8
-rw-r--r--src/Propellor/Types/CmdLine.hs9
8 files changed, 88 insertions, 12 deletions
diff --git a/debian/changelog b/debian/changelog
index 292ec0be..f3b73d3f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,6 +14,9 @@ propellor (2.9.0) UNRELEASED; urgency=medium
file content via origfile.propellor-new~, instead of to a randomly named
temp file. This allows them to clean up any temp file that may have
been left by an interrupted run of propellor.
+ * Added Propellor.Property.Spin, which can be used to make a host be a
+ controller of other hosts, which will automatically spin them each time
+ propellor is run.
-- Joey Hess <id@joeyh.name> Thu, 08 Oct 2015 11:09:01 -0400
diff --git a/propellor.cabal b/propellor.cabal
index 86337505..b61d2a2f 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -94,6 +94,9 @@ Library
Propellor.Property.Grub
Propellor.Property.Journald
Propellor.Property.Kerberos
+ Propellor.Property.List
+ Propellor.Property.LightDM
+ Propellor.Property.Logcheck
Propellor.Property.Mount
Propellor.Property.Network
Propellor.Property.Nginx
@@ -106,9 +109,7 @@ Library
Propellor.Property.Prosody
Propellor.Property.Reboot
Propellor.Property.Rsync
- Propellor.Property.List
- Propellor.Property.LightDM
- Propellor.Property.Logcheck
+ Propellor.Property.Spin
Propellor.Property.Scheduled
Propellor.Property.Service
Propellor.Property.Ssh
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 33bb0bdc..35929ea7 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -115,11 +115,14 @@ defaultMain hostlist = do
go True cmdline = updateFirst cmdline $ go False cmdline
go False (Spin hs r) = do
commitSpin
- forM_ hs $ \hn -> withhost hn $ spin hn r
+ forM_ hs $ \hn -> withhost hn $
+ spin hn r mempty
go False cmdline@(SimpleRun hn) = buildFirst cmdline $
go False (Run hn)
+ go False cmdline@(ControlledRun hn cc) = buildFirst cmdline $
+ onlyprocess $ withhost hn $ mainProperties cc
go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
- ( onlyprocess $ withhost hn mainProperties
+ ( onlyprocess $ withhost hn $ mainProperties mempty
, go True (Spin [hn] Nothing)
)
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 0fdbb995..87fa4cd2 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -26,6 +26,8 @@ import Propellor.Types
import Propellor.Message
import Propellor.Exception
import Propellor.Info
+import Propellor.Types.Info
+import Propellor.Types.CmdLine
import Propellor.Property
import Utility.Exception
import Utility.PartialPrelude
@@ -33,9 +35,9 @@ import Utility.Monad
-- | Gets the Properties of a Host, and ensures them all,
-- with nice display of what's being done.
-mainProperties :: Host -> IO ()
-mainProperties host = do
- ret <- runPropellor host $
+mainProperties :: ControllerChain -> Host -> IO ()
+mainProperties cc host = do
+ ret <- runPropellor host' $
ensureProperties [ignoreInfo $ infoProperty "overall" (ensureProperties ps) mempty mempty]
h <- mkMessageHandle
whenConsole h $
@@ -45,7 +47,8 @@ mainProperties host = do
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
where
- ps = map ignoreInfo $ hostProperties host
+ ps = map ignoreInfo $ hostProperties host'
+ host' = addHostInfo host (InfoVal cc)
-- | Runs a Propellor action with the specified host.
--
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index fed62ff9..889f8439 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -101,3 +101,6 @@ getAddresses = mapMaybe getIPAddr . S.toList . fromDnsInfo . getInfo
hostAddresses :: HostName -> [Host] -> [IPAddr]
hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)
+
+addHostInfo ::IsInfo v => Host -> v -> Host
+addHostInfo h v = h { hostInfo = addInfo (hostInfo h) v }
diff --git a/src/Propellor/Property/Spin.hs b/src/Propellor/Property/Spin.hs
new file mode 100644
index 00000000..24b8a3b6
--- /dev/null
+++ b/src/Propellor/Property/Spin.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Property.Spin (Controlled(..), controller) where
+
+import Propellor.Base
+import Propellor.Spin (spin)
+import Propellor.Types.CmdLine (ControllerChain(..))
+import Propellor.Types.Info
+
+class Controlled t where
+ toHosts :: t -> [Host]
+
+instance Controlled Host where
+ toHosts h = [h]
+
+instance Controlled [Host] where
+ toHosts = id
+
+-- | The Host that has this Property is in control of some other Hosts.
+--
+-- Making a host a controller eliminates the need to manually run
+-- propellor --spin to update the controlled hosts. Each time
+-- propellor is run on the controller host, it will in turn run
+-- propellor on the controlled Hosts.
+--
+-- Multiple controllers can control the same hosts. However, if
+-- propellor is already running on a host, its controller will fail
+-- to run it a second time. So, if two controllers both try to
+-- control the same host at the same time, one will fail.
+--
+-- Chains of controllers are supported; host A can control host B which
+-- controls host C. Loops of controllers are automatically prevented.
+controller :: Controlled h => h -> Property NoInfo
+controller h = propertyList "controller" (map controller' (toHosts h))
+
+controller' :: Host -> Property NoInfo
+controller' h = property ("controller for " ++ hostName h) $ do
+ ControllerChain cc <- getControllerChain
+ if hostName h `elem` cc
+ then noChange -- avoid loop
+ else do
+ liftIO $ spin (hostName h) Nothing (ControllerChain cc) h
+ -- Don't know if the spin made a change to the
+ -- remote host or not, but in any case, the
+ -- local host was not changed.
+ noChange
+
+getControllerChain :: Propellor ControllerChain
+getControllerChain = do
+ hn <- hostName <$> ask
+ ControllerChain cc <- fromMaybe (ControllerChain []) . fromInfoVal <$> askInfo
+ return (ControllerChain (hn:cc))
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index ecefbf6e..401c9375 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -40,8 +40,8 @@ commitSpin = do
void $ actionMessage "Push to central git repository" $
boolSystem "git" [Param "push"]
-spin :: HostName -> Maybe HostName -> Host -> IO ()
-spin target relay hst = do
+spin :: HostName -> Maybe HostName -> ControllerChain -> Host -> IO ()
+spin target relay cc hst = do
cacheparams <- if viarelay
then pure ["-A"]
else toCommand <$> sshCachingParams hn
@@ -89,7 +89,9 @@ spin target relay hst = do
runcmd = "cd " ++ localdir ++ " && ./propellor " ++ cmd
cmd = if viarelay
then "--serialized " ++ shellEscape (show (Spin [target] (Just target)))
- else "--continue " ++ shellEscape (show (SimpleRun target))
+ else if cc == mempty
+ then "--continue " ++ shellEscape (show (SimpleRun target))
+ else "--continue " ++ shellEscape (show (ControlledRun target cc))
-- Check if the Host contains an IP address that matches one of the IPs
-- in the DNS for the HostName. If so, the HostName is used as-is,
diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs
index 50908514..380ac5a8 100644
--- a/src/Propellor/Types/CmdLine.hs
+++ b/src/Propellor/Types/CmdLine.hs
@@ -1,14 +1,20 @@
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
module Propellor.Types.CmdLine where
import Propellor.Types.OS
import Propellor.Types.PrivData
import System.Posix.Types
+import Data.Typeable
+import Data.Monoid
+-- | All the command line actions that propellor can perform.
data CmdLine
= Run HostName
| Spin [HostName] (Maybe HostName)
| SimpleRun HostName
+ | ControlledRun HostName ControllerChain
| Set PrivDataField Context
| Unset PrivDataField Context
| Dump PrivDataField Context
@@ -28,3 +34,6 @@ data CmdLine
| Check
deriving (Read, Show, Eq)
+-- | List of hosts that acted as controllers to cause a host to be spinned.
+newtype ControllerChain = ControllerChain [HostName]
+ deriving (Read, Show, Eq, Typeable, Monoid)