language-puppet 1.4.2 → 1.4.3
raw patch · 20 files changed
+469/−295 lines, 20 filesnew-uploader
Files
- CHANGELOG +9/−0
- README.adoc +0/−206
- README.md +233/−0
- language-puppet.cabal +4/−3
- src/Puppet/Interpreter.hs +7/−2
- src/Puppet/Interpreter/Helpers.hs +12/−1
- src/Puppet/Interpreter/IO.hs +42/−38
- src/Puppet/Language/NativeTypes/Concat.hs +1/−0
- src/Puppet/Language/NativeTypes/File.hs +2/−2
- src/Puppet/Parser/Internal.hs +32/−17
- src/Puppet/Parser/PrettyPrinter.hs +5/−1
- src/Puppet/Parser/Types.hs +1/−1
- src/Puppet/Runner/Puppetlabs.hs +39/−17
- src/Puppet/Runner/Stdlib.hs +17/−6
- src/XPrelude/Extra.hs +1/−1
- tests/Interpreter/EvaluateStatementSpec.hs +25/−0
- tests/Parser/ExprSpec.hs +6/−0
- tests/Parser/lexer/include.pp +2/−0
- tests/Parser/lexer/varassignment.pp +29/−0
- tests/Spec.hs +2/−0
CHANGELOG view
@@ -1,3 +1,12 @@+language-puppet (1.4.3) artful; urgency=medium+ * Add the `dirname` stdlib function.+ * Add validate_cmd param to concat.+ * Support double assignment: see #201+ * Support namespace in function name: see #271++language-puppet (1.4.2) artful; urgency=medium+ * Bump upper version bounds for some haskell packages+ language-puppet (1.4.1) artful; urgency=medium * Add the `with` function.
− README.adoc
@@ -1,206 +0,0 @@-= Language-puppet--image:https://img.shields.io/hackage/v/language-puppet.svg[link="http://hackage.haskell.org/package/language-puppet"]-image:https://www.stackage.org/package/language-puppet/badge/lts[link="https://www.stackage.org/lts/package/language-puppet"]-image:https://www.stackage.org/package/language-puppet/badge/nightly[link="https://www.stackage.org/nightly/package/language-puppet"]-image:https://travis-ci.org/bartavelle/language-puppet.svg?branch=master["Build Status", link="https://travis-ci.org/bartavelle/language-puppet"]-image:https://img.shields.io/badge/cachix-cachix-orange.svg[link="https://language-puppet.cachix.org"]--A library to work with Puppet manifests, test them and eventually replace everything ruby.--== Install--.Install with stack:-```bash-stack install language-puppet-```--.Install with nix:-```bash-nix-env -i -f https://github.com/bartavelle/language-puppet/tarball/v1.4.1 <1>-```-<1> replace `1.4.1` with any commit ref or tag--.Build instructions:-```bash-git clone https://github.com/bartavelle/language-puppet.git-cd language-puppet-# Using nix-nix build-# Using stack-ln -s stack-10.yaml stack.yaml-stack build-```--== Puppetresources--.Basic usage:-```-puppetresources --puppetdir /where/your/puppet/files/are --node node.name.com-```--The `puppetresources` command is a command line utility that let you interactively compute catalogs on your local computer.-It is much faster than its ruby counterpart, and has been designed for giving assistance to the Puppet catalog writer.---There are 4 different modes:--* `--node` will display all resources on screen in a nice user-friendly colored fashion.-* `--all` displays statitics and optionally shows dead code.-* `--parse` only goes as far as parsing. No interpretation.-* `--showcontent` to display file content.--Catalog is not computed exactly the same way Puppet does. Some good practices are enforced. A strict and more permissive mode are provided.--=== Command line arguments--`-p` or `--puppetdir`::--This argument is mandatory except in `parse` mode. It must point to the base of the puppet directory (the directory that contains the `modules` and `manifests` directories).--`-o` or `--node`::--Enable the `node mode`. This let you specify the name of the node you wish to compute the catalog for.--`-a` or `--all`::--Enable the `stats mode`. If you specify `allnodes` it will compute the catalogs for all nodes that are specified in `site.pp` (this will not work for regexp-specified or the default nodes). You can also specify a list of nodes separated by a comma.-+-Combined with `--deadcode`, it will display the list of puppet files that have not been used.-+-This is useful as automated tests, to check a change didn't break something. You might want to run this option with `+RTS -N`.--`-t` or `--type`::--Filters the resources of the resulting catalog by type. Using PCRE regex is supported.--`-n` or `--name`::--Filters the resources of the resulting catalog by name. Using PCRE regex is supported.--`-c` or `--showcontent`::--If `-n` is the exact name of a file type resource defined in the catalog, this will display the file content nicely. Useful for debugging templates.-+-Example: `puppetresources -p . -o mynodename -n '/etc/motd' --showcontent`--`--loglevel` or `-v`::--Possible values are : DEBUG, INFO, NOTICE, WARNING, ERROR--`--pdburl`::--Expects the url of a live PuppetDB.--`--pdbfile`::--Expects a path to a *fake* PuppetDB, represented as a YAML file on disk. This option is pretty slow but can be invaluable to test exported resources tricks.--`--hiera`::--Expects the path to the `hiera.yaml` file.--`--ignoredmodules`::--Expects a list of comma-separated modules. The interpreter will not try to parse and evaluate the defined types and classes from this module. This is useful for using modules that use bad-practices forbidden by `puppetresources`.--`--commitdb`::--When this flag is set, exported resources, catalogs and facts are saved in the PuppetDB. This is useful in conjunction with `--pdbfile`.--`--checkExported`::--When this flag is set, exported resources are saved in the PuppetDB. This is useful in conjunction with `--pdbfile`.--`-j` or `--JSON`::--Displays the catalog as a Puppet-compatible JSON file, that can then be used with `puppet apply`.--`--strict`::--Enable strict check.-Strict is less permissive than vanilla Puppet.-It is meant to prevent some pitfalls by enforcing good practices.-For instance it refuses to- - silently ignore/convert `undef` variables- - lookup an hash with an unknown key and return `undef`.--`--noextratests`::--Disable the extra tests from `Puppet.OptionalTests`.--`--parse`::--Enable `parse mode`. Specify the puppet file to be parsed. Variables are not resolved. No interpretation.--`--version`::--Output version information and exist.--=== Settings defaults using a yaml file--Defaults for some of these options can be set using a `/yourworkingdirectory/tests/defaults.yaml` file. For instance `OptionalTests` is checking that all users and groups are known. Because some of these users and groups might be defined outside puppet, a list of known ones is used internally. This can be overridden in that file using the key `knownusers` and `knowngroups`.--Please look at https://github.com/bartavelle/language-puppet/blob/master/tests/defaults.yaml[the template file] for a list of possible defaults.--== pdbQuery--The `pdbquery` command will work with different implementations of PuppetDB (the official one with its HTTP API, the file-based backend and dummy ones). It can be used to:--* export data from production PuppetDB to a file (in order to debug some issue with `puppetresources`).-* query a Puppetdb--Here is a list of command line arguments :--`-l` or `--location`::--The URL of the PuppetDB when working with a remote PuppetDB, a file path when working with the file-based test implementation.--`-t` or `--pdbtype`::--The type of PuppetDB to work with:--* dummy: a dummy PuppetDB.-* remote: a "real" PuppetDB, accessed by its HTTP API.-* test: a file-based backend emulating a PuppetDB.--.Commands--`facts`::-Output facts for a specific node (json)--`nodes`::-Output all nodes (json)--`resources`::-Output all resources for a specific node (json)--`dumpfacts`::-Dump all facts to `/tmp/allfacts.yaml`.--`snapshot`::-Create a test DB from the current DB--`addfacts`::-Adds facts to the test DB for the given node name, if they are not already defined.--`--version`::-Output version information and exit.--== Supported and unsupported idioms or features--Supported version::-puppet 4 is mostly supported. Please look at the list of issues for details.--Custom ruby functions::-The tool might bark when resolving custom ruby functions.-These function can easily be mocked or implemented in Haskell if necessary.--Puppet functions::- * the `require` function is not supported (see https://github.com/bartavelle/language-puppet/issues/17[issue #17])- * the deprecated `import` function is not supported- * the deprecated node inheritance feature is not supported--OS::- Linux is the default OS. The tool has also been successfully installed and used on `OS X`. Windows is not supported.
+ README.md view
@@ -0,0 +1,233 @@+++++++A library to work with Puppet manifests, test them and eventually replace everything ruby.++# Install++**Install with stack:**+```+stack install language-puppet+```++**Install with nix:**+```+nix-env -i -f https://github.com/bartavelle/language-puppet/tarball/v1.4.3+```+(replace `1.4.3` with any commit ref or tag).++**Build from sources:**++```+git clone https://github.com/bartavelle/language-puppet.git+cd language-puppet+# Using nix+nix build+# Using stack+ln -s stack-10.yaml stack.yaml+stack build+```++# Puppetresources++**Basic usage**++ puppetresources --puppetdir /where/your/puppet/files/are --node node.name.com++The `puppetresources` command is a command line utility that let you+interactively compute catalogs on your local computer. It is much faster+than its ruby counterpart, and has been designed for giving assistance+to the Puppet catalog writer.++There are 4 different modes:++ - `--node` will display all resources on screen in a nice+ user-friendly colored fashion.++ - `--all` displays statitics and optionally shows dead code.++ - `--parse` only goes as far as parsing. No interpretation.++ - `--showcontent` to display file content.++Catalog is not computed exactly the same way Puppet does. Some good+practices are enforced. A strict and more permissive mode are provided.++**Command line arguments**++ - `-p` or `--puppetdir`+ This argument is mandatory except in `parse` mode. It must point to+ the base of the puppet directory (the directory that contains the+ `modules` and `manifests` directories).++ - `-o` or `--node`+ Enable the `node mode`. This let you specify the name of the node+ you wish to compute the catalog for.++ - `-a` or `--all`+ Enable the `stats mode`. If you specify `allnodes` it will compute+ the catalogs for all nodes that are specified in `site.pp` (this+ will not work for regexp-specified or the default nodes). You can+ also specify a list of nodes separated by a comma.++ Combined with `--deadcode`, it will display the list of puppet files+ that have not been used.++ This is useful as automated tests, to check a change didn’t break+ something. You might want to run this option with `+RTS -N`.++ - `-t` or `--type`+ Filters the resources of the resulting catalog by type. Using PCRE+ regex is supported.++ - `-n` or `--name`+ Filters the resources of the resulting catalog by name. Using PCRE+ regex is supported.++ - `-c` or `--showcontent`+ If `-n` is the exact name of a file type resource defined in the+ catalog, this will display the file content nicely. Useful for+ debugging templates.++ Example: `puppetresources -p . -o mynodename -n '/etc/motd'+ --showcontent`++ - `--loglevel` or `-v`+ Possible values are : DEBUG, INFO, NOTICE, WARNING, ERROR++ - `--pdburl`+ Expects the url of a live PuppetDB.++ - `--pdbfile`+ Expects a path to a **fake** PuppetDB, represented as a YAML file on+ disk. This option is pretty slow but can be invaluable to test+ exported resources tricks.++ - `--hiera`+ Expects the path to the `hiera.yaml` file.++ - `--ignoredmodules`+ Expects a list of comma-separated modules. The interpreter will not+ try to parse and evaluate the defined types and classes from this+ module. This is useful for using modules that use bad practices+ forbidden by `puppetresources`.++ - `--commitdb`+ When this flag is set, exported resources, catalogs and facts are+ saved in the PuppetDB. This is useful in conjunction with+ `--pdbfile`.++ - `--checkExported`+ When this flag is set, exported resources are saved in the PuppetDB.+ This is useful in conjunction with `--pdbfile`.++ - `-j` or `--JSON`+ Displays the catalog as a Puppet-compatible JSON file, that can then+ be used with `puppet apply`.++ - `--strict`+ Enable strict check. Strict is less permissive than vanilla Puppet.+ It is meant to prevent some pitfalls by enforcing good practices.+ For instance it refuses to++ - silently ignore/convert `undef` variables++ - lookup an hash with an unknown key and return `undef`.++ - `--noextratests`+ Disable the extra tests from `Puppet.OptionalTests`.++ - `--parse`+ Enable `parse mode`. Specify the puppet file to be parsed. Variables+ are not resolved. No interpretation.++ - `--version`+ Output version information and exist.++**Settings defaults using a yaml file**++Defaults for some of these options can be set using a+`/yourworkingdirectory/tests/defaults.yaml` file. For instance+`OptionalTests` is checking that all users and groups are known. Because+some of these users and groups might be defined outside puppet, a list+of known ones is used internally. This can be overridden in that file+using the key `knownusers` and `knowngroups`.++Please look at [the template+file](https://github.com/bartavelle/language-puppet/blob/master/tests/defaults.yaml)+for a list of possible defaults.++# pdbQuery++The `pdbquery` command will work with different implementations of+PuppetDB (the official one with its HTTP API, the file-based backend and+dummy ones). It can be used to:++ - export data from production PuppetDB to a file (in order to debug+ some issue with `puppetresources**).+ - query a Puppetdb++**Command line arguments**++ - `-l` or `--location`+ The URL of the PuppetDB when working with a remote PuppetDB, a file+ path when working with the file-based test implementation.++ - `-t` or `--pdbtype`+ The type of PuppetDB to work with:++ - dummy: a dummy PuppetDB.++ - remote: a "real" PuppetDB, accessed by its HTTP API.++ - test: a file-based backend emulating a PuppetDB.+++ - `facts`+ Output facts for a specific node (json)++ - `nodes`+ Output all nodes (json)++ - `resources`+ Output all resources for a specific node (json)++ - `dumpfacts`+ Dump all facts to `/tmp/allfacts.yaml`.++ - `snapshot`+ Create a test DB from the current DB++ - `addfacts`+ Adds facts to the test DB for the given node name, if they are not+ already defined.++ - `--version`+ Output version information and exit.++# Supported features++ - Supported version+ puppet 4 is mostly supported. Please look at the list of issues for+ details.++ - Custom ruby functions+ The tool might bark when resolving custom ruby functions. These+ function can easily be mocked or implemented in Haskell if+ necessary.++ - Puppet functions++ - the `require` function is not supported (see [issue+ \#17](https://github.com/bartavelle/language-puppet/issues/17))++ - the deprecated `import` function is not supported++ - the deprecated node inheritance feature is not supported++ - OS+ Linux is the default OS. The tool has also been successfully+ installed and used on `OS X`. Windows is not supported.
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 1.4.2+version: 1.4.3 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, simulation of complex interactions between nodes, Puppet master replacement, and more ! homepage: http://lpuppet.banquise.net/@@ -20,7 +20,7 @@ extra-source-files: CHANGELOG- README.adoc+ README.md HLint.hs tests/hiera/*.yaml tests/hiera/*.com.json@@ -94,7 +94,7 @@ , Puppet.Runner.Daemon.OptionalTests , Puppet.Runner.Daemon extensions: OverloadedStrings, BangPatterns, LambdaCase, NoImplicitPrelude, FlexibleContexts, FlexibleInstances- ghc-options: -Wall -funbox-strict-fields -j1+ ghc-options: -Wall -funbox-strict-fields -- ghc-prof-options: -auto-all -caf-all build-depends: aeson >= 0.8 , ansi-wl-pprint >= 0.6.8@@ -169,6 +169,7 @@ Interpreter.CollectorSpec Interpreter.IfSpec Interpreter.EvalSpec+ Interpreter.EvaluateStatementSpec Interpreter.Function.ShellquoteSpec Interpreter.Function.SprintfSpec Interpreter.Function.SizeSpec
src/Puppet/Interpreter.hs view
@@ -466,11 +466,11 @@ evaluateStatement (MainFunctionDeclaration (MainFuncDecl funcname funcargs p)) = do curPos .= p mapM resolveExpression (toList funcargs) >>= mainFunctionCall funcname-evaluateStatement (VarAssignmentDeclaration (VarAssignDecl mt varname varexpr p)) = do+evaluateStatement (VarAssignmentDeclaration (VarAssignDecl mt varnames varexpr p)) = do curPos .= p varval <- resolveExpression varexpr mapM_ (resolveDataType >=> (`checkMatch` varval)) mt- loadVariable varname varval+ mapM_ (flip loadVariable varval) varnames pure [] evaluateStatement (ConditionalDeclaration (ConditionalDecl conds p)) = do curPos .= p@@ -905,6 +905,11 @@ doInclude e = do classname <- resolvePValueString e loadClass classname S.Nothing mempty ClassIncludeLike+mainFunctionCall "require" includes = do+ checkStrict+ "The require function is not supported ! Calling 'include' instead"+ "The 'require' function is not supported in strict mode."+ mainFunctionCall "include" includes mainFunctionCall "create_resources" [t, hs] = mainFunctionCall "create_resources" [t, hs, PHash mempty] mainFunctionCall "create_resources" [PString t, PHash hs, PHash defparams] = do let (ats, t') = Text.span (== '@') t
src/Puppet/Interpreter/Helpers.hs view
@@ -103,12 +103,23 @@ getNodeName:: InterpreterMonad NodeName getNodeName = singleton GetNodeName +-- | Give key such as "os.family"+-- look an hash of facts to retrieve deepest PValue+lookupFacts :: Text -> HashMap Text PValue -> Maybe PValue+lookupFacts key facts =+ let (k0:ks) = Text.splitOn "." key+ f k = \case+ Just (PHash h) -> Map.lookup k h+ x -> x+ in+ List.foldr f (Map.lookup k0 facts) ks+ -- | Ask the value of a fact given a specified key -- The fact set comes from the reader used by the interpreter monad. askFact :: Text -> InterpreterMonad (Maybe PValue) askFact key = do facts <- singleton Facts- pure $ Map.lookup key facts+ pure $ lookupFacts key facts isIgnoredModule :: Text -> InterpreterMonad Bool isIgnoredModule m = singleton (IsIgnoredModule m)
src/Puppet/Interpreter/IO.hs view
@@ -48,44 +48,48 @@ Left err -> thpe err Right x -> runInstr x logStuff x c = (_3 %~ (x <>)) <$> c- in case a of- IsStrict -> runInstr (r ^. readerIsStrict)- ExternalFunction fname args -> case r ^. readerExternalFunc . at fname of- Just fn -> interpretMonad r s ( fn args >>= k)- Nothing -> thpe (PrettyError ("Unknown function: " <> ppline fname))- GetStatement topleveltype toplevelname- -> canFail ((r ^. readerGetStatement) topleveltype toplevelname)- ComputeTemplate src st -> canFail ((r ^. readerGetTemplate) src st r)- WriterTell t -> logStuff t (runInstr ())- WriterPass _ -> thpe "WriterPass"- WriterListen _ -> thpe "WriterListen"- PuppetPaths -> runInstr (r ^. readerPuppetPaths)- Facts -> runInstr (r ^. readerFacts)- RebaseFile -> runInstr (r ^. readerRebaseFile)- GetNativeTypes -> runInstr (r ^. readerNativeTypes)- ErrorThrow d -> return (Left d, s, mempty)- GetNodeName -> runInstr (r ^. readerNodename)- HieraQuery scps q t -> canFail (queryHiera (r ^. readerHieraQuery) scps q t)- PDBInformation -> pdbInformation pdb >>= runInstr- PDBReplaceCatalog w -> canFailX (replaceCatalog pdb w)- PDBReplaceFacts fcts -> canFailX (replaceFacts pdb fcts)- PDBDeactivateNode nn -> canFailX (deactivateNode pdb nn)- PDBGetFacts q -> canFailX (getPDBFacts pdb q)- PDBGetResources q -> canFailX (getResources pdb q)- PDBGetNodes q -> canFailX (getNodes pdb q)- PDBCommitDB -> canFailX (commitDB pdb)- PDBGetResourcesOfNode nn q -> canFailX (getResourcesOfNode pdb nn q)- GetCurrentCallStack -> (r ^. readerIoMethods . ioGetCurrentCallStack) >>= runInstr- ReadFile fls -> strFail ((r ^. readerIoMethods . ioReadFile) fls) (const $ PrettyError ("No file found in " <> list (map ppline fls)))- TraceEvent e -> (r ^. readerIoMethods . ioTraceEvent) e >>= runInstr- IsIgnoredModule m -> runInstr (r ^. readerIgnoredModules . contains m)- IsExternalModule m -> runInstr (r ^. readerExternalModules . contains m)- -- on error, the program state is RESET and the logged messages are dropped- ErrorCatch atry ahandle -> do- (eres, s', w) <- interpretMonad r s atry- case eres of- Left rr -> interpretMonad r s (ahandle rr >>= k)- Right x -> logStuff w (interpretMonad r s' (k x))+ in+ case a of+ IsStrict -> runInstr (r ^. readerIsStrict)+ ExternalFunction name args ->+ -- #271: namespace is currently ignored when looking up puppetlabs functions+ let (nsp, name') = Text.breakOnEnd "::" name+ in+ case r ^. readerExternalFunc . at name' of+ Just fn -> interpretMonad r s ( fn args >>= k)+ Nothing -> thpe (PrettyError ("Unknown function: (" <> ppline nsp <> ")" <> ppline name'))+ GetStatement toptype topname -> canFail ((r ^. readerGetStatement) toptype topname)+ ComputeTemplate src st -> canFail ((r ^. readerGetTemplate) src st r)+ WriterTell t -> logStuff t (runInstr ())+ WriterPass _ -> thpe "WriterPass"+ WriterListen _ -> thpe "WriterListen"+ PuppetPaths -> runInstr (r ^. readerPuppetPaths)+ Facts -> runInstr (r ^. readerFacts)+ RebaseFile -> runInstr (r ^. readerRebaseFile)+ GetNativeTypes -> runInstr (r ^. readerNativeTypes)+ ErrorThrow d -> return (Left d, s, mempty)+ GetNodeName -> runInstr (r ^. readerNodename)+ HieraQuery scps q t -> canFail (queryHiera (r ^. readerHieraQuery) scps q t)+ PDBInformation -> pdbInformation pdb >>= runInstr+ PDBReplaceCatalog w -> canFailX (replaceCatalog pdb w)+ PDBReplaceFacts fcts -> canFailX (replaceFacts pdb fcts)+ PDBDeactivateNode nn -> canFailX (deactivateNode pdb nn)+ PDBGetFacts q -> canFailX (getPDBFacts pdb q)+ PDBGetResources q -> canFailX (getResources pdb q)+ PDBGetNodes q -> canFailX (getNodes pdb q)+ PDBCommitDB -> canFailX (commitDB pdb)+ PDBGetResourcesOfNode nn q -> canFailX (getResourcesOfNode pdb nn q)+ GetCurrentCallStack -> (r ^. readerIoMethods . ioGetCurrentCallStack) >>= runInstr+ ReadFile fls -> strFail ((r ^. readerIoMethods . ioReadFile) fls) (const $ PrettyError ("No file found in " <> list (map ppline fls)))+ TraceEvent e -> (r ^. readerIoMethods . ioTraceEvent) e >>= runInstr+ IsIgnoredModule m -> runInstr (r ^. readerIgnoredModules . contains m)+ IsExternalModule m -> runInstr (r ^. readerExternalModules . contains m)+ -- on error, the program state is RESET and the logged messages are dropped+ ErrorCatch atry ahandle -> do+ (eres, s', w) <- interpretMonad r s atry+ case eres of+ Left rr -> interpretMonad r s (ahandle rr >>= k)+ Right x -> logStuff w (interpretMonad r s' (k x)) -- query all hiera layers
src/Puppet/Language/NativeTypes/Concat.hs view
@@ -18,6 +18,7 @@ ,("path" , [string]) ,("owner" , [string]) ,("group" , [string])+ ,("validate_cmd" , [string]) ,("mode" , [defaultvalue "0644", string]) ,("warn" , [defaultvalue "false", string, values ["false", "true"]]) ,("force" , [defaultvalue "false", string, values ["false", "true"]])
src/Puppet/Language/NativeTypes/File.hs view
@@ -68,8 +68,8 @@ else identity checkSource :: Text -> PValue -> NativeTypeValidate-checkSource _ (PString x) res | any (`Text.isPrefixOf` x) ["puppet://", "file://", "/"] = Right res- | otherwise = throwError "A source should start with either puppet:// or file:// or an absolute path"+checkSource _ (PString x) res | any (`Text.isPrefixOf` x) ["puppet://", "file://", "/", "http://", "https://"] = Right res+ | otherwise = throwError "A source should start with either puppet://, http://, https:// or file:// or an absolute path" checkSource _ x _ = throwError $ PrettyError ("Expected a string, not" <+> pretty x) data PermParts = Special | User | Group | Other
src/Puppet/Parser/Internal.hs view
@@ -111,14 +111,17 @@ ( header <> ) . Text.intercalate "::" <$> p `sepBy1` chunk "::" qualif1 :: Parser Text -> Parser Text-qualif1 p = try $ do+qualif1 p = do r <- qualif p unless ("::" `Text.isInfixOf` r) (fail "This parser is not qualified") pure r -- | Consumes a var $foo and then spaces variableReference :: Parser Text-variableReference = char '$' *> lexeme variableName+variableReference = do+ v <- char '$' *> lexeme variableName+ when (Text.all Char.isDigit v) (fail "Can't assign fully numeric variables")+ pure v variableName :: Parser Text variableName = qualif identifier@@ -126,6 +129,9 @@ className :: Parser Text className = lexeme $ qualif moduleName +funcName :: Parser Text+funcName = lexeme $ qualif $ genericModuleName False+ -- yay with reserved words typeName :: Parser Text typeName = className@@ -218,18 +224,19 @@ -- The first argument defines if non-parenthesized arguments are acceptable genFunctionCall :: Bool -> Parser (Text, Vector Expression) genFunctionCall nonparens = do- fname <- (specialFunctions <|> moduleName) <?> "Function name"- -- this is a hack. Contrary to what the documentation says,- -- a "bareword" can perfectly be a qualified name :- -- include foo::bar- let argsc sep e = (fmap (Terminal . UString) (lexeme (qualif1 moduleName)) <|> e <?> "Function argument A") `sep` comma+ fname <- (specialFunctions <|> funcName) <?> "Function name"+ let+ -- first check if the function arg is not a qualified name (ex.: include foo::bar)+ -- if it is not, then we expect an expression+ qualif_param = (Terminal . UString) <$> qualif1 moduleName <* notFollowedBy (single '(') -- <* lookAhead (anySingleBut '(')+ func_arg expr = try qualif_param <|> expr <?> "Function argument" terminalF = terminalG FunctionWithoutParens- expressionF = makeExprParser (lexeme terminalF) expressionTable <?> "function expression"- withparens = parens (argsc sepEndBy expression)- withoutparens = argsc sepEndBy1 expressionF- args <- withparens <|> if nonparens- then withoutparens <?> "Function arguments B"- else fail "Function arguments C"+ expressionF = makeExprParser (lexeme terminalF) expressionTable <?> "Function expression"+ withparens = parens (func_arg expression `sepEndBy` comma)+ withoutparens = if nonparens+ then func_arg expressionF `sepEndBy1` comma+ else fail "Not an argument list allowed with function without parentheses"+ args <- withparens <|> withoutparens pure (fname, V.fromList args) @@ -331,16 +338,24 @@ <|> varExpression <|> Terminal <$> literalValue +-- | a = b = 0+chainedVariableReferences :: Parser [Text]+chainedVariableReferences = do+ h <- variableReference+ t <- many (try next)+ pure (h:t)+ where+ next = symbolic '=' *> variableReference <* lookAhead (single '=' *> space1)+ varAssign :: Parser VarAssignDecl varAssign = do p <- getSourcePos mt <- optional datatype- v <- variableReference+ vs <- chainedVariableReferences void $ symbolic '='- e <- expression- when (Text.all Char.isDigit v) (fail "Can't assign fully numeric variables")+ expr <- expression pe <- getSourcePos- pure (VarAssignDecl mt v e (p :!: pe))+ pure (VarAssignDecl mt vs expr (p :!: pe)) nodeDecl :: Parser [NodeDecl] nodeDecl = do
src/Puppet/Parser/PrettyPrinter.hs view
@@ -165,6 +165,10 @@ pretty (NodeName n) = pretty (UString n) pretty (NodeMatch r) = pretty (URegexp r) +instance Pretty VarAssignDecl where+ pretty (VarAssignDecl mt vs expr p) =+ foldMap (\t -> pretty t <+> mempty) mt <> dullblue (foldMap (\v -> pretty '$' <> ppline v) vs) <+> pretty '=' <+> pretty expr <+> showPPos p+ instance Pretty Statement where pretty (HigherOrderLambdaDeclaration (HigherOrderLambdaDecl c p)) = pretty c <+> showPPos p pretty (ConditionalDeclaration (ConditionalDecl conds p))@@ -194,7 +198,7 @@ inheritance = case inherit of S.Nothing -> mempty S.Just x -> mempty <+> "inherits" <+> ppline x- pretty (VarAssignmentDeclaration (VarAssignDecl mt a b p)) = foldMap (\t -> pretty t <+> mempty) mt <> dullblue (pretty '$' <> ppline a <+> pretty '=' <+> pretty b <+> showPPos p)+ pretty (VarAssignmentDeclaration decl) = pretty decl pretty (NodeDeclaration (NodeDecl nodename stmts i p)) = dullyellow "node" <+> pretty nodename <> inheritance <+> showPPos p <$> braceStatements stmts where inheritance = case i of
src/Puppet/Parser/Types.hs view
@@ -277,7 +277,7 @@ data VarAssignDecl = VarAssignDecl { _vadtype :: Maybe UDataType- , _vadname :: !Text+ , _vadnames :: [Text] , _vadvalue :: !Expression , _vadpos :: !PPosition } deriving (Eq, Show)
src/Puppet/Runner/Puppetlabs.hs view
@@ -16,6 +16,7 @@ import Formatting (scifmt, sformat, (%), (%.)) import qualified Formatting as FMT import qualified System.Directory as Directory+import System.FilePath ((</>), (<.>)) import System.Random (mkStdGen, randomRs) import Puppet.Interpreter@@ -23,18 +24,20 @@ md5 :: Text -> Text md5 = Text.pack . show . (Crypto.hash :: ByteString -> Digest MD5) . Text.encodeUtf8 -extFun :: [(FilePath, Text, [PValue] -> InterpreterMonad PValue)]-extFun = [ ("/apache", "bool2httpd", apacheBool2httpd)- , ("/docker", "docker_swarm_join_flags", mockDockerSwarmJoinFlags)- , ("/docker", "docker_run_flags", mockDockerRunFlags)- , ("/docker", "docker_stack_flags", mockDockerStackFlags)- , ("/jenkins", "jenkins_port", mockJenkinsPort)- , ("/jenkins", "jenkins_prefix", mockJenkinsPrefix)- , ("/postgresql", "postgresql_acls_to_resources_hash", pgAclsToHash)- , ("/postgresql", "postgresql_password", pgPassword)- , ("/puppetdb", "puppetdb_create_subsetting_resource_hash", puppetdb_create_subsetting_resource_hash)- , ("/extlib", "random_password", randomPassword)- , ("/extlib", "cache_data", mockCacheData)+extFun :: [(Text, Text, [PValue] -> InterpreterMonad PValue)]+extFun = [ ("apache", "bool2httpd", apacheBool2httpd)+ , ("docker", "docker_swarm_join_flags", mockDockerSwarmJoinFlags)+ , ("docker", "docker_swarm_init_flags", mockDockerSwarmInitFlags)+ , ("docker", "docker_run_flags", mockDockerRunFlags)+ , ("docker", "docker_stack_flags", mockDockerStackFlags)+ , ("jenkins", "jenkins_port", mockJenkinsPort)+ , ("jenkins", "jenkins_prefix", mockJenkinsPrefix)+ , ("postgresql", "postgresql_acls_to_resources_hash", pgAclsToHash)+ , ("postgresql", "postgresql_password", pgPassword)+ , ("puppetdb", "puppetdb_create_subsetting_resource_hash", puppetdb_create_subsetting_resource_hash)+ , ("extlib", "random_password", randomPassword)+ , ("extlib", "cache_data", mockCacheData)+ , ("kubernetes", "kubeadm_init_flags", mockKubernetesInitFlags) ] -- | Build the map of available external functions.@@ -43,12 +46,21 @@ extFunctions :: FilePath -> IO (Container ( [PValue] -> InterpreterMonad PValue)) extFunctions modpath = foldlM f Map.empty extFun where- f acc (modname, fname, fn) = do- test <- testFile modname fname+ f acc (nsp, name, fn) = do+ test <- testFile (toS nsp) name if test- then return $ Map.insert fname fn acc- else return acc- testFile modname fname = Directory.doesFileExist (modpath <> modname <> "/lib/puppet/parser/functions/" <> Text.unpack fname <>".rb")+ then pure $ Map.insert name fn acc+ else pure acc+ testFile nspath funcname = do+ let funcpath0 = modpath </> nspath </> "lib/puppet"+ funcpath1 = funcpath0 </> "parser/functions"+ funcpath2 = funcpath0 </> "functions"+ filename = toS funcname <.> "rb"+ isJust <$> Directory.findFile [ funcpath1+ , funcpath2+ , funcpath1 </> nspath+ , funcpath2 </> nspath+ ] filename apacheBool2httpd :: MonadThrowPos m => [PValue] -> m PValue apacheBool2httpd [PBoolean True] = pure $ PString "On"@@ -141,6 +153,16 @@ mockDockerSwarmJoinFlags :: MonadThrowPos m => [PValue] -> m PValue mockDockerSwarmJoinFlags arg@[PHash _]= (pure . PString . show . head) arg mockDockerSwarmJoinFlags arg@_ = throwPosError $ "Expect an hash as argument but was" <+> pretty arg++-- faked implementation, replace by the correct one if you need so.+mockDockerSwarmInitFlags :: MonadThrowPos m => [PValue] -> m PValue+mockDockerSwarmInitFlags arg@[PHash _]= (pure . PString . show . head) arg+mockDockerSwarmInitFlags arg@_ = throwPosError $ "Expect an hash as argument but was" <+> pretty arg++-- faked implementation, replace by the correct one if you need so.+mockKubernetesInitFlags :: MonadThrowPos m => [PValue] -> m PValue+mockKubernetesInitFlags arg@[PHash _]= (pure . PString . show . head) arg+mockKubernetesInitFlags arg@_ = throwPosError $ "Expect an hash as argument but was" <+> pretty arg -- utils scientificToInt :: MonadThrowPos m => Scientific -> m Int
src/Puppet/Runner/Stdlib.hs view
@@ -5,6 +5,7 @@ import XPrelude hiding (sort) +import qualified Data.Yaml as Yaml import Data.Aeson.Lens import qualified Data.ByteString.Base16 as B16 import qualified Data.Char as Char@@ -13,10 +14,12 @@ import qualified Data.List.Split as List (chunksOf) import qualified Data.Scientific as Scientific import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text import Data.Text.Lens (unpacked) import qualified Data.Vector as V import Data.Vector.Lens (toVectorOf) import qualified Text.Regex.PCRE.ByteString.Utils as Regex+import qualified System.FilePath as FilePath import Puppet.Interpreter @@ -45,7 +48,7 @@ , singleArgument "delete_undef_values" deleteUndefValues -- delete_values -- difference- -- dirname+ , singleArgument "dirname" dirname -- dos2unix , ("downcase", stringArrayFunction Text.toLower) , singleArgument "empty" _empty@@ -96,7 +99,7 @@ , ("pick_default", pickDefault) , ("prefix", prefix) -- private- , ("pw_hash", pw_hash)+ , ("pw_hash", pwHash) -- range -- reject -- reverse@@ -120,6 +123,7 @@ -- union , singleArgument "unique" unique -- from puppetlabs-translate+ , singleArgument "to_yaml" toYaml , ("translate", translate) -- unix2dos , ("upcase", stringArrayFunction Text.toUpper)@@ -185,10 +189,10 @@ -- Dummy mock implementation of pw_hash -- To be implemented if required-pw_hash :: [PValue] -> InterpreterMonad PValue-pw_hash [PString (pwd), PString(algo), PString(salt)] =+pwHash :: [PValue] -> InterpreterMonad PValue+pwHash [PString pwd, PString algo, PString salt] = pure (PString ("plain " <> pwd <> "(crypt with " <> algo <> " and " <> salt))-pw_hash _ = throwPosError "pw_hash(): expects 3 string arguments"+pwHash _ = throwPosError "pw_hash(): expects 3 string arguments" foofix :: Doc -> (Text -> Text -> Text) -> [PValue] -> InterpreterMonad PValue foofix nm f args =@@ -232,7 +236,7 @@ base64 :: [PValue] -> InterpreterMonad PValue base64 [pa,pb] = do- b <- encodeUtf8 <$> (resolvePValueString pb)+ b <- encodeUtf8 <$> resolvePValueString pb r <- resolvePValueString pa >>= \case "encode" -> return (B16.encode b) "decode" -> case B16.decode b of@@ -441,6 +445,10 @@ unique (PArray v) = return $ PArray (V.fromList (List.nub (V.toList v))) -- :( unique x = throwPosError ("unique(): Expects an array or a string, not" <+> pretty x) +dirname :: PValue -> InterpreterMonad PValue+dirname (PString s) = pure $ PString (s & unpacked %~ FilePath.takeDirectory)+dirname x = throwPosError ("dirname(): Expects a string, not" <+> pretty x)+ sort :: PValue -> InterpreterMonad PValue sort (PArray s) = let lst = V.toList s@@ -541,3 +549,6 @@ translate :: [PValue] -> InterpreterMonad PValue translate [v@(PString _)] = pure v translate x = throwPosError ("values(): expected a String, not" <+> pretty x)++toYaml :: PValue -> InterpreterMonad PValue+toYaml s = pure $ PString $ Text.decodeUtf8 (Yaml.encode s)
src/XPrelude/Extra.hs view
@@ -32,7 +32,7 @@ unsnoc, withState, (%), (<&>), (<.>)) import Control.Exception.Lens as Exports (catching)-import Control.Lens as Exports hiding (Strict, argument, noneOf, op)+import Control.Lens as Exports hiding (Strict, argument, noneOf, op, (<.>)) import Control.Monad as Exports (fail) import Control.Monad.Trans.Except as Exports (except, throwE, catchE) import Control.Monad.Trans.Maybe as Exports (runMaybeT)
+ tests/Interpreter/EvaluateStatementSpec.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedLists #-}+module Interpreter.EvaluateStatementSpec where++import Helpers+import qualified Data.Text as Text++main :: IO ()+main = hspec spec++shouldNotify :: [Text] -> PValue -> Expectation+shouldNotify s expected = do+ catalog <- case pureCatalog (Text.unlines s) of+ Left rr -> fail rr+ Right (x,_) -> pure x+ let msg = catalog ^? at (RIdentifier "notify" "test")._Just.rattributes. ix "message"+ msg `shouldBe` (Just expected)+++spec :: Spec+spec = do+ describe "evaluate statement" $ do+ it "should evaluate simple variable assignment" $+ [ "$a = 0" , "notify { 'test': message => \"a is ${a}\"}"] `shouldNotify` "a is 0"+ it "should evaluate chained variables assignment" $+ [ "$a = $b = 0" , "notify { 'test': message => \"b is ${b}\"}"] `shouldNotify` "b is 0"
tests/Parser/ExprSpec.hs view
@@ -14,6 +14,12 @@ [ ("5 + 3 * 2", 5 + 3 * 2) , ("5+2 == 7", Equal (5 + 2) 7) , ("include(foo::bar)", Terminal (UFunctionCall "include" ["foo::bar"] ))+ , ("fail(('foo'))", Terminal (UFunctionCall "fail" ["foo"] ))+ , ("test(foo,bar)", Terminal (UFunctionCall "test" ["foo", "bar"] ))+ , ("extlib::test()", Terminal (UFunctionCall "extlib::test" [] ))+ , ("extlib::test(fail('foo'))", Terminal (UFunctionCall "extlib::test" [Terminal (UFunctionCall "fail" [Terminal (UString "foo")])]))+ , ("test(extlib::test())", Terminal (UFunctionCall "test" [Terminal (UFunctionCall "extlib::test" [])] ))+ , ("test ( foo , bar )", Terminal (UFunctionCall "test" ["foo", "bar"] )) , ("$y ? {\ \ undef => 'undef',\ \ default => 'default',\
+ tests/Parser/lexer/include.pp view
@@ -0,0 +1,2 @@+include ::java::params+include java::params
+ tests/Parser/lexer/varassignment.pp view
@@ -0,0 +1,29 @@+# $Id$++$a = 0++$a = {+ c => 1,+ d => $x+}++$a = {+ c => {+ d => 1+ }+}++$a = $b = 0++$a = $b = {+ c => 1,+ d => $x+}++$a = $b = {+ c => {+ d => 1+ }+}++$a = $b == 0
tests/Spec.hs view
@@ -7,6 +7,7 @@ import qualified Interpreter.ClassSpec import qualified Interpreter.CollectorSpec import qualified Interpreter.EvalSpec+import qualified Interpreter.EvaluateStatementSpec import qualified Interpreter.Function.AssertPrivateSpec import qualified Interpreter.Function.DeleteAtSpec import qualified Interpreter.Function.EachSpec@@ -40,6 +41,7 @@ Interpreter.ClassSpec.spec Interpreter.EvalSpec.spec Interpreter.IfSpec.spec+ Interpreter.EvaluateStatementSpec.spec describe "stdlib functions" $ do describe "The assert_private function" Interpreter.Function.AssertPrivateSpec.spec describe "The join_keys_to_values function" Interpreter.Function.JoinKeysToValuesSpec.spec