From e66b62f40bcb29ca62c905dabe87cc6e91a6bccd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 16 Oct 2015 14:20:13 -0400 Subject: 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) --- src/Propellor/Property/Spin.hs | 52 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 src/Propellor/Property/Spin.hs (limited to 'src/Propellor/Property') 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)) -- cgit v1.2.3