module Propellor.Engine (
mainProperties,
runPropellor,
ensureChildProperties,
fromHost,
fromHost',
onlyProcess,
chainPropellor,
runChainPropellor,
) where
import System.Exit
import System.IO
import Data.Monoid
import "mtl" Control.Monad.RWS.Strict
import System.PosixCompat
import System.Posix.IO
import System.FilePath
import System.Console.Concurrent
import Control.Applicative
import Control.Concurrent.Async
import Prelude
import Propellor.Types
import Propellor.Types.MetaTypes
import Propellor.Types.Core
import Propellor.Message
import Propellor.Exception
import Propellor.Info
import Utility.Exception
import Utility.Directory
import Utility.Process
import Utility.PartialPrelude
mainProperties :: Host -> IO ()
mainProperties host = do
ret <- runPropellor host $ ensureChildProperties [toChildProperty overall]
messagesDone
case ret of
FailedChange -> exitWith (ExitFailure 1)
_ -> exitWith ExitSuccess
where
overall :: Property (MetaTypes '[])
overall = property "overall" $
ensureChildProperties (hostProperties host)
runPropellor :: Host -> Propellor Result -> IO Result
runPropellor host a = do
(res, endactions) <- evalRWST (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
ensureChildProperties :: [ChildProperty] -> Propellor Result
ensureChildProperties ps = ensure ps NoChange
where
ensure [] rs = return rs
ensure (p:ls) rs = do
hn <- asks hostName
r <- maybe (pure NoChange)
(actionMessageOn hn (getDesc p) . catchPropellor)
(getSatisfy 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
setFdOptionl CloseOnExec True
setLock l (WriteLock, AbsoluteSeek, 0, 0)
`catchIO` const alreadyrunning
return l
unlock = closeFd
alreadyrunning = error "Propellor is already running on this host!"
chainPropellor :: CreateProcess -> IO Result
chainPropellor p =
withOEHandles createProcessSuccess p $ \(outh, errh) -> do
(r, ()) <- processChainOutput outh
`concurrently` forwardChainError errh
return r
processChainOutput :: Handle -> IO Result
processChainOutput h = go Nothing
where
go lastline = do
v <- catchMaybeIO (hGetLine h)
case v of
Nothing -> case lastline of
Nothing -> do
return FailedChange
Just l -> case readish l of
Just r -> pure r
Nothing -> do
outputConcurrent (l ++ "\n")
return FailedChange
Just s -> do
outputConcurrent $
maybe "" (\l -> if null l then "" else l ++ "\n") lastline
go (Just s)
forwardChainError :: Handle -> IO ()
forwardChainError h = do
v <- catchMaybeIO (hGetLine h)
case v of
Nothing -> return ()
Just s -> do
errorConcurrent (s ++ "\n")
forwardChainError h
runChainPropellor :: Host -> Propellor Result -> IO ()
runChainPropellor h a = do
r <- runPropellor h a
flushConcurrentOutput
putStrLn $ "\n" ++ show r