module Puppet.Daemon (initDaemon, logDebug, logInfo, logWarning, logError) where
import Puppet.Parser
import Puppet.Utils
import Puppet.Preferences
import Puppet.Stats
import Puppet.Interpreter.Types
import Puppet.Parser.Types
import Puppet.Manifests
import Puppet.Interpreter
import Puppet.Interpreter.IO
import Puppet.Plugins
import Puppet.PP
import Hiera.Server
import Erb.Compute
import Data.FileCache
import qualified System.Log.Logger as LOG
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM
import Debug.Trace
import Control.Lens
import qualified Data.Either.Strict as S
import Data.Tuple.Strict
import Control.Exception
import Foreign.Ruby.Safe
loggerName :: String
loggerName = "Puppet.Daemon"
logDebug :: T.Text -> IO ()
logDebug = LOG.debugM loggerName . T.unpack
logInfo :: T.Text -> IO ()
logInfo = LOG.infoM loggerName . T.unpack
logWarning :: T.Text -> IO ()
logWarning = LOG.warningM loggerName . T.unpack
logError :: T.Text -> IO ()
logError = LOG.errorM loggerName . T.unpack
initDaemon :: Preferences IO -> IO DaemonMethods
initDaemon prefs = do
logDebug "initDaemon"
traceEventIO "initDaemon"
templateStats <- newStats
parserStats <- newStats
catalogStats <- newStats
pfilecache <- newFileCache
let getStatements = parseFunction prefs pfilecache parserStats
intr <- startRubyInterpreter
getTemplate <- initTemplateDaemon intr prefs templateStats
hquery <- case prefs ^. hieraPath of
Just p -> startHiera p >>= \case
Left _ -> return dummyHiera
Right x -> return x
Nothing -> return dummyHiera
luacontainer <- initLuaMaster (T.pack (prefs ^. modulesPath))
let myprefs = prefs & prefExtFuncs %~ HM.union luacontainer
return (DaemonMethods (gCatalog myprefs getStatements getTemplate catalogStats hquery) parserStats catalogStats templateStats)
gCatalog :: Preferences IO
-> ( TopLevelType -> T.Text -> IO (S.Either PrettyError Statement) )
-> (Either T.Text T.Text -> T.Text -> Container ScopeInformation -> IO (S.Either PrettyError T.Text))
-> MStats
-> HieraQueryFunc IO
-> T.Text
-> Facts
-> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource]))
gCatalog prefs getStatements getTemplate stats hquery ndename facts = do
logDebug ("Received query for node " <> ndename)
traceEventIO ("START gCatalog " <> T.unpack ndename)
(stmts :!: warnings) <- measure stats ndename $
getCatalog interpretMonad
getStatements
getTemplate
(prefs ^. prefPDB)
ndename
facts
(prefs ^. natTypes)
(prefs ^. prefExtFuncs)
hquery
defaultImpureMethods
(prefs ^. ignoredmodules)
mapM_ (\(p :!: m) -> LOG.logM loggerName p (displayS (renderCompact (ttext ndename <> ":" <+> m)) "")) warnings
traceEventIO ("STOP gCatalog " <> T.unpack ndename)
return stmts
parseFunction :: Preferences IO -> FileCache (V.Vector Statement) -> MStats -> TopLevelType -> T.Text -> IO (S.Either PrettyError Statement)
parseFunction prefs filecache stats topleveltype toplevelname =
case compileFileList prefs topleveltype toplevelname of
S.Left rr -> return (S.Left rr)
S.Right fname -> do
let sfname = T.unpack fname
handleFailure :: SomeException -> IO (S.Either String (V.Vector Statement))
handleFailure e = return (S.Left (show e))
x <- measure stats fname (query filecache sfname (parseFile sfname `catch` handleFailure))
case x of
S.Right stmts -> filterStatements topleveltype toplevelname stmts
S.Left rr -> return (S.Left (PrettyError (red (text rr))))
compileFileList :: Preferences IO -> TopLevelType -> T.Text -> S.Either PrettyError T.Text
compileFileList prefs TopNode _ = S.Right (T.pack (prefs ^. manifestPath) <> "/site.pp")
compileFileList prefs _ name = moduleInfo
where
moduleInfo | length nameparts == 1 = S.Right (mpath <> "/" <> name <> "/manifests/init.pp")
| null nameparts = S.Left "no name parts, error in compilefilelist"
| otherwise = S.Right (mpath <> "/" <> head nameparts <> "/manifests/" <> T.intercalate "/" (tail nameparts) <> ".pp")
mpath = T.pack (prefs ^. modulesPath)
nameparts = T.splitOn "::" name
parseFile :: FilePath -> IO (S.Either String (V.Vector Statement))
parseFile fname = do
traceEventIO ("START parsing " ++ fname)
cnt <- T.readFile fname
o <- case runPParser puppetParser fname cnt of
Right r -> traceEventIO ("Stopped parsing " ++ fname) >> return (S.Right r)
Left rr -> traceEventIO ("Stopped parsing " ++ fname ++ " (failure: " ++ show rr ++ ")") >> return (S.Left (show rr))
traceEventIO ("STOP parsing " ++ fname)
return o