diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -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 diff --git a/Erb/Compute.hs b/Erb/Compute.hs --- a/Erb/Compute.hs +++ b/Erb/Compute.hs @@ -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 diff --git a/Erb/Evaluate.hs b/Erb/Evaluate.hs --- a/Erb/Evaluate.hs +++ b/Erb/Evaluate.hs @@ -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 diff --git a/Puppet/Daemon.hs b/Puppet/Daemon.hs --- a/Puppet/Daemon.hs +++ b/Puppet/Daemon.hs @@ -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) diff --git a/Puppet/Interpreter.hs b/Puppet/Interpreter.hs --- a/Puppet/Interpreter.hs +++ b/Puppet/Interpreter.hs @@ -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)" diff --git a/Puppet/Interpreter/IO.hs b/Puppet/Interpreter/IO.hs --- a/Puppet/Interpreter/IO.hs +++ b/Puppet/Interpreter/IO.hs @@ -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" diff --git a/Puppet/Interpreter/PrettyPrinter.hs b/Puppet/Interpreter/PrettyPrinter.hs --- a/Puppet/Interpreter/PrettyPrinter.hs +++ b/Puppet/Interpreter/PrettyPrinter.hs @@ -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) diff --git a/Puppet/Interpreter/Pure.hs b/Puppet/Interpreter/Pure.hs --- a/Puppet/Interpreter/Pure.hs +++ b/Puppet/Interpreter/Pure.hs @@ -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 diff --git a/Puppet/Interpreter/Resolve.hs b/Puppet/Interpreter/Resolve.hs --- a/Puppet/Interpreter/Resolve.hs +++ b/Puppet/Interpreter/Resolve.hs @@ -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 >>= diff --git a/Puppet/Interpreter/Types.hs b/Puppet/Interpreter/Types.hs --- a/Puppet/Interpreter/Types.hs +++ b/Puppet/Interpreter/Types.hs @@ -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) diff --git a/Puppet/NativeTypes/File.hs b/Puppet/NativeTypes/File.hs --- a/Puppet/NativeTypes/File.hs +++ b/Puppet/NativeTypes/File.hs @@ -42,6 +42,7 @@ ,("sourceselect", [values ["first","all"]]) ,("target" , [string]) ,("source" , [rarray, strings, flip runarray checkSource]) + ,("seluser" , [string]) ] validateMode :: NativeTypeValidate diff --git a/Puppet/OptionalTests.hs b/Puppet/OptionalTests.hs --- a/Puppet/OptionalTests.hs +++ b/Puppet/OptionalTests.hs @@ -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) diff --git a/Puppet/PP.hs b/Puppet/PP.hs --- a/Puppet/PP.hs +++ b/Puppet/PP.hs @@ -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) "" diff --git a/Puppet/Parser.hs b/Puppet/Parser.hs --- a/Puppet/Parser.hs +++ b/Puppet/Parser.hs @@ -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 diff --git a/Puppet/Pathes.hs b/Puppet/Pathes.hs new file mode 100644 --- /dev/null +++ b/Puppet/Pathes.hs @@ -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" diff --git a/Puppet/Plugins.hs b/Puppet/Plugins.hs --- a/Puppet/Plugins.hs +++ b/Puppet/Plugins.hs @@ -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)) diff --git a/Puppet/Preferences.hs b/Puppet/Preferences.hs --- a/Puppet/Preferences.hs +++ b/Puppet/Preferences.hs @@ -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) diff --git a/Puppet/Puppetlabs.hs b/Puppet/Puppetlabs.hs new file mode 100644 --- /dev/null +++ b/Puppet/Puppetlabs.hs @@ -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)) diff --git a/language-puppet.cabal b/language-puppet.cabal --- a/language-puppet.cabal +++ b/language-puppet.cabal @@ -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.* diff --git a/ruby/hrubyerb.rb b/ruby/hrubyerb.rb --- a/ruby/hrubyerb.rb +++ b/ruby/hrubyerb.rb @@ -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 diff --git a/tests/evals.hs b/tests/evals.hs --- a/tests/evals.hs +++ b/tests/evals.hs @@ -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 + + diff --git a/tests/expr.hs b/tests/expr.hs --- a/tests/expr.hs +++ b/tests/expr.hs @@ -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")])))