module Propellor.Engine (
mainProperties,
runPropellor,
ensureProperty,
ensureProperties,
fromHost,
fromHost',
onlyProcess,
processChainOutput,
) where
import System.Exit
import System.IO
import Data.Monoid
import Control.Applicative
import System.Console.ANSI
import "mtl" Control.Monad.RWS.Strict
import System.PosixCompat
import System.Posix.IO
import System.FilePath
import System.Directory
import Propellor.Types
import Propellor.Message
import Propellor.Exception
import Propellor.Info
import Propellor.Property
import Utility.Exception
import Utility.PartialPrelude
import Utility.Monad
mainProperties :: Host -> IO ()
mainProperties host = do
ret <- runPropellor host $
ensureProperties [ignoreInfo $ infoProperty "overall" (ensureProperties ps) mempty mempty]
h <- mkMessageHandle
whenConsole h $
setTitle "propellor: done"
hFlush stdout
case ret of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
where
ps = map ignoreInfo $ hostProperties host
runPropellor :: Host -> Propellor Result -> IO Result
runPropellor host a = do
(res, _s, endactions) <- runRWST (runWithHost a) host ()
endres <- mapM (runEndAction host res) endactions
return $ mconcat (res:endres)
runEndAction :: Host -> Result -> EndAction -> IO Result
runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc $ do
(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host ()
return ret
ensureProperties :: [Property NoInfo] -> Propellor Result
ensureProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (p:ls) rs = do
hn <- asks hostName
r <- actionMessageOn hn (propertyDesc p) (ensureProperty p)
ensure ls (r <> rs)
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
fromHost l hn getter = case findHost l hn of
Nothing -> return Nothing
Just h -> Just <$> fromHost' h getter
fromHost' :: Host -> Propellor a -> Propellor a
fromHost' h getter = do
(ret, _s, runlog) <- liftIO $ runRWST (runWithHost getter) h ()
tell runlog
return ret
onlyProcess :: FilePath -> IO a -> IO a
onlyProcess lockfile a = bracket lock unlock (const a)
where
lock = do
createDirectoryIfMissing True (takeDirectory lockfile)
l <- createFile lockfile stdFileMode
setLock l (WriteLock, AbsoluteSeek, 0, 0)
`catchIO` const alreadyrunning
return l
unlock = closeFd
alreadyrunning = error "Propellor is already running on this host!"
processChainOutput :: Handle -> IO Result
processChainOutput h = go Nothing
where
go lastline = do
v <- catchMaybeIO (hGetLine h)
debug ["read from chained propellor: ", show v]
case v of
Nothing -> case lastline of
Nothing -> do
debug ["chained propellor output nothing; assuming it failed"]
return FailedChange
Just l -> case readish l of
Just r -> pure r
Nothing -> do
debug ["chained propellor output did not end with a Result; assuming it failed"]
putStrLn l
hFlush stdout
return FailedChange
Just s -> do
maybe noop (\l -> unless (null l) (putStrLn l)) lastline
hFlush stdout
go (Just s)