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/CmdLine.hs | 7 ++++-- src/Propellor/Engine.hs | 11 +++++---- src/Propellor/Info.hs | 3 +++ src/Propellor/Property/Spin.hs | 52 ++++++++++++++++++++++++++++++++++++++++++ src/Propellor/Spin.hs | 8 ++++--- src/Propellor/Types/CmdLine.hs | 9 ++++++++ 6 files changed, 81 insertions(+), 9 deletions(-) create mode 100644 src/Propellor/Property/Spin.hs (limited to 'src/Propellor') 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) -- cgit v1.2.3