summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Spin.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-16 14:20:13 -0400
committerJoey Hess2015-10-16 14:23:01 -0400
commite66b62f40bcb29ca62c905dabe87cc6e91a6bccd (patch)
treeab317c5bccecfb347c4dc4d9f122334532397fba /src/Propellor/Property/Spin.hs
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)
Diffstat (limited to 'src/Propellor/Property/Spin.hs')
-rw-r--r--src/Propellor/Property/Spin.hs52
1 files changed, 52 insertions, 0 deletions
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))