From fcff7762e395378791f01c9ea8507b41a4d7d501 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 6 Dec 2014 06:34:32 -0400 Subject: endAction can be used to register an action to run once propellor has successfully run on a host. --- debian/changelog | 2 ++ src/Propellor/Engine.hs | 37 +++++++++++++++++++++++++++++-------- src/Propellor/Property.hs | 11 ++++++++--- src/Propellor/Types.hs | 15 ++++++++++++--- 4 files changed, 51 insertions(+), 14 deletions(-) diff --git a/debian/changelog b/debian/changelog index 4bb387ce..a2b357ae 100644 --- a/debian/changelog +++ b/debian/changelog @@ -28,6 +28,8 @@ propellor (1.1.0) UNRELEASED; urgency=medium * propellor.debug can be set in the git config to enable more persistent debugging output. * Run apt-cache policy with LANG=C so it works on other locales. + * endAction can be used to register an action to run once propellor + has successfully run on a host. -- Joey Hess Sat, 22 Nov 2014 00:12:35 -0400 diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 81cc2397..310f4c84 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -7,7 +7,7 @@ import System.IO import Data.Monoid import Control.Applicative import System.Console.ANSI -import "mtl" Control.Monad.Reader +import "mtl" Control.Monad.RWS.Strict import Control.Exception (bracket) import System.PosixCompat import System.Posix.IO @@ -22,21 +22,37 @@ import Utility.Exception import Utility.PartialPrelude import Utility.Monad -runPropellor :: Host -> Propellor a -> IO a -runPropellor host a = runReaderT (runWithHost a) host - +-- | Gets the Properties of a Host, and ensures them all, +-- with nice display of what's being done. mainProperties :: Host -> IO () mainProperties host = do - r <- runPropellor host $ + ret <- runPropellor host $ ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty] h <- mkMessageHandle whenConsole h $ setTitle "propellor: done" hFlush stdout - case r of + case ret of FailedChange -> exitWith (ExitFailure 1) _ -> exitWith ExitSuccess +-- | Runs a Propellor action with the specified host. +-- +-- If the Result is not FailedChange, any EndActions +-- that were accumulated while running the action +-- are then also run. +runPropellor :: Host -> Propellor Result -> IO Result +runPropellor host a = do + (ret, _s, endactions) <- runRWST (runWithHost a) host () + endrets <- mapM (runEndAction host) endactions + return $ mconcat (ret:endrets) + +runEndAction :: Host -> EndAction -> IO Result +runEndAction host (EndAction desc a) = actionMessageOn (hostName host) desc $ do + (ret, _s, _) <- runRWST (runWithHost (catchPropellor a)) host () + return ret + +-- | Ensures a list of Properties, with a display of each as it runs. ensureProperties :: [Property] -> Propellor Result ensureProperties ps = ensure ps NoChange where @@ -46,6 +62,8 @@ ensureProperties ps = ensure ps NoChange r <- actionMessageOn hn (propertyDesc l) (ensureProperty l) ensure ls (r <> rs) +-- | For when code running in the Propellor monad needs to ensure a +-- Property. ensureProperty :: Property -> Propellor Result ensureProperty = catchPropellor . propertySatisfy @@ -55,8 +73,11 @@ ensureProperty = catchPropellor . propertySatisfy fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a) fromHost l hn getter = case findHost l hn of Nothing -> return Nothing - Just h -> liftIO $ Just <$> - runReaderT (runWithHost getter) h + Just h -> do + (ret, _s, runlog) <- liftIO $ + runRWST (runWithHost getter) h () + tell runlog + return (Just ret) onlyProcess :: FilePath -> IO a -> IO a onlyProcess lockfile a = bracket lock unlock (const a) diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 6ace5e4e..1533471e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -7,7 +7,7 @@ import System.FilePath import Control.Monad import Data.Monoid import Control.Monad.IfElse -import "mtl" Control.Monad.Reader +import "mtl" Control.Monad.RWS.Strict import Propellor.Types import Propellor.Info @@ -131,11 +131,11 @@ boolProperty desc a = property desc $ ifM (liftIO a) revert :: RevertableProperty -> RevertableProperty revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 --- Changes the action that is performed to satisfy a property. +-- | Changes the action that is performed to satisfy a property. adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) } --- Combines the Info of two properties. +-- | Combines the Info of two properties. combineInfo :: (IsProp p, IsProp q) => p -> q -> Info combineInfo p q = getInfo p <> getInfo q @@ -147,3 +147,8 @@ makeChange a = liftIO a >> return MadeChange noChange :: Propellor Result noChange = return NoChange + +-- | Registers an action that should be run at the very end, +-- and only when all configured Properties of the host succeed. +endAction :: Desc -> Propellor Result -> Propellor () +endAction desc a = tell [EndAction desc a] diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 2f51b3e4..64cb5fbb 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -23,6 +23,8 @@ module Propellor.Types , SshKeyType(..) , Val(..) , fromVal + , RunLog + , EndAction(..) , module Propellor.Types.OS , module Propellor.Types.Dns ) where @@ -31,7 +33,7 @@ import Data.Monoid import Control.Applicative import System.Console.ANSI import System.Posix.Types -import "mtl" Control.Monad.Reader +import "mtl" Control.Monad.RWS.Strict import "MonadCatchIO-transformers" Control.Monad.CatchIO import qualified Data.Set as S import qualified Propellor.Types.Dns as Dns @@ -52,13 +54,14 @@ data Host = Host deriving (Show) -- | Propellor's monad provides read-only access to info about the host --- it's running on. -newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p } +-- it's running on, and a writer to accumulate logs about the run. +newtype Propellor p = Propellor { runWithHost :: RWST Host RunLog () IO p } deriving ( Monad , Functor , Applicative , MonadReader Host + , MonadWriter RunLog , MonadIO , MonadCatchIO ) @@ -197,3 +200,9 @@ instance Monoid (Val a) where fromVal :: Val a -> Maybe a fromVal (Val a) = Just a fromVal NoVal = Nothing + +type RunLog = [EndAction] + +-- | An action that Propellor runs at the end, after trying to satisfy all +-- properties. +data EndAction = EndAction Desc (Propellor Result) -- cgit v1.2.3