diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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. diff --git a/README.adoc b/README.adoc deleted file mode 100644 --- a/README.adoc +++ /dev/null @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,233 @@ +![language puppet](https://img.shields.io/hackage/v/language-puppet.svg) +![lts](https://www.stackage.org/package/language-puppet/badge/lts) +![nightly](https://www.stackage.org/package/language-puppet/badge/nightly) +![Build Status](https://travis-ci.org/bartavelle/language-puppet.svg?branch=master) +![cachix cachix orange](https://img.shields.io/badge/cachix-cachix-orange.svg) + +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. 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.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 diff --git a/src/Puppet/Interpreter.hs b/src/Puppet/Interpreter.hs --- a/src/Puppet/Interpreter.hs +++ b/src/Puppet/Interpreter.hs @@ -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 diff --git a/src/Puppet/Interpreter/Helpers.hs b/src/Puppet/Interpreter/Helpers.hs --- a/src/Puppet/Interpreter/Helpers.hs +++ b/src/Puppet/Interpreter/Helpers.hs @@ -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) diff --git a/src/Puppet/Interpreter/IO.hs b/src/Puppet/Interpreter/IO.hs --- a/src/Puppet/Interpreter/IO.hs +++ b/src/Puppet/Interpreter/IO.hs @@ -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 diff --git a/src/Puppet/Language/NativeTypes/Concat.hs b/src/Puppet/Language/NativeTypes/Concat.hs --- a/src/Puppet/Language/NativeTypes/Concat.hs +++ b/src/Puppet/Language/NativeTypes/Concat.hs @@ -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"]]) diff --git a/src/Puppet/Language/NativeTypes/File.hs b/src/Puppet/Language/NativeTypes/File.hs --- a/src/Puppet/Language/NativeTypes/File.hs +++ b/src/Puppet/Language/NativeTypes/File.hs @@ -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 diff --git a/src/Puppet/Parser/Internal.hs b/src/Puppet/Parser/Internal.hs --- a/src/Puppet/Parser/Internal.hs +++ b/src/Puppet/Parser/Internal.hs @@ -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 diff --git a/src/Puppet/Parser/PrettyPrinter.hs b/src/Puppet/Parser/PrettyPrinter.hs --- a/src/Puppet/Parser/PrettyPrinter.hs +++ b/src/Puppet/Parser/PrettyPrinter.hs @@ -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 diff --git a/src/Puppet/Parser/Types.hs b/src/Puppet/Parser/Types.hs --- a/src/Puppet/Parser/Types.hs +++ b/src/Puppet/Parser/Types.hs @@ -277,7 +277,7 @@ data VarAssignDecl = VarAssignDecl { _vadtype :: Maybe UDataType - , _vadname :: !Text + , _vadnames :: [Text] , _vadvalue :: !Expression , _vadpos :: !PPosition } deriving (Eq, Show) diff --git a/src/Puppet/Runner/Puppetlabs.hs b/src/Puppet/Runner/Puppetlabs.hs --- a/src/Puppet/Runner/Puppetlabs.hs +++ b/src/Puppet/Runner/Puppetlabs.hs @@ -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 diff --git a/src/Puppet/Runner/Stdlib.hs b/src/Puppet/Runner/Stdlib.hs --- a/src/Puppet/Runner/Stdlib.hs +++ b/src/Puppet/Runner/Stdlib.hs @@ -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) diff --git a/src/XPrelude/Extra.hs b/src/XPrelude/Extra.hs --- a/src/XPrelude/Extra.hs +++ b/src/XPrelude/Extra.hs @@ -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) diff --git a/tests/Interpreter/EvaluateStatementSpec.hs b/tests/Interpreter/EvaluateStatementSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Interpreter/EvaluateStatementSpec.hs @@ -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" diff --git a/tests/Parser/ExprSpec.hs b/tests/Parser/ExprSpec.hs --- a/tests/Parser/ExprSpec.hs +++ b/tests/Parser/ExprSpec.hs @@ -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',\ diff --git a/tests/Parser/lexer/include.pp b/tests/Parser/lexer/include.pp new file mode 100644 --- /dev/null +++ b/tests/Parser/lexer/include.pp @@ -0,0 +1,2 @@ +include ::java::params +include java::params diff --git a/tests/Parser/lexer/varassignment.pp b/tests/Parser/lexer/varassignment.pp new file mode 100644 --- /dev/null +++ b/tests/Parser/lexer/varassignment.pp @@ -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 diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -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