module Propellor.Engine where
import System.Exit
import System.IO
import Data.Monoid
import Control.Applicative
import System.Console.ANSI
import "mtl" Control.Monad.Reader
import Control.Exception (bracket)
import System.PosixCompat
import System.Posix.IO
import Data.Maybe
import Propellor.Types
import Propellor.Message
import Propellor.Exception
import Propellor.Info
import Utility.Exception
import Utility.PartialPrelude
import Utility.Monad
runPropellor :: Host -> Propellor a -> IO a
runPropellor host a = runReaderT (runWithHost a) host
mainProperties :: Host -> IO ()
mainProperties host = do
r <- runPropellor host $
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
setTitle "propellor: done"
hFlush stdout
case r of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
ensureProperties :: [Property] -> Propellor Result
ensureProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (l:ls) rs = do
hn <- asks hostName
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
ensure ls (r <> rs)
ensureProperty :: Property -> Propellor Result
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
onlyProcess :: FilePath -> IO a -> IO a
onlyProcess lockfile a = bracket lock unlock (const a)
where
lock = do
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)
case v of
Nothing -> pure $ fromMaybe FailedChange $
readish =<< lastline
Just s -> do
maybe noop (\l -> unless (null l) (putStrLn l)) lastline
hFlush stdout
go (Just s)