2014-04-10 21:22:32 +00:00
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
|
2014-03-31 05:06:44 +00:00
|
|
|
module Propellor.Engine where
|
|
|
|
|
|
|
|
import System.Exit
|
|
|
|
import System.IO
|
2014-03-31 14:36:45 +00:00
|
|
|
import Data.Monoid
|
2014-05-31 22:02:56 +00:00
|
|
|
import Control.Applicative
|
2014-03-31 22:31:08 +00:00
|
|
|
import System.Console.ANSI
|
2014-04-10 21:22:32 +00:00
|
|
|
import "mtl" Control.Monad.Reader
|
2014-03-31 05:06:44 +00:00
|
|
|
|
|
|
|
import Propellor.Types
|
2014-03-31 22:31:08 +00:00
|
|
|
import Propellor.Message
|
2014-04-10 21:22:32 +00:00
|
|
|
import Propellor.Exception
|
2014-06-09 05:45:58 +00:00
|
|
|
import Propellor.Info
|
2014-03-31 05:06:44 +00:00
|
|
|
|
2014-05-31 22:02:56 +00:00
|
|
|
runPropellor :: Host -> Propellor a -> IO a
|
|
|
|
runPropellor host a = runReaderT (runWithHost a) host
|
2014-03-31 05:06:44 +00:00
|
|
|
|
2014-05-31 22:02:56 +00:00
|
|
|
mainProperties :: Host -> IO ()
|
|
|
|
mainProperties host = do
|
|
|
|
r <- runPropellor host $
|
2014-06-01 00:39:56 +00:00
|
|
|
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
|
2014-03-31 23:31:35 +00:00
|
|
|
setTitle "propellor: done"
|
2014-03-31 05:19:40 +00:00
|
|
|
hFlush stdout
|
2014-03-31 05:06:44 +00:00
|
|
|
case r of
|
|
|
|
FailedChange -> exitWith (ExitFailure 1)
|
|
|
|
_ -> exitWith ExitSuccess
|
|
|
|
|
2014-04-10 21:22:32 +00:00
|
|
|
ensureProperties :: [Property] -> Propellor Result
|
|
|
|
ensureProperties ps = ensure ps NoChange
|
2014-03-31 05:06:44 +00:00
|
|
|
where
|
|
|
|
ensure [] rs = return rs
|
|
|
|
ensure (l:ls) rs = do
|
2014-06-01 00:48:23 +00:00
|
|
|
hn <- asks hostName
|
2014-05-31 22:52:42 +00:00
|
|
|
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
|
2014-03-31 14:36:45 +00:00
|
|
|
ensure ls (r <> rs)
|
2014-04-10 21:22:32 +00:00
|
|
|
|
|
|
|
ensureProperty :: Property -> Propellor Result
|
|
|
|
ensureProperty = catchPropellor . propertySatisfy
|
2014-05-31 22:02:56 +00:00
|
|
|
|
|
|
|
-- | Lifts an action into a different host.
|
|
|
|
--
|
|
|
|
-- For example, `fromHost hosts "otherhost" getSshPubKey`
|
|
|
|
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
|
|
|
|
fromHost l hn getter = case findHost l hn of
|
2014-07-23 16:27:38 +00:00
|
|
|
Nothing -> return Nothing
|
|
|
|
Just h -> liftIO $ do
|
|
|
|
print ("fromHost", hn, "using", h)
|
|
|
|
Just <$>
|
|
|
|
runReaderT (runWithHost getter) h
|