diff --git a/language-docker.cabal b/language-docker.cabal --- a/language-docker.cabal +++ b/language-docker.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: a57fde3be580edb76aab82767e9e47bbe3cb585d5ea2af07eeb05b5331a5bac8 +-- hash: 723b9670b2b0a9fecb8914d87e55f64c1f0fac09afa4d901a24ae08d04b612bc name: language-docker -version: 10.4.1 +version: 10.4.2 synopsis: Dockerfile parser, pretty-printer and embedded DSL description: All functions for parsing and pretty-printing Dockerfiles are exported through @Language.Docker@. For more fine-grained operations look for specific modules that implement a certain functionality. See the for the source-code and examples. @@ -86,6 +86,7 @@ main-is: Spec.hs other-modules: Language.Docker.IntegrationSpec + Language.Docker.ParseCmdSpec Language.Docker.ParseCopySpec Language.Docker.ParsePragmaSpec Language.Docker.ParserSpec diff --git a/src/Language/Docker/Parser/Arguments.hs b/src/Language/Docker/Parser/Arguments.hs --- a/src/Language/Docker/Parser/Arguments.hs +++ b/src/Language/Docker/Parser/Arguments.hs @@ -10,7 +10,7 @@ -- Parse arguments of a command in the exec form argumentsExec :: (?esc :: Char) => Parser (Arguments Text) argumentsExec = do - args <- brackets $ commaSep stringLiteral + args <- brackets $ commaSep doubleQuotedStringUnescaped return $ ArgumentsList (T.unwords args) -- Parse arguments of a command in the shell form diff --git a/src/Language/Docker/Parser/Copy.hs b/src/Language/Docker/Parser/Copy.hs --- a/src/Language/Docker/Parser/Copy.hs +++ b/src/Language/Docker/Parser/Copy.hs @@ -91,7 +91,7 @@ where spaceSeparated = someUnless "a file" (== ' ') `sepEndBy1` (try requiredWhitespace "at least another file path") - stringList = brackets $ commaSep stringLiteral + stringList = brackets $ commaSep doubleQuotedString unexpectedFlag :: Text -> Text -> Parser a unexpectedFlag name "" = customFailure $ NoValueFlagError (T.unpack name) diff --git a/src/Language/Docker/Parser/Prelude.hs b/src/Language/Docker/Parser/Prelude.hs --- a/src/Language/Docker/Parser/Prelude.hs +++ b/src/Language/Docker/Parser/Prelude.hs @@ -1,36 +1,39 @@ {-# LANGUAGE DeriveDataTypeable #-} module Language.Docker.Parser.Prelude - ( customError, + ( + DockerfileError (..), + Error, + Parser, + anyUnless, + brackets, + caseInsensitiveString, + commaSep, comment, + customError, + doubleQuotedString, + doubleQuotedStringUnescaped, eol, - reserved, - natural, - commaSep, - spaceSep1, - stringLiteral, - brackets, heredoc, - heredocMarker, heredocContent, - whitespace, - requiredWhitespace, - untilEol, - untilHeredoc, - symbol, - onlySpaces, - onlyWhitespaces, - caseInsensitiveString, - stringWithEscaped, - lexeme, - lexeme', + heredocMarker, isNl, isSpaceNl, - anyUnless, + lexeme', + lexeme, + natural, + onlySpaces, + onlyWhitespaces, + requiredWhitespace, + reserved, + singleQuotedString, someUnless, - Parser, - Error, - DockerfileError (..), + spaceSep1, + stringWithEscaped, + symbol, + untilEol, + untilHeredoc, + whitespace, module Megaparsec, char, L.charLiteral, @@ -135,20 +138,24 @@ spaceSep1 :: Parser a -> Parser [a] spaceSep1 p = sepEndBy1 p onlySpaces --- | Note this is just an alias for compatibility -stringLiteral :: Parser Text -stringLiteral = doubleQuotedString - singleQuotedString :: Parser Text singleQuotedString = quotedString '\'' doubleQuotedString :: Parser Text doubleQuotedString = quotedString '\"' +-- | Special variant of the doubleQuotedString parser. +-- This removes escaped newlines from the quoted string. +-- When using the exec form for CMD, RUN and ENTRYPOINT, this mirrors the +-- behavior of Docker. +doubleQuotedStringUnescaped :: (?esc :: Char) => Parser Text +doubleQuotedStringUnescaped = do + let needle = T.pack [ ?esc, '\n' ] + in T.replace needle "" <$> doubleQuotedString + quotedString :: Char -> Parser Text quotedString c = do - void $ char c - lit <- manyTill L.charLiteral (char c) + lit <- char c >> manyTill anySingle (char c) return $ T.pack lit brackets :: (?esc :: Char) => Parser a -> Parser a diff --git a/src/Language/Docker/Parser/Run.hs b/src/Language/Docker/Parser/Run.hs --- a/src/Language/Docker/Parser/Run.hs +++ b/src/Language/Docker/Parser/Run.hs @@ -227,7 +227,7 @@ ] stringArg :: (?esc :: Char) => Parser Text -stringArg = choice [stringLiteral, someUnless "a string" (== ',')] +stringArg = choice [doubleQuotedString, someUnless "a string" (== ',')] key :: Text -> Parser a -> Parser a key name p = string (name <> "=") *> p diff --git a/test/Language/Docker/ParseCmdSpec.hs b/test/Language/Docker/ParseCmdSpec.hs new file mode 100644 --- /dev/null +++ b/test/Language/Docker/ParseCmdSpec.hs @@ -0,0 +1,37 @@ +module Language.Docker.ParseCmdSpec where + +import Data.Default.Class (def) +import Language.Docker.Parser +import Language.Docker.Syntax +import Test.HUnit hiding (Label) +import Test.Hspec +import TestHelper +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Set as Set +import qualified Data.Text as Text + + +spec :: Spec +spec = do + describe "parse CMD instructions" $ do + it "one line cmd" $ assertAst "CMD true" [Cmd "true"] + it "cmd over several lines" $ + assertAst "CMD true \\\n && true" [Cmd "true && true"] + it "quoted command params" $ assertAst "CMD [\"echo\", \"1\"]" [Cmd ["echo", "1"]] + it "Parses commas correctly" $ assertAst "CMD [ \"echo\" ,\"-e\" , \"1\"]" [Cmd ["echo", "-e", "1"]] + + -- This is the Dockefile statement under test (cleaned of Haskell escapes): + -- + -- CMD [ "/bin/sh", "-c", \ + -- "echo foo && \ + -- echo bar" \ + -- ] + it "parse exec style CMD with long broken lines" $ do + let cmd = + Text.unlines + [ "CMD [ \"/bin/sh\", \"-c\", \\", + " \"echo foo && \\", + " echo bar\" \\", + " ]" + ] + in assertAst cmd [ Cmd [ "/bin/sh", "-c", "echo foo && echo bar" ] ] diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -174,12 +174,6 @@ [ Env [("PHP_FPM_ACCESS_FORMAT", "%R - %u %t \"%m %r\" %s")] ] in assertAst dockerfile ast - describe "parse CMD" $ do - it "one line cmd" $ assertAst "CMD true" [Cmd "true"] - it "cmd over several lines" $ - assertAst "CMD true \\\n && true" [Cmd "true && true"] - it "quoted command params" $ assertAst "CMD [\"echo\", \"1\"]" [Cmd ["echo", "1"]] - it "Parses commas correctly" $ assertAst "CMD [ \"echo\" ,\"-e\" , \"1\"]" [Cmd ["echo", "-e", "1"]] describe "parse SHELL" $ it "quoted shell params" $ assertAst "SHELL [\"/bin/bash\", \"-c\"]" [Shell ["/bin/bash", "-c"]]