{-# LANGUAGE LambdaCase #-} {-| Horrible and hackish ... but damn useful. This can be used as a standalone executable or a ghci script for interactive usage. It comes with a sample Puppet site (that I hope will gets more realistic later). When given a single argument, it will try to parse the given file, and will print the parsed values : > $ puppetresources samplesite/manifests/site.pp > node test.nod { > apt::builddep { Interpolable [Literal "glusterfs-server"]: > ; > } > ... With two arguments, it will try to compute the catalog for a given node. The first argument must be the path to the Puppet directory and the second the name of the node. Note that regexp node names do not work yet. > $ puppetresources samplesite test.nod > The defined() function is not implemented for resource references. Returning true at "samplesite/modules/apt/manifests/ppa.pp" (line 20, column 3) > The defined() function is not implemented for resource references. Returning true at "samplesite/modules/apt/manifests/key.pp" (line 38, column 7) > The defined() function is not implemented for resource references. Returning true at "samplesite/modules/apt/manifests/key.pp" (line 42, column 7) > anchor { > "apt::builddep::glusterfs-server": #"samplesite/modules/apt/manifests/builddep.pp" (line 12, column 12) > name => "apt::builddep::glusterfs-server"; > "apt::key/Add key: 55BE302B from Apt::Source debian_unstable": #"samplesite/modules/apt/manifests/key.pp" (line 32, column 16) > name => "apt::key/Add key: 55BE302B from Apt::Source debian_unstable"; > ... When adding a file name as the third argument to the previous invocation, it will display the value of the /content/ attribute of the named /file/ resource. > $ puppetresources samplesite test.nod karmic.pref > The defined() function is not implemented for resource references. Returning true at "samplesite/modules/apt/manifests/ppa.pp" (line 20, column 3) > The defined() function is not implemented for resource references. Returning true at "samplesite/modules/apt/manifests/key.pp" (line 38, column 7) > The defined() function is not implemented for resource references. Returning true at "samplesite/modules/apt/manifests/key.pp" (line 42, column 7) > # karmic > Package: * > Pin: release a=karmic > Pin-Priority: 700 You can also just use a resource name : > $ puppetresources samplesite test.nod 'exec[apt_update]' > exec { > "apt_update": #"samplesite/modules/apt/manifests/update.pp" (line 4, column 10) > command => "/usr/bin/apt-get update", > logoutput => "false", > refreshonly => "true", > returns => 0, > timeout => 300, > tries => 1, > try_sleep => 0; > } With GHCI there are tons of things you can do. First initialize it >>> queryfunc <- initializedaemon "./samplesite/" You can now compute catalogs for various nodes. >>> c1 <- queryfunc "test.nod" The defined() function is not implemented for resource references. Returning true at "./samplesite//modules/apt/manifests/ppa.pp" (line 20, column 3) The defined() function is not implemented for resource references. Returning true at "./samplesite//modules/apt/manifests/key.pp" (line 38, column 7) The defined() function is not implemented for resource references. Returning true at "./samplesite//modules/apt/manifests/key.pp" (line 42, column 7) >>> c2 <- queryfunc "test2.nod" The defined() function is not implemented for resource references. Returning true at "./samplesite//modules/apt/manifests/ppa.pp" (line 20, column 3) The defined() function is not implemented for resource references. Returning true at "./samplesite//modules/apt/manifests/key.pp" (line 38, column 7) The defined() function is not implemented for resource references. Returning true at "./samplesite//modules/apt/manifests/key.pp" (line 42, column 7) And you can check what the difference is between catalogs. >>> diff c1 c2 file[karmic-updates.pref] { # content + Pin-Priority: 750 - Pin-Priority: 700 } You also can manipulate catalogs. >>> Map.size c1 25 >>> mapM_ print $ Map.toList $ Map.map (length . lines . (\x -> case x of (PString n) -> n) .fromJust . Map.lookup "content" . rrattributes) $ Map.filter (Map.member "content" . rrattributes) c1 (("file","debian_unstable.list"),3) (("file","debian_unstable.pref"),4) (("file","karmic-security.pref"),4) (("file","karmic-updates.pref"),4) (("file","karmic.pref"),4) A typical usage of this tool is to compute a reference catalog, and then check the differences as you alter it. This can be done this way : >>> reference <- queryfunc "test.nod" And then run the following command every time you need to verify your changes are correct : >>> queryfunc "test.nod" >>= diff reference -} module Main where import System.IO import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import qualified Data.Set as Set import qualified System.Log.Logger as LOG import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Monoid hiding (First) import qualified Text.Parsec as P import qualified Data.Vector as V import qualified Data.Either.Strict as S import Options.Applicative as O hiding ((&)) import Options.Applicative.Help.Chunk (stringChunk,Chunk(..)) import Control.Monad import Text.Regex.PCRE.String import Data.Text.Strict.Lens import Data.Aeson (encode) import Data.Yaml (decodeFileEither) import Control.Lens as L import Control.Concurrent.ParallelIO (parallel) import Data.Maybe (mapMaybe) import qualified System.FilePath.Glob as G import Data.Either (partitionEithers) import Data.List (isInfixOf) import qualified Test.Hspec.Runner as H import System.Exit (exitFailure, exitSuccess) import Data.Tuple (swap) import Facter import Puppet.PP hiding ((<$>)) import Puppet.Preferences import Puppet.Daemon import Puppet.Interpreter.Types import Puppet.Parser.Types import Puppet.Parser import Puppet.Parser.PrettyPrinter() import Puppet.Interpreter.PrettyPrinter() import PuppetDB.Remote import PuppetDB.Dummy import PuppetDB.TestDB import PuppetDB.Common import Puppet.Testing import Puppet.Stats tshow :: Show a => a -> T.Text tshow = T.pack . show type QueryFunc = T.Text -> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) checkErrorStrict :: S.Either PrettyError x -> IO x checkErrorStrict (S.Left rr) = putDoc (getError rr) >> putStrLn "" >> error "error!" checkErrorStrict (S.Right x) = return x {-| Does all the work of initializing a daemon for querying. Returns the final catalog when given a node name. Note that this is pretty hackish as it will generate facts from the local computer ! -} initializedaemonWithPuppet :: LOG.Priority -> PuppetDBAPI IO -> FilePath -> Maybe FilePath -> (Facts -> Facts) -> HS.HashSet T.Text -> IO (QueryFunc, MStats, MStats, MStats) initializedaemonWithPuppet prio pdbapi puppetdir hierapath overrideFacts ignord = do LOG.updateGlobalLogger "Puppet.Daemon" (LOG.setLevel prio) q <- fmap ((prefPDB .~ pdbapi) . (hieraPath .~ hierapath) . (ignoredmodules .~ ignord)) (genPreferences puppetdir) >>= initDaemon let f ndename = fmap overrideFacts (puppetDBFacts ndename pdbapi) >>= _dGetCatalog q ndename return (f, _dParserStats q, _dCatalogStats q, _dTemplateStats q) parseFile :: FilePath -> IO (Either P.ParseError (V.Vector Statement)) parseFile fp = fmap (runMyParser puppetParser fp) (T.readFile fp) printContent :: T.Text -> FinalCatalog -> IO () printContent filename catalog = case HM.lookup (RIdentifier "file" filename) catalog of Nothing -> error "File not found" Just r -> case HM.lookup "content" (_rattributes r) of Nothing -> error "This file has no content" Just (PString c) -> T.putStrLn c Just x -> print x data CommandLine = CommandLine { _pdb :: Maybe String , _showjson :: Bool , _showContent :: Bool , _resourceType :: Maybe T.Text , _resourceName :: Maybe T.Text , _puppetdir :: FilePath , _nodename :: Maybe String , _pdbfile :: Maybe FilePath , _loglevel :: LOG.Priority , _hieraFile :: Maybe FilePath , _factsFile :: Maybe FilePath , _factsDef :: Maybe FilePath , _commitDB :: Bool , _checkExport :: Bool , _testusergroups :: Bool , _ignoredMods :: HS.HashSet T.Text } deriving Show prepareForPuppetApply :: WireCatalog -> WireCatalog prepareForPuppetApply w = let res = V.filter (\r -> r ^. rvirtuality == Normal) (w ^. wResources) :: V.Vector Resource -- step 1 : capitalize resources types (and names in case of -- classes), and filter out exported stuff capi :: RIdentifier -> RIdentifier capi r = r & itype %~ capitalizeRT & if r ^. itype == "class" then iname %~ capitalizeRT else id aliasMap :: HM.HashMap RIdentifier T.Text aliasMap = HM.fromList $ concatMap genAliasList (res ^.. folded) genAliasList r = map (\n -> (RIdentifier (r ^. rid . itype) n, r ^. rid . iname)) (r ^. rid . iname : r ^.. ralias . folded) nr = V.map (rid %~ capi) res ne = V.map capEdge (w ^. wEdges) capEdge (PuppetEdge a b x) = PuppetEdge (capi a) (capi b) x -- step 2 : replace all references with the resource title in case -- of aliases - yes this sucks knownEdge :: PuppetEdge -> Bool knownEdge (PuppetEdge s d _) = (aliasMap & has (ix s)) && (aliasMap & has (ix d)) correctEdges = V.map correctEdge $ V.filter knownEdge ne correctResources = V.map correctResource nr correct :: RIdentifier -> RIdentifier correct ri = ri & iname %~ \n -> HM.lookupDefault n ri aliasMap correctEdge :: PuppetEdge -> PuppetEdge correctEdge (PuppetEdge s d x) = PuppetEdge (correct s) (correct d) x correctResource :: Resource -> Resource correctResource r = r & rrelations %~ HM.fromList . filter (\(x,_) -> aliasMap & has (ix x)) . map (_1 %~ correct) . HM.toList in (wResources .~ correctResources) . (wEdges .~ correctEdges) $ w cmdlineParser :: Parser CommandLine cmdlineParser = CommandLine <$> optional remotepdb <*> sj <*> sc <*> optional (T.pack <$> rt) <*> optional (T.pack <$> rn) <*> pdir <*> optional nn <*> optional pdbfile <*> priority <*> optional hiera <*> optional fcts <*> optional fco <*> commitdb <*> checkExported <*> tug <*> imods where imods = HS.fromList . T.splitOn "," . T.pack <$> strOption ( long "ignoremodules" <> help "Specify a comma-separated list of modules to ignore" <> value "" ) tug = switch ( long "nousergrouptest" <> help "Disable the user and group tests" ) commitdb = switch ( long "commitdb" <> help "Commit the computed catalogs in the puppetDB" ) checkExported = switch ( long "checkExported" <> help "Save exported resources in the puppetDB") sc = switch ( long "showcontent" <> short 'c' <> help "When specifying a file resource, only output its content (useful for testing templates)") sj = switch ( long "JSON" <> short 'j' <> help "Shows the output as a JSON document (useful for full catalog views)") remotepdb = strOption ( long "pdburl" <> help "URL of the puppetdb (ie. http://localhost:8080/).") rt = strOption ( long "type" <> short 't' <> help "Filter the output by resource type (accepts a regular expression, ie '^file$')") rn = strOption ( long "name" <> short 'n' <> help "Filter the output by resource name (accepts a regular expression)") pdir = strOption ( long "puppetdir" <> short 'p' <> help "Puppet directory") nn = strOption ( long "node" <> short 'o' <> help "Node name. Using 'allnodes' enables a special mode where all nodes present in site.pp are tried. Run with +RTS -N. Using 'deadcode' will do the same, but will print warnings about code that's not being used.") pdbfile = strOption ( long "pdbfile" <> help "Path to the testing PuppetDB file.") hiera = strOption ( long "hiera" <> help "Path to the Hiera configuration file (default hiera.yaml)" <> value "hiera.yaml" ) priority = option ( long "loglevel" <> short 'v' <> help "Values are : DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY" <> value LOG.WARNING ) fcts = strOption ( long "facts-override" <> help "Path to a Yaml file containing a list of 'facts' that will override locally resolved facts" ) fco = strOption ( long "facts-defaults" <> help "Path to a Yaml file containing a list of 'facts' that will be used as defaults" ) loadFactsOverrides :: FilePath -> IO Facts loadFactsOverrides fp = decodeFileEither fp >>= \case Left rr -> error ("Error when parsing " ++ fp ++ ": " ++ show rr) Right x -> return x -- this finds the dead code findDeadCode :: String -> [Resource] -> Set.Set FilePath -> IO () findDeadCode puppetdir catalogs allfiles = do -- first collect all files / positions from all the catalogs let allpositions = Set.fromList $ catalogs ^.. traverse . rpos -- now find all haskell files puppetfiles <- Set.fromList . concat . fst <$> G.globDir [G.compile "**/*.pp"] (puppetdir <> "/modules") let deadfiles = Set.filter ("/manifests/" `isInfixOf`) $ puppetfiles `Set.difference` allfiles usedfiles = puppetfiles `Set.intersection` allfiles unless (Set.null deadfiles) $ do putDoc ("The following files" <+> int (Set.size deadfiles) <+> "are not used: " <> list (map string $ Set.toList deadfiles)) putStrLn "" allparses <- parallel (map parseFile (Set.toList usedfiles)) let (parseFailed, parseSucceeded) = partitionEithers allparses unless (null parseFailed) $ do putDoc ("The following" <+> int (length parseFailed) <+> "files could not be parsed:" indent 4 (vcat (map (string . show) parseFailed))) putStrLn "" let getSubStatements s@(ResourceDeclaration{}) = [s] getSubStatements (ConditionalStatement conds _) = conds ^.. traverse . _2 . tgt getSubStatements s@(ClassDeclaration{}) = extractPrism s getSubStatements s@(DefineDeclaration{}) = extractPrism s getSubStatements s@(Node{}) = extractPrism s getSubStatements s@(SHFunctionCall{}) = extractPrism s getSubStatements (TopContainer v s) = getSubStatements s ++ v ^.. tgt getSubStatements _ = [] tgt = folded . to getSubStatements . folded extractPrism s = s ^.. _Statements . traverse . to getSubStatements . traverse allResources = parseSucceeded ^.. folded . folded . to getSubStatements . folded deadResources = filter isDead allResources isDead (ResourceDeclaration _ _ _ _ pp) = not $ Set.member pp allpositions isDead _ = True unless (null deadResources) $ do putDoc ("The following" <+> int (length deadResources) <+> "resource declarations are not used:" indent 4 (vcat (map pretty deadResources))) putStrLn "" newtype Maximum a = Maximum { getMaximum :: Maybe a } instance (Ord a) => Monoid (Maximum a) where mempty = Maximum Nothing mappend (Maximum Nothing) m2 = m2 mappend m1 (Maximum Nothing) = m1 mappend (Maximum (Just a1)) (Maximum (Just a2)) = Maximum (Just (max a1 a2)) run :: CommandLine -> IO () run (CommandLine _ _ _ _ _ f Nothing _ _ _ _ _ _ _ _ _) = parseFile f >>= \case Left rr -> error ("parse error:" ++ show rr) Right s -> putDoc (vcat (map pretty (V.toList s))) run c@(CommandLine puppeturl _ _ _ _ puppetdir (Just ndename) mpdbf prio hpath fcts fdef docommit _ _ _) = do let checkError r (S.Left rr) = error (show (red r <> ":" <+> getError rr)) checkError _ (S.Right x) = return x tnodename = T.pack ndename pdbapi <- case (puppeturl, mpdbf) of (Nothing, Nothing) -> return dummyPuppetDB (Just _, Just _) -> error "You must choose between a testing PuppetDB and a remote one" (Just url, _) -> pdbConnect (T.pack url) >>= checkError "Error when connecting to the remote PuppetDB" (_, Just file) -> loadTestDB file >>= checkError "Error when initializing the PuppetDB API" !factsOverrides <- case (fcts, fdef) of (Just _, Just _) -> error "You can't use --facts-override and --facts-defaults at the same time" (Just p, Nothing) -> HM.union `fmap` loadFactsOverrides p (Nothing, Just p) -> (flip HM.union) `fmap` loadFactsOverrides p (Nothing, Nothing) -> return id (queryfunc,mPStats,mCStats,mTStats) <- initializedaemonWithPuppet prio pdbapi puppetdir hpath factsOverrides (_ignoredMods c) printFunc <- hIsTerminalDevice stdout >>= \isterm -> return $ \x -> if isterm then putDoc x >> putStrLn "" else displayIO stdout (renderCompact x) >> putStrLn "" let allnodes = tnodename == "allnodes" || deadcode deadcode = tnodename == "deadcode" exit <- if allnodes then do allstmts <- parseFile (puppetdir <> "/manifests/site.pp") >>= \presult -> case presult of Left rr -> error (show rr) Right x -> return x let topnodes = mapMaybe getNodeName (V.toList allstmts) getNodeName (Node (NodeName n) _ _ _) = Just n getNodeName _ = Nothing cats <- parallel (map (computeCatalogs True queryfunc pdbapi printFunc c) topnodes) -- the the parsing statistics, so that we known which files -- were parsed pStats <- getStats mPStats cStats <- getStats mCStats tStats <- getStats mTStats -- merge all the resources together let cc = mapMaybe fst cats testFailures = getSum (cats ^. traverse . _2 . _Just . to (Sum . H.summaryFailures)) allres = (cc ^.. folded . _1 . folded) ++ (cc ^.. folded . _2 . folded) allfiles = Set.fromList $ map T.unpack $ HM.keys pStats when deadcode $ findDeadCode puppetdir allres allfiles -- compute statistics let (parsing, Just (wPName, wPMean)) = worstAndSum pStats (cataloging, Just (wCName, wCMean)) = worstAndSum cStats (templating, Just (wTName, wTMean)) = worstAndSum tStats parserShare = 100 * parsing / cataloging templateShare = 100 * templating / cataloging formatDouble = take 5 . show -- yeah, well ... nbnodes = length topnodes worstAndSum = (_1 %~ getSum) . (_2 %~ fmap swap . getMaximum) . ifoldMap (\k (StatsPoint cnt total _ _) -> (Sum total, Maximum $ Just (total / fromIntegral cnt, k))) putStr ("Tested " ++ show nbnodes ++ " nodes. ") unless (nbnodes == 0) $ do putStrLn (formatDouble parserShare <> "% of total CPU time spent parsing, " <> formatDouble templateShare <> "% spent computing templates") when (prio <= LOG.INFO) $ do putStrLn ("Slowest template: " <> T.unpack wTName <> ", taking " <> formatDouble wTMean <> "s on average") putStrLn ("Slowest file to parse: " <> T.unpack wPName <> ", taking " <> formatDouble wPMean <> "s on average") putStrLn ("Slowest catalog to compute: " <> T.unpack wCName <> ", taking " <> formatDouble wCMean <> "s on average") return $ if testFailures > 0 then exitFailure else exitSuccess else do r <- computeCatalogs False queryfunc pdbapi printFunc c tnodename return $ case snd r of Just s -> if (H.summaryFailures s > 0) then exitFailure else exitSuccess Nothing -> exitSuccess when docommit $ void $ commitDB pdbapi exit computeCatalogs :: Bool -> QueryFunc -> PuppetDBAPI IO -> (Doc -> IO ()) -> CommandLine -> T.Text -> IO (Maybe (FinalCatalog, [Resource]), Maybe H.Summary) computeCatalogs testOnly queryfunc pdbapi printFunc (CommandLine _ showjson showcontent mrt mrn puppetdir _ _ _ _ _ _ _ checkExported disableugtest _) tnodename = queryfunc tnodename >>= \case S.Left rr -> do if testOnly then putDoc ("Problem with" <+> ttext tnodename <+> ":" <+> getError rr mempty) else putDoc (getError rr) >> putStrLn "" >> error "error!" return (Nothing, Just (H.Summary 1 1)) S.Right (rawcatalog,m,rawexported,knownRes) -> do let wireCatalog = generateWireCatalog tnodename (rawcatalog <> rawexported) m when checkExported $ void $ replaceCatalog pdbapi wireCatalog let cmpMatch Nothing _ curcat = return curcat cmpMatch (Just rg) lns curcat = compile compBlank execBlank (T.unpack rg) >>= \case Left rr -> error ("Error compiling regexp 're': " ++ show rr) Right rec -> fmap HM.fromList $ filterM (filterResource lns rec) (HM.toList curcat) filterResource lns rec v = execute rec (v ^. lns) >>= \case Left rr -> error ("Error when applying regexp: " ++ show rr) Right Nothing -> return False _ -> return True filterCatalog = cmpMatch mrt (_1 . itype . unpacked) >=> cmpMatch mrn (_1 . iname . unpacked) testResult <- case (testOnly, showcontent, showjson) of (True, _, _) -> Just `fmap` testCatalog tnodename puppetdir rawcatalog basicTest (_, _, True) -> BSL.putStrLn (encode (prepareForPuppetApply wireCatalog)) >> return Nothing (_, True, _) -> do catalog <- filterCatalog rawcatalog unless (mrt == Just "file" || mrt == Nothing) (error $ "Show content only works for file, not for " ++ show mrt) case mrn of Just f -> printContent f catalog Nothing -> error "You should supply a resource name when using showcontent" return Nothing _ -> do catalog <- filterCatalog rawcatalog exported <- filterCatalog rawexported r <- testCatalog tnodename puppetdir rawcatalog (basicTest >> unless disableugtest usersGroupsDefined) printFunc (pretty (HM.elems catalog)) unless (HM.null exported) $ do printFunc (mempty <+> dullyellow "Exported:" <+> mempty) printFunc (pretty (HM.elems exported)) return (Just r) return (Just (rawcatalog <> rawexported, knownRes), testResult) main :: IO () main = execParser pinfo >>= run where pinfo :: ParserInfo CommandLine pinfo = ParserInfo (helper <*> cmdlineParser) True (stringChunk "A useful program for parsing puppet files, generating and inspecting catalogs") (stringChunk "puppetresources - a useful utility for dealing with Puppet") (Chunk Nothing) 3 True