diff --git a/src/Language/Docker/Parser/From.hs b/src/Language/Docker/Parser/From.hs index 1e14de1..577a304 100644 --- a/src/Language/Docker/Parser/From.hs +++ b/src/Language/Docker/Parser/From.hs @@ -9,9 +9,9 @@ import Language.Docker.Syntax parseRegistry :: (?esc :: Char) => Parser Registry parseRegistry = do - domain <- someUnless "a domain name" (== '.') + domain <- someUnlessExpanded "a domain name" (== '.') void $ char '.' - tld <- someUnless "a TLD" (== '/') + tld <- someUnlessExpanded "a TLD" (== '/') void $ char '/' return $ Registry (domain <> "." <> tld) @@ -22,12 +22,44 @@ parsePlatform = do requiredWhitespace return p +-- | Like someUnless, but a ${...} parameter expansion is opaque: a ':' or '@' +-- inside it (the :- :? :+ operators) is not read as the tag or digest +-- separator. One linear pass, bounded to the current line. +someUnlessExpanded :: (?esc :: Char) => String -> (Char -> Bool) -> Parser Text +someUnlessExpanded name predicate = + mconcat <$> some (variableExpansion <|> literalRun) name + where + literalRun = someUnless name (\c -> predicate c || c == '$') + +-- | A '$' and, when it opens one, the balanced ${...} that follows. The scan +-- stops at whitespace, so an unterminated '${' stays literal text bounded like +-- any image reference (it cannot swallow a same-line 'AS' alias or a later +-- instruction, nor backtrack). Fragments are collected in a list and joined +-- once, so deep nesting stays linear. +variableExpansion :: Parser Text +variableExpansion = do + void $ char '$' + brace <- optional (char '{') + case brace of + Nothing -> return "$" + Just _ -> ("${" <>) <$> braces [] (1 :: Int) + where + braces acc depth = do + piece <- takeWhileP Nothing (\c -> c `notElem` ['{', '}', ' ', '\t', '\n']) + next <- optional (char '{' <|> char '}') + case next of + Just '{' -> braces ("{" : piece : acc) $! depth + 1 + Just '}' + | depth <= 1 -> return $ mconcat (reverse ("}" : piece : acc)) + | otherwise -> braces ("}" : piece : acc) $! depth - 1 + _ -> return $ mconcat (reverse (piece : acc)) + parseBaseImage :: (?esc :: Char) => (Text -> Parser (Maybe Tag)) -> Parser BaseImage parseBaseImage tagParser = do maybePlatform <- (Just <$> try parsePlatform) <|> return Nothing notFollowedBy (string "--") regName <- (Just <$> try parseRegistry) <|> return Nothing - name <- someUnless "the image name with a tag" (\c -> c == '@' || c == ':') + name <- someUnlessExpanded "the image name with a tag" (\c -> c == '@' || c == ':') maybeTag <- tagParser name <|> return Nothing maybeDigest <- (Just <$> try parseDigest) <|> return Nothing maybeAlias <- (Just <$> try (requiredWhitespace *> imageAlias)) <|> return Nothing @@ -38,7 +70,7 @@ taggedImage = parseBaseImage tagParser where tagParser _ = do void $ char ':' - t <- someUnless "the image tag" (\c -> c == '@' || c == ':') + t <- someUnlessExpanded "the image tag" (\c -> c == '@' || c == ':') return (Just . Tag $ t) parseDigest :: (?esc :: Char) => Parser Digest diff --git a/test/Language/Docker/ParserSpec.hs b/test/Language/Docker/ParserSpec.hs index 441d62b..7109f45 100644 --- a/test/Language/Docker/ParserSpec.hs +++ b/test/Language/Docker/ParserSpec.hs @@ -64,6 +64,29 @@ spec = do assertAst "FROM myfolder/imagename:5.12-dev" [From (taggedImage (Image Nothing "myfolder/imagename") "5.12-dev")] + describe "parse FROM with variable expansion" $ do + it "keeps ':' inside an expansion out of the tag" $ + assertAst + "FROM ${IMAGE_PREFIX:?}${DISTRO:?}:${VERSION_DISTRO:?}" + [From (taggedImage "${IMAGE_PREFIX:?}${DISTRO:?}" "${VERSION_DISTRO:?}")] + it "handles :- and :+ operators" $ + assertAst + "FROM ${BASE:-alpine}:${TAG:+edge}" + [From (taggedImage "${BASE:-alpine}" "${TAG:+edge}")] + it "handles a nested expansion" $ + assertAst "FROM ${BASE:-${DEFAULT}}" [From (untaggedImage "${BASE:-${DEFAULT}}")] + it "keeps expansion with a slash in the registry" $ + assertAst + "FROM ${REGISTRY:-docker.io/library}/myimage:tag" + [From (taggedImage (Image Nothing "${REGISTRY:-docker.io/library}/myimage") "tag")] + it "an unterminated ${ stays on its line" $ + assertAst + "FROM ${BASE:x\nRUN y" + [From (untaggedImage "${BASE:x"), Run "y"] + it "an unterminated ${ keeps a following alias" $ + assertAst + "FROM ${BASE AS build" + [From (untaggedImage "${BASE" `withAlias` "build")] describe "parse LABEL" $ do it "parse label" $ assertAst "LABEL foo=bar" [Label [("foo", "bar")]] it "parse space separated label" $ assertAst "LABEL foo bar baz" [Label [("foo", "bar baz")]]