language-puppet 1.1.3.1 → 1.1.4
raw patch · 22 files changed
+443/−148 lines, 22 filesdep +cryptonitedep +formattingdep +memorydep −cryptohashdep −luautilsdep ~attoparsecdep ~hrubydep ~hslua
Dependencies added: cryptonite, formatting, memory, random
Dependencies removed: cryptohash, luautils
Dependency ranges changed: attoparsec, hruby, hslua
Files
- CHANGELOG.markdown +14/−0
- Erb/Compute.hs +62/−22
- Erb/Evaluate.hs +17/−2
- Puppet/Daemon.hs +6/−4
- Puppet/Interpreter.hs +20/−6
- Puppet/Interpreter/IO.hs +2/−1
- Puppet/Interpreter/PrettyPrinter.hs +2/−1
- Puppet/Interpreter/Pure.hs +9/−7
- Puppet/Interpreter/Resolve.hs +38/−25
- Puppet/Interpreter/Types.hs +17/−6
- Puppet/NativeTypes/File.hs +1/−0
- Puppet/OptionalTests.hs +2/−2
- Puppet/PP.hs +0/−4
- Puppet/Parser.hs +4/−2
- Puppet/Pathes.hs +23/−0
- Puppet/Plugins.hs +44/−9
- Puppet/Preferences.hs +7/−16
- Puppet/Puppetlabs.hs +105/−0
- language-puppet.cabal +11/−7
- ruby/hrubyerb.rb +40/−31
- tests/evals.hs +17/−2
- tests/expr.hs +2/−1
CHANGELOG.markdown view
@@ -1,3 +1,17 @@+# v1.1.4 (2015/09/07)++## New features+* The `regsubst` function now works with arrays.+* The `file` variable is resolved in templates.+* Support for `function_x` calls in templates.++## Bugs fixed+* Expressions such as (-1) are now supported.+* Selectors recognize the undef token now.+* Fixed a bug with parsing lines starting with `::`.+* Sanitize resource names in some missing instances to fix bugs+ when they were starting with `::`.+ # v1.1.3 (2015/05/31) ## New features
Erb/Compute.hs view
@@ -4,6 +4,8 @@ module Erb.Compute(computeTemplate, initTemplateDaemon) where import Puppet.Interpreter.Types+import Puppet.Interpreter.IO+import Puppet.Interpreter.Resolve import Puppet.PP import Puppet.Preferences import Puppet.Stats@@ -11,10 +13,12 @@ import Control.Concurrent import Control.Monad.Except+import Data.Aeson.Lens import qualified Data.Either.Strict as S import Data.FileCache import qualified Data.Text as T import Data.String+import qualified Data.Vector as V import Debug.Trace import Erb.Evaluate import Erb.Parser@@ -38,7 +42,7 @@ newtype TemplateParseError = TemplateParseError { tgetError :: ParseError } -type TemplateQuery = (Chan TemplateAnswer, Either T.Text T.Text, T.Text, Container ScopeInformation)+type TemplateQuery = (Chan TemplateAnswer, Either T.Text T.Text, InterpreterState, InterpreterReader IO) type TemplateAnswer = S.Either PrettyError T.Text showRubyError :: RubyError -> PrettyError@@ -46,29 +50,34 @@ showRubyError (WithOutput str _) = PrettyError $ dullred (string str) showRubyError (OtherError rr) = PrettyError (dullred (text rr)) -initTemplateDaemon :: RubyInterpreter -> Preferences IO -> MStats -> IO (Either T.Text T.Text -> T.Text -> Container ScopeInformation -> IO (S.Either PrettyError T.Text))+initTemplateDaemon :: RubyInterpreter -> Preferences IO -> MStats -> IO (Either T.Text T.Text -> InterpreterState -> InterpreterReader IO -> IO (S.Either PrettyError T.Text)) initTemplateDaemon intr prefs mvstats = do controlchan <- newChan templatecache <- newFileCache let returnError rs = return $ \_ _ _ -> return (S.Left (showRubyError rs))- getRubyScriptPath "hrubyerb.rb" >>= loadFile intr >>= \case- Left rs -> returnError rs- Right () -> registerGlobalFunction4 intr "varlookup" hrresolveVariable >>= \case- Right () -> do- void $ forkIO $ templateDaemon intr (T.pack (prefs^.puppetPaths.modulesPath)) (T.pack (prefs^.puppetPaths.templatesPath)) controlchan mvstats templatecache- return (templateQuery controlchan)- Left rs -> returnError rs+ x <- runExceptT $ do+ liftIO (getRubyScriptPath "hrubyerb.rb") >>= ExceptT . loadFile intr+ ExceptT (registerGlobalFunction4 intr "varlookup" hrresolveVariable)+ ExceptT (registerGlobalFunction5 intr "callextfunc" hrcallfunction)+ liftIO $ void $ forkIO $ templateDaemon intr+ (T.pack (prefs^.puppetPaths.modulesPath))+ (T.pack (prefs^.puppetPaths.templatesPath))+ controlchan+ mvstats+ templatecache+ return (templateQuery controlchan)+ either returnError return x -templateQuery :: Chan TemplateQuery -> Either T.Text T.Text -> T.Text -> Container ScopeInformation -> IO (S.Either PrettyError T.Text)-templateQuery qchan filename scope variables = do+templateQuery :: Chan TemplateQuery -> Either T.Text T.Text -> InterpreterState -> InterpreterReader IO -> IO (S.Either PrettyError T.Text)+templateQuery qchan filename stt rdr = do rchan <- newChan- writeChan qchan (rchan, filename, scope, variables)+ writeChan qchan (rchan, filename, stt, rdr) readChan rchan templateDaemon :: RubyInterpreter -> T.Text -> T.Text -> Chan TemplateQuery -> MStats -> FileCacheR TemplateParseError [RubyStatement] -> IO () templateDaemon intr modpath templatepath qchan mvstats filecache = do nameThread "RubyTemplateDaemon"- (respchan, fileinfo, scope, variables) <- readChan qchan+ (respchan, fileinfo, stt, rdr) <- readChan qchan case fileinfo of Right filename -> do let prts = T.splitOn "/" filename@@ -77,12 +86,15 @@ acceptablefiles <- filterM (fileExist . T.unpack) searchpathes if null acceptablefiles then writeChan respchan (S.Left $ PrettyError $ "Can't find template file for" <+> ttext filename <+> ", looked in" <+> list (map ttext searchpathes))- else measure mvstats filename (computeTemplate intr (Right (head acceptablefiles)) scope variables mvstats filecache) >>= writeChan respchan- Left _ -> measure mvstats "inline" (computeTemplate intr fileinfo scope variables mvstats filecache) >>= writeChan respchan+ else measure mvstats filename (computeTemplate intr (Right (head acceptablefiles)) stt rdr mvstats filecache) >>= writeChan respchan+ Left _ -> measure mvstats "inline" (computeTemplate intr fileinfo stt rdr mvstats filecache) >>= writeChan respchan templateDaemon intr modpath templatepath qchan mvstats filecache -computeTemplate :: RubyInterpreter -> Either T.Text T.Text -> T.Text -> Container ScopeInformation -> MStats -> FileCacheR TemplateParseError [RubyStatement] -> IO TemplateAnswer-computeTemplate intr fileinfo curcontext fvariables mstats filecache = do+computeTemplate :: RubyInterpreter -> Either T.Text T.Text -> InterpreterState -> InterpreterReader IO -> MStats -> FileCacheR TemplateParseError [RubyStatement] -> IO TemplateAnswer+computeTemplate intr fileinfo stt rdr mstats filecache = do+ let (curcontext, fvariables) = case extractFromState stt of+ Nothing -> (mempty, mempty)+ Just (c,v) -> (c,v) let (filename, ufilename) = case fileinfo of Left _ -> ("inline", "inline") Right x -> (x, T.unpack x)@@ -102,14 +114,14 @@ let !msg = "template " ++ ufilename ++ " could not be parsed " ++ show (tgetError err) traceEventIO msg LOG.debugM "Erb.Compute" msg- measure mstats ("ruby - " <> filename) $ mkSafe $ computeTemplateWRuby fileinfo curcontext variables+ measure mstats ("ruby - " <> filename) $ mkSafe $ computeTemplateWRuby fileinfo curcontext variables stt rdr Right ast -> case rubyEvaluate variables curcontext ast of Right ev -> return (S.Right ev) Left err -> do let !msg = "template " ++ ufilename ++ " evaluation failed " ++ show err traceEventIO msg LOG.debugM "Erb.Compute" msg- measure mstats ("ruby efail - " <> filename) $ mkSafe $ computeTemplateWRuby fileinfo curcontext variables+ measure mstats ("ruby efail - " <> filename) $ mkSafe $ computeTemplateWRuby fileinfo curcontext variables stt rdr traceEventIO ("STOP template " ++ T.unpack filename) return o @@ -147,14 +159,40 @@ Left _ -> getSymbol "undef" Right r -> FR.toRuby r -computeTemplateWRuby :: Either T.Text T.Text -> T.Text -> Container ScopeInformation -> IO TemplateAnswer-computeTemplateWRuby fileinfo curcontext variables = FR.freezeGC $ eitherDocIO $ do+hrcallfunction :: RValue -> RValue -> RValue -> RValue -> RValue -> IO RValue+hrcallfunction _ rfname rargs rstt rrdr = do+ efname <- FR.fromRuby rfname+ eargs <- FR.fromRuby rargs+ rdr <- FR.extractHaskellValue rrdr+ stt <- FR.extractHaskellValue rstt+ let err :: String -> IO RValue+ err rr = fmap (either Prelude.snd id) (FR.toRuby (T.pack rr) >>= FR.safeMethodCall "MyError" "new" . (:[]))+ case (,) <$> efname <*> eargs of+ Right (fname, varray) -> do+ let args = case varray of+ [PArray vargs] -> V.toList vargs+ _ -> varray+ (x,_,_) <- interpretMonad rdr stt (resolveFunction' fname args)+ case x of+ Right o -> case o ^? _Number of+ Just n -> FR.toRuby n+ Nothing -> FR.toRuby o+ Left rr -> err (show rr)+ Left rr -> err rr++computeTemplateWRuby :: Either T.Text T.Text -> T.Text -> Container ScopeInformation -> InterpreterState -> InterpreterReader IO -> IO TemplateAnswer+computeTemplateWRuby fileinfo curcontext variables stt rdr = FR.freezeGC $ eitherDocIO $ do rscp <- FR.embedHaskellValue curcontext rvariables <- FR.embedHaskellValue variables+ rstt <- FR.embedHaskellValue stt+ rrdr <- FR.embedHaskellValue rdr let varlist = variables ^. ix curcontext . scopeVariables -- must be called from a "makeSafe" thingie+ contentinfo <- case fileinfo of+ Right fname -> FR.toRuby fname+ Left _ -> FR.toRuby ("-" :: T.Text) let withBinding f = do- erbBinding <- FR.safeMethodCall "ErbBinding" "new" [rscp,rvariables]+ erbBinding <- FR.safeMethodCall "ErbBinding" "new" [rscp,rvariables,contentinfo,rstt, rrdr] case erbBinding of Left x -> return (Left x) Right v -> do@@ -165,6 +203,8 @@ rfname <- FR.toRuby fname withBinding $ \v -> FR.safeMethodCall "Controller" "runFromFile" [rfname,v] Left content -> withBinding $ \v -> FR.toRuby content >>= FR.safeMethodCall "Controller" "runFromContent" . (:[v])+ FR.freeHaskellValue rrdr+ FR.freeHaskellValue rstt FR.freeHaskellValue rvariables FR.freeHaskellValue rscp case o of
Erb/Evaluate.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE LambdaCase #-} -- | Evaluates a ruby template from what's generated by "Erb.Parser".-module Erb.Evaluate (rubyEvaluate, getVariable) where+module Erb.Evaluate (rubyEvaluate, getVariable, extractFromState) where import Puppet.PP import qualified Text.PrettyPrint.ANSI.Leijen as P@@ -14,7 +14,22 @@ import qualified Data.Vector as V import Data.Char (isSpace) import Data.Aeson.Lens+import Data.Tuple.Strict+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe) +extractFromState :: InterpreterState -> Maybe (T.Text, Container ScopeInformation)+extractFromState stt =+ let cs = stt ^. curScope+ in if null cs+ then Nothing+ else let scp = scopeName (head cs)+ classes = (PArray . V.fromList . map PString . HM.keys) (stt ^. loadedClasses)+ scps = stt ^. scopes+ cd = fromMaybe ContRoot (scps ^? ix scp . scopeContainer . cctype) -- get the current containder description+ cscps = scps & ix scp . scopeVariables . at "classes" ?~ ( classes :!: dummypos :!: cd )+ in Just (scp, cscps)+ rubyEvaluate :: Container ScopeInformation -> T.Text -> [RubyStatement] -> Either Doc T.Text rubyEvaluate vars ctx = foldl (evalruby vars ctx) (Right "") . optimize where@@ -60,7 +75,7 @@ evalValue :: PValue -> Either Doc T.Text evalValue (PString x) = Right x evalValue (PNumber x) = Right (scientific2text x)-evalValue x = Right $ tshow x+evalValue x = Right $ T.pack $ show x a2i :: T.Text -> Maybe Integer a2i x = case text2Scientific x of
Puppet/Daemon.hs view
@@ -75,19 +75,19 @@ 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 -> either error id <$> startHiera p Nothing -> return dummyHiera luacontainer <- initLuaMaster (T.pack (prefs ^. puppetPaths.modulesPath)) let myprefs = prefs & prefExtFuncs %~ HM.union luacontainer+ getStatements = parseFunction myprefs pfilecache parserStats+ getTemplate <- initTemplateDaemon intr myprefs templateStats 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))+ -> (Either T.Text T.Text -> InterpreterState -> InterpreterReader IO -> IO (S.Either PrettyError T.Text)) -> MStats -> HieraQueryFunc IO -> Nodename@@ -107,7 +107,9 @@ defaultImpureMethods (prefs ^. ignoredmodules) (prefs ^. externalmodules)- (prefs ^. strictness == Strict))+ (prefs ^. strictness == Strict)+ (prefs ^. puppetPaths)+ ) ndename facts (prefs^.puppetSettings)
Puppet/Interpreter.hs view
@@ -94,16 +94,22 @@ addOverrides' r (ResRefOverride _ prms p) = do -- we used this override, so we discard it scopes . ix scp . scopeOverrides . at (r ^. rid) .= Nothing- let forb = throwPosError ("Override of parameters of the following resource is forbidden in the current context:" </> pretty r <+> showPPos p)+ let forb msg = throwPosError ("Override of parameters ("+ <> list (map (ttext . fst) $ itoList prms)+ <> ") of the following resource is forbidden in the current context:"+ </> pretty r+ <+> showPPos p+ </> ":"+ <+> msg) s <- getScope overrideType <- case r ^. rscope of- [] -> forb -- we could not get the current resource context+ [] -> forb "Could not find the current resource context" -- we could not get the current resource context (x:_) -> if x == s then return CantOverride -- we are in the same context : can't replace, but add stuff else isParent (scopeName s) x >>= \i ->- if i+ if i || (r ^. rid . itype == "class") then return Replace -- we can override what's defined in a parent- else forb+ else forb "Can't override something that was not defined in the parent." ifoldlM (addAttribute overrideType) r prms withDefaults <- mapM (addOverrides >=> addDefaults) rlist -- There might be some overrides that could not be applied. The only@@ -688,14 +694,22 @@ (_, Replace) -> return (r & rattributes . at t ?~ v) (Nothing, _) -> return (r & rattributes . at t ?~ v) (_, CantReplace) -> return r- _ -> do+ (Just curval, _) -> do -- we must check if the resource scope is -- a parent of the current scope curscope <- getScopeName i <- isParent curscope (rcurcontainer r) if i then return (r & rattributes . at t ?~ v)- else throwPosError ("Attribute" <+> dullmagenta (ttext t) <+> "defined multiple times for" <+> pretty (r ^. rid) <+> showPPos (r ^. rpos))+ else do+ -- We will not bark if the same attribute+ -- is defined multiple times with distinct+ -- values.+ let errmsg = "Attribute" <+> dullmagenta (ttext t) <+> "defined multiple times for" <+> pretty (r ^. rid) <+> showPPos (r ^. rpos)+ if curval == v+ then checkStrict errmsg errmsg+ else throwPosError errmsg+ return r registerResource :: T.Text -> T.Text -> Container PValue -> Virtuality -> PPosition -> InterpreterMonad [Resource] registerResource "class" _ _ Virtual p = curPos .= p >> throwPosError "Cannot declare a virtual class (or perhaps you can, but I do not know what this means)"
Puppet/Interpreter/IO.hs view
@@ -80,10 +80,11 @@ Nothing -> thpe (PrettyError ("Unknown function: " <> ttext fname)) GetStatement topleveltype toplevelname -> canFail ((r ^. getStatement) topleveltype toplevelname)- ComputeTemplate fn scp cscps -> canFail ((r ^. computeTemplateFunction) fn scp cscps)+ ComputeTemplate fn stt -> canFail ((r ^. computeTemplateFunction) fn stt r) WriterTell t -> logStuff t (runInstr ()) WriterPass _ -> thpe "WriterPass" WriterListen _ -> thpe "WriterListen"+ PuppetPathes -> runInstr (r ^. ppathes) GetNativeTypes -> runInstr (r ^. nativeTypes) ErrorThrow d -> return (Left d, s, mempty) ErrorCatch _ _ -> thpe "ErrorCatch"
Puppet/Interpreter/PrettyPrinter.hs view
@@ -120,10 +120,11 @@ showQuery = string . BSL.unpack . encode instance Pretty (InterpreterInstr a) where+ pretty PuppetPathes = pf "PuppetPathes" [] pretty IsStrict = pf "IsStrict" [] pretty GetNativeTypes = pf "GetNativeTypes" [] pretty (GetStatement tlt nm) = pf "GetStatement" [pretty tlt,ttext nm]- pretty (ComputeTemplate fn scp _) = pf "ComputeTemplate" [fn', ttext scp]+ pretty (ComputeTemplate fn _) = pf "ComputeTemplate" [fn'] where fn' = case fn of Left content -> pretty (PString content)
Puppet/Interpreter/Pure.hs view
@@ -13,6 +13,7 @@ import Puppet.Interpreter.Types import Puppet.NativeTypes import Puppet.Parser.Types+import Puppet.Pathes import Puppet.PP import PuppetDB.Dummy @@ -32,15 +33,16 @@ -- templates, and that can include only the supplied top level statements. pureReader :: HM.HashMap (TopLevelType, T.Text) Statement -- ^ A top-level statement map -> InterpreterReader Identity-pureReader sttmap = InterpreterReader baseNativeTypes getstatementdummy templatedummy dummyPuppetDB mempty "dummy" hieradummy impurePure mempty mempty True+pureReader sttmap = InterpreterReader baseNativeTypes getstatementdummy templatedummy dummyPuppetDB mempty "dummy" hieradummy impurePure mempty mempty True (defaultPathes "/etc/puppet") where templatedummy (Right _) _ _ = return (S.Left "Can't interpret files")- templatedummy (Left cnt) ctx scope =- return $ case parseErbString (T.unpack cnt) of- Left rr -> S.Left (PrettyError (text (show rr)))- Right stmts -> case rubyEvaluate scope ctx stmts of- Right x -> S.Right x- Left rr -> S.Left (PrettyError rr)+ templatedummy (Left cnt) stt _ = return $ case extractFromState stt of+ Nothing -> S.Left "Context retrieval error (pureReader)"+ Just (ctx, scope) -> case parseErbString (T.unpack cnt) of+ Left rr -> S.Left (PrettyError (text (show rr)))+ Right stmts -> case rubyEvaluate scope ctx stmts of+ Right x -> S.Right x+ Left rr -> S.Left (PrettyError rr) hieradummy _ _ _ = return (S.Right Nothing) getstatementdummy tlt n = return $ case HM.lookup (tlt,n) sttmap of Just x -> S.Right x
Puppet/Interpreter/Resolve.hs view
@@ -14,6 +14,7 @@ resolveExpressionString, resolveExpressionStrings, resolveArgument,+ resolveFunction', runHiera, isNativeType, -- * Search expression management@@ -32,6 +33,7 @@ import Puppet.Interpreter.RubyRandom import Puppet.Interpreter.Types import Puppet.Parser.Types+import Puppet.Pathes import Puppet.PP import Puppet.Utils @@ -39,17 +41,18 @@ import Control.Lens import Control.Monad import Control.Monad.Operational (singleton)-import qualified Crypto.Hash.MD5 as MD5-import qualified Crypto.Hash.SHA1 as SHA1+import Crypto.Hash import Data.Aeson hiding ((.=)) import Data.Aeson.Lens hiding (key) import Data.Bits+import Data.ByteString (ByteString)+import Data.ByteArray (convert) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import Data.CaseInsensitive (mk) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (mapMaybe,fromMaybe) import qualified Data.Maybe.Strict as S import Data.Scientific import qualified Data.Text as T@@ -62,6 +65,12 @@ import Text.Regex.PCRE.ByteString.Utils import Prelude +sha1 :: ByteString -> ByteString+sha1 = convert . (hash :: ByteString -> Digest SHA1)++md5 :: ByteString -> ByteString+md5 = convert . (hash :: ByteString -> Digest MD5)+ -- | A useful type that is used when trying to perform arithmetic on Puppet -- numbers. type NumberPair = Pair Scientific Scientific@@ -71,8 +80,8 @@ fixResourceName :: T.Text -- ^ Resource type -> T.Text -- ^ Resource name -> T.Text-fixResourceName "class" = T.toLower-fixResourceName _ = id+fixResourceName "class" x = T.toLower $ fromMaybe x $ T.stripPrefix "::" x+fixResourceName _ x = x -- | A hiera helper function, that will throw all Hiera errors and log -- messages to the main monad.@@ -299,7 +308,7 @@ unless (S.isNothing (hf ^. hfexpr)) (throwPosError ("You can't combine chains of higher order functions (with .) and giving them parameters, in:" <+> pretty a)) resolveValue (UHFunctionCall (hf & hfexpr .~ S.Just e)) resolveExpression (FunctionApplication _ x) = throwPosError ("Expected function application here, not" <+> pretty x)-resolveExpression x = throwPosError ("Don't know how to resolve this expression:" PP.<$> pretty x)+resolveExpression (Negate x) = PNumber . negate <$> resolveExpressionNumber x -- | Resolves an 'UValue' (terminal for the 'Expression' data type) into -- a 'PValue'@@ -383,7 +392,7 @@ then [fqdn, ""] else fqdn : targs val = fromIntegral (Prelude.fst (limitedRand (randInit myhash) (fromIntegral curmax)))- myhash = toint (MD5.hash (T.encodeUtf8 fullstring)) :: Integer+ myhash = toint (md5 (T.encodeUtf8 fullstring)) :: Integer toint = BS.foldl' (\c nx -> c*256 + fromIntegral nx) 0 fullstring = T.intercalate ":" rargs return (_Integer # val)@@ -418,19 +427,23 @@ resolveFunction' "fail" x = throwPosError ("fail:" <+> pretty x) resolveFunction' "inline_template" [templatename] = calcTemplate Left templatename resolveFunction' "inline_template" _ = throwPosError "inline_template(): Expects a single argument"-resolveFunction' "md5" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . MD5.hash . T.encodeUtf8) (resolvePValueString pstr)+resolveFunction' "md5" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . md5 . T.encodeUtf8) (resolvePValueString pstr) resolveFunction' "md5" _ = throwPosError "md5(): Expects a single argument" resolveFunction' "regsubst" [ptarget, pregexp, preplacement] = resolveFunction' "regsubst" [ptarget, pregexp, preplacement, PString "G"] resolveFunction' "regsubst" [ptarget, pregexp, preplacement, pflags] = do -- TODO handle all the flags -- http://docs.puppetlabs.com/references/latest/function.html#regsubst when (pflags /= "G") (use curPos >>= \p -> warn ("regsubst(): Currently only supports a single flag (G) " <> showPos (S.fst p)))- target <- fmap T.encodeUtf8 (resolvePValueString ptarget) regexp <- fmap T.encodeUtf8 (resolvePValueString pregexp) replacement <- fmap T.encodeUtf8 (resolvePValueString preplacement)- case substituteCompile' regexp target replacement of- Left rr -> throwPosError ("regsubst():" <+> string rr)- Right x -> fmap PString (safeDecodeUtf8 x)+ let sub t = do+ t' <- fmap T.encodeUtf8 (resolvePValueString t)+ case substituteCompile' regexp t' replacement of+ Left rr -> throwPosError ("regsubst():" <+> string rr)+ Right x -> fmap PString (safeDecodeUtf8 x)+ case ptarget of+ PArray a -> fmap PArray (traverse sub a)+ s -> sub s resolveFunction' "regsubst" _ = throwPosError "regsubst(): Expects 3 or 4 arguments" resolveFunction' "split" [psrc, psplt] = do src <- fmap T.encodeUtf8 (resolvePValueString psrc)@@ -438,11 +451,19 @@ case splitCompile' splt src of Left rr -> throwPosError ("splitCompile():" <+> string rr) Right x -> fmap (PArray . V.fromList) (mapM (fmap PString . safeDecodeUtf8) x)-resolveFunction' "sha1" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . SHA1.hash . T.encodeUtf8) (resolvePValueString pstr)+resolveFunction' "sha1" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . sha1 . T.encodeUtf8) (resolvePValueString pstr) resolveFunction' "sha1" _ = throwPosError "sha1(): Expects a single argument"-resolveFunction' "mysql_password" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . SHA1.hash . SHA1.hash . T.encodeUtf8) (resolvePValueString pstr)+resolveFunction' "mysql_password" [pstr] = fmap (PString . T.decodeUtf8 . B16.encode . sha1 . sha1 . T.encodeUtf8) (resolvePValueString pstr) resolveFunction' "mysql_password" _ = throwPosError "mysql_password(): Expects a single argument"-resolveFunction' "file" args = mapM resolvePValueString args >>= fmap PString . singleton . ReadFile+resolveFunction' "file" args = mapM (resolvePValueString >=> fixFilePath) args >>= fmap PString . singleton . ReadFile+ where+ fixFilePath s | T.null s = let rr = "Empty file path passed to the 'file' function" in checkStrict rr rr >> return s+ | T.head s == '/' = return s+ | otherwise = case T.splitOn "/" s of+ (md:x:rst) -> do+ moduledir <- view modulesPath <$> getPuppetPathes+ return (T.intercalate "/" (T.pack moduledir : md : "files" : x : rst))+ _ -> throwPosError ("file() argument invalid: " <> ttext s) resolveFunction' "tagged" ptags = do tags <- fmap HS.fromList (mapM resolvePValueString ptags) scp <- getScopeName@@ -501,16 +522,8 @@ calcTemplate :: (T.Text -> Either T.Text T.Text) -> PValue -> InterpreterMonad PValue calcTemplate templatetype templatename = do fname <- resolvePValueString templatename- classes <- (PArray . V.fromList . map PString . HM.keys) `fmap` use loadedClasses- scp <- getScopeName- scps <- use scopes- -- inject the special template variables (just classes for now)- let cd = fromMaybe ContRoot (scps ^? ix scp . scopeContainer . cctype) -- get the current containder description- -- Inject the classes variable. Note that we are relying on the- -- invariant that the scope is already entered, and hence present- -- in the scps container.- cscps = scps & ix scp . scopeVariables . at "classes" ?~ ( classes :!: dummypos :!: cd )- PString `fmap` singleton (ComputeTemplate (templatetype fname) scp cscps)+ stt <- use id+ PString `fmap` singleton (ComputeTemplate (templatetype fname) stt) resolveExpressionSE :: Expression -> InterpreterMonad PValue resolveExpressionSE e = resolveExpression e >>=
Puppet/Interpreter/Types.hs view
@@ -85,6 +85,7 @@ , safeDecodeUtf8 , getScope , getScopeName+ , getPuppetPathes , scopeName , resourceRelations , checkStrict@@ -143,6 +144,7 @@ import Text.PrettyPrint.ANSI.Leijen hiding (rational, (<$>)) import Prelude +import Puppet.Pathes import Puppet.Parser.PrettyPrinter import Puppet.Parser.Types import Puppet.Stats@@ -283,7 +285,7 @@ data InterpreterReader m = InterpreterReader { _nativeTypes :: !(Container NativeTypeMethods) , _getStatement :: TopLevelType -> T.Text -> m (S.Either PrettyError Statement)- , _computeTemplateFunction :: Either T.Text T.Text -> T.Text -> Container ScopeInformation -> m (S.Either PrettyError T.Text)+ , _computeTemplateFunction :: Either T.Text T.Text -> InterpreterState -> InterpreterReader m -> m (S.Either PrettyError T.Text) , _pdbAPI :: PuppetDBAPI m , _externalFunctions :: Container ([PValue] -> InterpreterMonad PValue) , _thisNodename :: T.Text@@ -292,6 +294,7 @@ , _ignoredModules :: HS.HashSet T.Text , _externalModules :: HS.HashSet T.Text , _isStrict :: Bool+ , _ppathes :: PuppetDirPaths } data ImpureMethods m = ImpureMethods@@ -305,7 +308,7 @@ -- Utility for using what's in "InterpreterReader" GetNativeTypes :: InterpreterInstr (Container NativeTypeMethods) GetStatement :: TopLevelType -> T.Text -> InterpreterInstr Statement- ComputeTemplate :: Either T.Text T.Text -> T.Text -> Container ScopeInformation -> InterpreterInstr T.Text+ ComputeTemplate :: Either T.Text T.Text -> InterpreterState -> InterpreterInstr T.Text ExternalFunction :: T.Text -> [PValue] -> InterpreterInstr PValue GetNodeName :: InterpreterInstr T.Text HieraQuery :: Container T.Text -> T.Text -> HieraQueryType -> InterpreterInstr (Maybe PValue)@@ -313,6 +316,7 @@ IsIgnoredModule :: T.Text -> InterpreterInstr Bool IsExternalModule :: T.Text -> InterpreterInstr Bool IsStrict :: InterpreterInstr Bool+ PuppetPathes :: InterpreterInstr PuppetDirPaths -- error ErrorThrow :: PrettyError -> InterpreterInstr a ErrorCatch :: InterpreterMonad a -> (PrettyError -> InterpreterMonad a) -> InterpreterInstr a@@ -341,6 +345,9 @@ type InterpreterLog = Pair LOG.Priority Doc type InterpreterWriter = [InterpreterLog] +getPuppetPathes :: InterpreterMonad PuppetDirPaths+getPuppetPathes = singleton PuppetPathes+ warn :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m () warn d = tell [LOG.WARNING :!: d] @@ -521,19 +528,23 @@ rcurcontainer :: Resource -> CurContainerDesc rcurcontainer r = fromMaybe ContRoot (r ^? rscope . _head) -class MonadThrowPos m where+class Monad m => MonadThrowPos m where throwPosError :: Doc -> m a +-- Useful for mocking for instance in a REPL+instance MonadThrowPos (Either Doc) where+ throwPosError = Left+ class MonadStack m where- getCallStack :: m [String]+ getCurrentCallStack :: m [String] instance MonadStack InterpreterMonad where- getCallStack = singleton GetCurrentCallStack+ getCurrentCallStack = singleton GetCurrentCallStack instance MonadThrowPos InterpreterMonad where throwPosError s = do p <- use (curPos . _1)- stack <- getCallStack+ stack <- getCurrentCallStack let dstack = if null stack then mempty else mempty </> string (renderStack stack)
Puppet/NativeTypes/File.hs view
@@ -42,6 +42,7 @@ ,("sourceselect", [values ["first","all"]]) ,("target" , [string]) ,("source" , [rarray, strings, flip runarray checkSource])+ ,("seluser" , [string]) ] validateMode :: NativeTypeValidate
Puppet/OptionalTests.hs view
@@ -32,8 +32,8 @@ -- | Tests that all users and groups are defined testUsersGroups :: [T.Text] -> [T.Text] -> FinalCatalog -> IO () testUsersGroups kusers kgroups c = do- let users = HS.fromList $ "" : map (view (rid . iname)) (getResourceFrom "user") ++ kusers- groups = HS.fromList $ "" : map (view (rid . iname)) (getResourceFrom "group") ++ kgroups+ let users = HS.fromList $ "" : "0" : map (view (rid . iname)) (getResourceFrom "user") ++ kusers+ groups = HS.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" <+> ttext (res^.rid.itype)
Puppet/PP.hs view
@@ -1,6 +1,5 @@ module Puppet.PP ( ttext- , tshow , pshow , displayNocolor -- * Re-exports@@ -12,9 +11,6 @@ ttext :: T.Text -> Doc ttext = text . T.unpack--tshow :: Show a => a -> T.Text-tshow = T.pack . show pshow :: Doc -> String pshow d = displayS (renderPretty 0.4 120 d) ""
Puppet/Parser.hs view
@@ -57,9 +57,10 @@ condExpression = do selectedExpression <- try (token terminal <* symbolic '?') let cas = do- c <- (symbol "default" *> return SelectorDefault) -- default case+ c <- (SelectorDefault <$ symbol "default") -- default case <|> fmap SelectorValue (fmap UVariableReference variableReference <|> fmap UBoolean puppetBool+ <|> (UUndef <$ symbol "undef") <|> literalValue <|> fmap UInterpolable interpolableString <|> (URegexp <$> termRegexp))@@ -121,7 +122,8 @@ variableName :: Parser T.Text variableName = do- let acceptablePart = T.pack <$> ident identifierStyle+ let acceptablePart = T.pack <$> many (satisfy identifierAcceptable)+ identifierAcceptable x = isAsciiLower x || isAsciiUpper x || isDigit x || (x == '_') out <- qualif acceptablePart when (out == "string") (fail "The special variable $string should never be used") return out
+ Puppet/Pathes.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}+module Puppet.Pathes where++import Control.Lens+import Data.Monoid++data PuppetDirPaths = PuppetDirPaths+ { _baseDir :: FilePath -- ^ Puppet base working directory+ , _manifestPath :: FilePath -- ^ The path to the manifests.+ , _modulesPath :: FilePath -- ^ The path to the modules.+ , _templatesPath :: FilePath -- ^ The path to the template.+ , _testPath :: FilePath -- ^ The path to a tests folders to hold tests files such as the pdbfiles.+ }++makeClassy ''PuppetDirPaths++defaultPathes :: String -> PuppetDirPaths+defaultPathes basedir = PuppetDirPaths basedir manifestdir modulesdir templatedir testdir+ where+ manifestdir = basedir <> "/manifests"+ modulesdir = basedir <> "/modules"+ templatedir = basedir <> "/templates"+ testdir = basedir <> "/tests"
Puppet/Plugins.hs view
@@ -29,39 +29,74 @@ import Puppet.PP import qualified Scripting.Lua as Lua-import Scripting.LuaUtils() import Control.Exception+import Control.Applicative import qualified Data.HashMap.Strict as HM-import qualified Data.Map.Strict as Map import System.IO import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import qualified Data.Vector as V import Control.Concurrent import Control.Monad.Except import Control.Monad.Operational (singleton) import Data.Scientific+import qualified Data.ByteString as BS+import Control.Lens+import Prelude+import Debug.Trace import Puppet.Interpreter.Types import Puppet.Utils instance Lua.StackValue PValue where- push l (PString s) = Lua.push l s+ push l (PString s) = Lua.push l (T.encodeUtf8 s) push l (PBoolean b) = Lua.push l b- push l (PResourceReference rr _) = Lua.push l rr+ push l (PResourceReference rr _) = Lua.push l (T.encodeUtf8 rr) push l (PArray arr) = Lua.push l (V.toList arr)- push l (PHash m) = Lua.push l (Map.fromList $ HM.toList m)- push l (PUndef) = Lua.push l ("undefined" :: T.Text)+ push l (PHash m) = do+ Lua.newtable l+ forM_ (HM.toList m) $ \(k,v) -> do+ Lua.push l (T.encodeUtf8 k)+ Lua.push l v+ Lua.settable l (-3)+ push l (PUndef) = Lua.push l ("undefined" :: BS.ByteString) push l (PNumber b) = Lua.push l (fromRational (toRational b) :: Double) peek l n = Lua.ltype l n >>= \case Lua.TBOOLEAN -> fmap (fmap PBoolean) (Lua.peek l n)- Lua.TSTRING -> fmap (fmap PString) (Lua.peek l n)+ Lua.TSTRING -> do+ cnt <- Lua.peek l n+ case fmap T.decodeUtf8' cnt of+ Just (Right t) -> return (Just $ PString t)+ _ -> return Nothing Lua.TNUMBER -> fmap (fmap (PNumber . fromFloatDigits)) (Lua.peek l n :: IO (Maybe Double)) Lua.TNIL -> return (Just PUndef) Lua.TNONE -> return (Just PUndef)- Lua.TTABLE -> fmap (fmap (PArray . V.fromList)) (Lua.peek l n)+ Lua.TTABLE -> do+ let go tidx m = do+ isnext <- Lua.next l tidx+ if isnext+ then do+ mk <- Lua.peek l (-2)+ mv <- Lua.peek l (-1)+ traceShow (mk, mv) $ return ()+ Lua.pop l 1+ case HM.insert <$> (mk >>= preview _Right . T.decodeUtf8') <*> mv <*> pure m of+ Just m' -> go tidx m'+ Nothing -> return Nothing+ else return $ Just $ PHash m+ ln <- Lua.objlen l n+ if ln > 0+ then fmap (PArray . V.fromList) <$> Lua.tolist l n+ else do+ tidx <- if n >= 0+ then return n+ else fmap (\top -> top + n + 1) (Lua.gettop l)+ Lua.pushnil l+ go tidx mempty+ _ -> return Nothing valuetype _ = Lua.TUSERDATA@@ -110,7 +145,7 @@ funcfiles <- getLuaFiles moduledir l <- Lua.newstate Lua.openlibs l- luafuncs <- fmap concat $ mapM (loadLuaFile l) funcfiles+ luafuncs <- concat <$> mapM (loadLuaFile l) funcfiles return (l , luafuncs) initLuaMaster :: T.Text -> IO (HM.HashMap T.Text ([PValue] -> InterpreterMonad PValue))
Puppet/Preferences.hs view
@@ -29,19 +29,11 @@ import Puppet.NativeTypes.Helpers import Puppet.Plugins import Puppet.Stdlib+import Puppet.Pathes+import qualified Puppet.Puppetlabs as Puppetlabs import Puppet.Utils import PuppetDB.Dummy -data PuppetDirPaths = PuppetDirPaths- { _baseDir :: FilePath -- ^ Puppet base working directory- , _manifestPath :: FilePath -- ^ The path to the manifests.- , _modulesPath :: FilePath -- ^ The path to the modules.- , _templatesPath :: FilePath -- ^ The path to the template.- , _testPath :: FilePath -- ^ The path to a tests folders to hold tests files such as the pdbfiles.- }--makeClassy ''PuppetDirPaths- data Preferences m = Preferences { _puppetPaths :: PuppetDirPaths , _prefPDB :: PuppetDBAPI m@@ -91,17 +83,16 @@ dfPreferences :: FilePath -> IO (Preferences IO) dfPreferences basedir = do- let manifestdir = basedir <> "/manifests"- modulesdir = basedir <> "/modules"- templatedir = basedir <> "/templates"- testdir = basedir <> "/tests"+ let dirpaths = defaultPathes basedir+ modulesdir = dirpaths ^. modulesPath+ testdir = dirpaths ^. testPath typenames <- fmap (map takeBaseName) (getFiles (T.pack modulesdir) "lib/puppet/type" ".rb") defaults <- loadDefaults (testdir ++ "/defaults.yaml")+ labsFunctions <- Puppetlabs.extFunctions modulesdir let loadedTypes = HM.fromList (map defaulttype typenames)- let dirpaths = PuppetDirPaths basedir manifestdir modulesdir templatedir testdir return $ Preferences dirpaths dummyPuppetDB (baseNativeTypes `HM.union` loadedTypes)- stdlibFunctions+ (HM.union stdlibFunctions labsFunctions) (Just (basedir <> "/hiera.yaml")) (getIgnoredmodules defaults) (getStrictness defaults)
+ Puppet/Puppetlabs.hs view
@@ -0,0 +1,105 @@+-- | Contains an Haskell implementation (or mock implementation) of some ruby functions found in puppetlabs modules+module Puppet.Puppetlabs (extFunctions) where++import Control.Lens+import Crypto.Hash as Crypto+import Data.ByteString (ByteString)+import Data.Foldable (foldlM)+import qualified Data.HashMap.Strict as HM+import Data.Monoid+import Data.Scientific as Sci+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Vector (Vector)+import Formatting (scifmt, sformat, (%), (%.))+import qualified Formatting as FMT+import System.Posix.Files (fileExist)+import System.Random (mkStdGen, randomRs)++import Puppet.Interpreter.PrettyPrinter ()+import Puppet.Interpreter.Types+import Puppet.PP++md5 :: Text -> Text+md5 = Text.pack . show . (Crypto.hash :: ByteString -> Digest MD5) . Text.encodeUtf8++extFun :: [(FilePath, Text, [PValue] -> InterpreterMonad PValue)]+extFun = [ ("/apache", "bool2httpd", apacheBool2httpd)+ , ("/postgresql", "postgresql_acls_to_resources_hash", pgAclsToHash)+ , ("/postgresql", "postgresql_password", pgPassword)+ , ("/foreman", "random_password", randomPassword)+ , ("/foreman", "cache_data", mockCacheData)+ ]++-- | Build the map of available ext functions+-- If the ruby file is not found on the local filesystem the record is ignored. This is to avoid potential namespace conflict+extFunctions :: FilePath -> IO (Container ( [PValue] -> InterpreterMonad PValue))+extFunctions modpath = foldlM f HM.empty extFun+ where+ f acc (modname, fname, fn) = do+ test <- testFile modname fname+ if test+ then return $ HM.insert fname fn acc+ else return acc+ testFile modname fname = fileExist (modpath <> modname <> "/lib/puppet/parser/functions/" <> Text.unpack fname <>".rb")++apacheBool2httpd :: MonadThrowPos m => [PValue] -> m PValue+apacheBool2httpd [PBoolean True] = return $ PString "On"+apacheBool2httpd [PString "true"] = return $ PString "On"+apacheBool2httpd [_] = return $ PString "Off"+apacheBool2httpd arg@_ = throwPosError $ "expect one single argument" <+> pretty arg++pgPassword :: MonadThrowPos m => [PValue] -> m PValue+pgPassword [PString username, PString pwd] =+ return $ PString $ "md5" <> md5 (pwd <> username)+pgPassword _ = throwPosError "expects 2 string arguments"++-- | The function is pure and always return the same "random" password+randomPassword :: MonadThrowPos m => [PValue] -> m PValue+randomPassword x@[PNumber s] =+ PString . Text.pack . randomChars <$> toInt s+ where+ randomChars n = take n $ randomRs ('a', 'z') (mkStdGen 1)+ toInt :: MonadThrowPos m => Scientific -> m Int+ toInt s = maybe (throwPosError $ "Unable to convert" <+> pretty x <+> "into an int.")+ return+ (Sci.toBoundedInteger s)++randomPassword _ = throwPosError "expect one single string arguments"+++mockCacheData :: MonadThrowPos m => [PValue] -> m PValue+mockCacheData [_, b] = return b+mockCacheData arg@_ = throwPosError $ "expect 2 string arguments" <+> pretty arg++-- | Simple implemenation that does not handle all cases.+-- For instance 'auth_option' is currently not implemented.+-- Please add cases as needed.+pgAclsToHash :: MonadThrowPos m => [PValue] -> m PValue+pgAclsToHash [PArray as, PString ident, PNumber offset] = do+ x <- aclsToHash as ident offset+ return $ PHash x+pgAclsToHash _ = throwPosError "expects 3 arguments; one array one string and one number"++aclsToHash :: MonadThrowPos m => Vector PValue -> Text -> Scientific -> m (Container PValue)+aclsToHash vec ident offset = ifoldlM f HM.empty vec+ where+ f :: MonadThrowPos m => Int -> Container PValue -> PValue -> m (Container PValue)+ f idx acc (PString acl) = do+ let order = offset + scientific (toInteger idx) 0+ keymsg = sformat ("postgresql class generated rule " % FMT.stext % " " % FMT.int) ident idx+ x <- aclToHash (Text.words acl) order+ return $ HM.insert keymsg x acc+ f _ _ pval = throwPosError $ "expect a string as acl but get" <+> pretty pval++aclToHash :: (MonadThrowPos m) => [Text] -> Scientific -> m PValue+aclToHash [typ, db, usr, addr, auth] order =+ return $ PHash $ HM.fromList [ ("type", PString typ)+ , ("database", PString db )+ , ("user", PString usr)+ , ("order", PString (sformat (FMT.left 3 '0' %. scifmt Sci.Fixed (Just 0)) order))+ , ("address", PString addr)+ , ("auth_method", PString auth)+ ]+aclToHash acl _ = throwPosError $ "Unable to parse acl line" <+> squotes (ttext (Text.unwords acl))
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 1.1.3.1+version: 1.1.4 synopsis: Tools to parse and evaluate the Puppet DSL. description: This is a set of tools that is supposed to fill all your Puppet needs : syntax checks, catalog compilation, PuppetDB queries, simulationg of complex interactions between nodes, Puppet master replacement, and more ! homepage: http://lpuppet.banquise.net/@@ -52,6 +52,7 @@ , Puppet.Parser.Types , Puppet.PP , Puppet.Preferences+ , Puppet.Puppetlabs , Puppet.Stats , Puppet.Stdlib , Puppet.OptionalTests@@ -73,36 +74,39 @@ , Puppet.NativeTypes.SshSecure , Puppet.NativeTypes.User , Puppet.NativeTypes.ZoneRecord+ , Puppet.Pathes , Puppet.Plugins extensions: OverloadedStrings, BangPatterns- ghc-options: -Wall -funbox-strict-fields+ ghc-options: -Wall -funbox-strict-fields -j1 ghc-prof-options: -auto-all -caf-all build-depends: base >=4.6 && < 4.9 , aeson >= 0.8 && < 0.10 , ansi-wl-pprint == 0.6.*- , attoparsec >= 0.13 && < 0.14+ , attoparsec >= 0.12 && < 0.14 , base16-bytestring == 0.1.* , bytestring , case-insensitive == 1.2.* , containers == 0.5.*- , cryptohash >= 0.10 && < 0.12+ , cryptonite >= 0.6 , directory == 1.2.* , either >= 4.3 && < 4.5 , exceptions >= 0.8 && < 0.9 , filecache >= 0.2.8 && < 0.3+ , formatting , hashable == 1.2.*- , hruby >= 0.3.1.4 && <0.4+ , hruby >= 0.3.1.6 && <0.4 , hslogger == 1.2.*- , hslua >= 0.3.10 && < 0.4+ , hslua >= 0.4 && < 0.5 , lens >= 4.9 && < 5 , lens-aeson >= 1.0- , luautils >= 0.1.3 && < 0.1.4+ , memory >= 0.7 , mtl >= 2.2 && < 2.3 , operational >= 0.2.3 && < 0.3 , parsec == 3.1.* , parsers >= 0.11 && < 0.13 , pcre-utils >= 0.1.4 && < 0.2 , process >= 1.1 && < 1.3+ , random , regex-pcre-builtin >= 0.94.4 , scientific >= 0.2 && < 0.4 , servant == 0.4.*
ruby/hrubyerb.rb view
@@ -3,9 +3,12 @@ require 'yaml' class Scope- def initialize(context,variables)+ def initialize(context,variables,filename,stt,rdr) @context = context @variables = variables+ @file = filename+ @stt = stt+ @rdr = rdr end def [](key)@@ -20,6 +23,9 @@ end def lookupvar(name)+ if name == "file"+ return @file+ end x = vl(name) if x == :undef throw("Unknown variable " + name)@@ -45,41 +51,36 @@ args.to_yaml end - def function_versioncmp(args)- version_a = args[0]- version_b = args[1]- vre = /[-.]|\d+|[^-.\d]+/- ax = version_a.scan(vre)- bx = version_b.scan(vre)-- while (ax.length>0 && bx.length>0)- a = ax.shift- b = bx.shift-- if( a == b ) then next- elsif (a == '-' && b == '-') then next- elsif (a == '-') then return -1- elsif (b == '-') then return 1- elsif (a == '.' && b == '.') then next- elsif (a == '.' ) then return -1- elsif (b == '.' ) then return 1- elsif (a =~ /^\d+$/ && b =~ /^\d+$/) then- if( a =~ /^0/ or b =~ /^0/ ) then- return a.to_s.upcase <=> b.to_s.upcase- end- return a.to_i <=> b.to_i+ def method_missing(sname,*args,&block)+ name = sname.to_s+ if name.start_with?('function_')+ fname = name[9..1000]+ o = callextfunc(fname, args, @stt, @rdr)+ case o+ when MyError+ throw o.getError() else- return a.upcase <=> b.upcase+ return o end end- version_a <=> version_b; end end +class MyError+ def initialize(msg)+ @msg = msg+ end+ def getError+ @msg+ end+end+ class ErbBinding @options = {}- def initialize(context,variables)- @scope = Scope.new(context,variables)+ def initialize(context,variables,filename='x',stt,rdr)+ @stt = stt+ @rdr = rdr+ @scope = Scope.new(context,variables,filename,stt,rdr) end def get_binding return binding()@@ -87,9 +88,18 @@ def has_variable?(name) @scope.has_variable?(name.to_s) end- def method_missing(sname)+ def method_missing(sname,*args,&block) name = sname.to_s- if name == 'scope'+ if name.start_with?('function_')+ fname = name[9..1000]+ o = callextfunc(fname, args, @stt, @rdr)+ case o+ when MyError+ throw o.getError()+ else+ return o+ end+ elsif name == 'scope' @scope else @scope.lookupvar(name)@@ -103,7 +113,6 @@ end def self.runFromContent(content,binding) nerb = ERB.new(content, nil, "-")- # binding = ErbBinding.new(context,variables).get_binding nerb.result(binding.get_binding) end end
tests/evals.hs view
@@ -7,6 +7,7 @@ import Puppet.Interpreter.Types import Puppet.Interpreter.Resolve +import System.Environment import Test.Hspec import Control.Applicative import Text.Parser.Combinators (eof)@@ -23,10 +24,13 @@ , "[1,2,3] << [4,5] == [1,2,3,[4,5]]" , "4 / 2.0 == 2" , "$settings::confdir == '/etc/puppet'"+ , "regsubst('127', '([0-9]+)', '<\\1>', 'G') == '<127>'"+ , "regsubst(['1','2','3'], '([0-9]+)', '<\\1>', 'G') == ['<1>','<2>','<3>']"+ , "versioncmp('2.1','2.2') == -1" ] main :: IO ()-main = hspec $ do+main = do let check :: T.Text -> Either String () check t = case runPParser (expression <* eof) "dummy" t of Left rr -> Left (T.unpack t ++ " -> " ++ show rr)@@ -34,4 +38,15 @@ Right (PBoolean True) -> Right () Right x -> Left (T.unpack t ++ " -> " ++ show (pretty x)) Left rr -> Left (T.unpack t ++ " -> " ++ show rr)- describe "evaluation" $ forM_ pureTests $ \t -> it ("should evaluate " ++ show t) $ either error (const True) (check t)+ runcheck :: String -> IO ()+ runcheck t = case runPParser (expression <* eof) "dummy" (T.pack t) of+ Left rr -> error ("Can't parse: " ++ show rr)+ Right e -> case dummyEval (resolveExpression e) of+ Right x -> print (pretty x)+ Left rr -> error ("Can't eval: " ++ show rr)+ args <- getArgs+ if null args+ then hspec $ describe "evaluation" $ forM_ pureTests $ \t -> it ("should evaluate " ++ show t) $ either error (const True) (check t)+ else mapM_ runcheck args++
tests/expr.hs view
@@ -11,6 +11,7 @@ import Puppet.Parser.PrettyPrinter () import Puppet.Parser.Types import Text.Parser.Combinators+import Prelude testcases :: [(T.Text, Expression)] testcases =@@ -21,7 +22,7 @@ \ undef => 'undef',\ \ default => 'default',\ \ }", ConditionalValue (Terminal (UVariableReference "y"))- (V.fromList [SelectorValue (UString "undef") :!: Terminal (UString "undef")+ (V.fromList [SelectorValue UUndef :!: Terminal (UString "undef") ,SelectorDefault :!: Terminal (UString "default")])) , ("$x", Terminal (UVariableReference "x")) , ("\"${x}\"", Terminal (UInterpolable (V.fromList [Terminal (UVariableReference "x")])))