module Puppet.Runner.Daemon.OptionalTests (testCatalog) where
import XPrelude
import qualified Data.HashSet as Set
import qualified Data.Text as Text
import qualified System.Directory as Directory
import Puppet.Language
import Puppet.Runner.Preferences
testCatalog :: Preferences IO
-> FinalCatalog
-> IO (Either PrettyError ())
testCatalog prefs c =
runExceptT
$ testFileSources (prefs ^. prefPuppetPaths.baseDir) c
*> testUsersGroups (prefs ^. prefKnownusers) (prefs ^. prefKnowngroups) c
testUsersGroups :: [Text] -> [Text] -> FinalCatalog -> ExceptT PrettyError IO ()
testUsersGroups kusers kgroups c = do
let users = Set.fromList $ "" : "0" : map (view (rid . iname)) (getResourceFrom "user") ++ kusers
groups = Set.fromList $ "" : "0" : map (view (rid . iname)) (getResourceFrom "group") ++ kgroups
checkResource lu lg = mapM_ (checkResource' lu lg)
checkResource' lu lg res = do
let msg att name = align (vsep [ "Resource" <+> ppline (res^.rid.itype)
<+> ppline (res^.rid.iname) <+> showPos (res^.rpos._1)
, "references the unknown" <+> att <+> squotes (ppline name)])
<> line
case lu of
Just lu' -> do
let u = res ^. rattributes . lu' . _PString
unless (Set.member u users) $ throwE $ PrettyError (msg "user" u)
Nothing -> pure ()
case lg of
Just lg' -> do
let g = res ^. rattributes . lg' . _PString
unless (Set.member g groups) $ throwE $ PrettyError (msg "group" g)
Nothing -> pure ()
do
checkResource (Just $ ix "owner") (Just $ ix "group") (getResourceFrom "file")
checkResource (Just $ ix "user") (Just $ ix "group") (getResourceFrom "exec")
checkResource (Just $ ix "user") Nothing (getResourceFrom "cron")
checkResource (Just $ ix "user") Nothing (getResourceFrom "ssh_authorized_key")
checkResource (Just $ ix "user") Nothing (getResourceFrom "ssh_authorized_key_secure")
checkResource Nothing (Just $ ix "gid") (getResourceFrom "users")
where
getResourceFrom t = c ^.. traverse . filtered (\r -> r ^. rid . itype == t && r ^. rattributes . at "ensure" /= Just "absent")
testFileSources :: FilePath -> FinalCatalog -> ExceptT PrettyError IO ()
testFileSources basedir c = do
let getfiles = filter presentFile . toList
presentFile r = r ^. rid . itype == "file"
&& (r ^. rattributes . at "ensure") `elem` [Nothing, Just "present"]
&& r ^. rattributes . at "source" /= Just PUndef
recurse r = case r ^? rattributes . ix "recurse" of
Just (PString "true") -> True
Just (PBoolean b) -> b
_ -> False
getsource = mapMaybe (\r -> (,,) <$> pure r <*> r ^. rattributes . at "source" <*> pure (recurse r))
checkAllSources basedir $ (getsource . getfiles) c
checkAllSources :: FilePath -> [(Resource, PValue, Bool)] -> ExceptT PrettyError IO ()
checkAllSources fp fs =
go fs []
where
go :: [(Resource, PValue, Bool)] -> [PrettyError] -> ExceptT PrettyError IO ()
go ((res, filesrc, recurse):xs) es = ExceptT $ do
runExceptT (checkFile fp filesrc recurse) >>= \case
Right () -> runExceptT $ go xs es
Left err ->
runExceptT
$ go xs ((PrettyError $ align (vsep [ "Could not find" <+> pretty filesrc
, getError err
, showPos (res^.rpos^._1)
])):es)
go [] [] = pure ()
go [] es = throwE (mconcat es)
testFile :: Bool -> FilePath -> ExceptT PrettyError IO ()
testFile recurse fp = do
p <- liftIO (Directory.doesFileExist fp)
p' <- if recurse && not p
then liftIO (Directory.doesDirectoryExist fp)
else return p
unless p' (throwE $ PrettyError $ "searched in" <+> squotes (pptext fp))
checkFile :: FilePath -> PValue -> Bool -> ExceptT PrettyError IO ()
checkFile basedir (PString f) recurse =
case Text.stripPrefix "puppet:///" f of
Just stringdir -> case Text.splitOn "/" stringdir of
("modules":modname:rest) -> testFile recurse (basedir <> "/modules/" <> toS modname <> "/files/" <> toS (Text.intercalate "/" rest))
("files":rest) -> testFile recurse (basedir <> "/files/" <> toS (Text.intercalate "/" rest))
("private":_) -> pure ()
_ -> throwE (PrettyError $ "Invalid file source:" <+> ppline f)
Nothing -> return ()
checkFile basedir (PArray xs) recurse = asum [checkFile basedir x recurse | x <- toList xs]
checkFile _ x _ = throwE (PrettyError $ "Source was not a string, but" <+> pretty x)