diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -[![Build Status][travis-img]][travis] +[![Build Status][actions-img]][actions] [![Hackage][hackage-img]][hackage] [![GPL-3 licensed][license-img]][license] @@ -37,7 +37,7 @@ [hackage-img]: https://img.shields.io/hackage/v/language-docker.svg [hackage]: https://hackage.haskell.org/package/language-docker -[travis-img]: https://travis-ci.org/hadolint/language-docker.svg?branch=master -[travis]: https://travis-ci.org/hadolint/language-docker +[actions-img]: https://github.com/hadolint/language-docker/actions/workflows/haskell.yml/badge.svg +[actions]: https://github.com/hadolint/language-docker/actions/workflows/haskell.yml [license-img]: https://img.shields.io/badge/license-GPL--3-blue.svg [license]: https://tldrlegal.com/license/gnu-general-public-license-v3-(gpl-3) diff --git a/language-docker.cabal b/language-docker.cabal --- a/language-docker.cabal +++ b/language-docker.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: language-docker -version: 14.0.1 +version: 15.0.0 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. 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 @@ -28,9 +28,10 @@ | MountArgSharing CacheSharing | MountArgSource SourcePath | MountArgTarget TargetPath - | MountArgType Text + | MountArgType MountType | MountArgUid Text | MountArgGid Text + | MountArgRelabel Relabel deriving (Show) data MountType @@ -39,6 +40,7 @@ | Tmpfs | Secret | Ssh + deriving (Show) parseRun :: (?esc :: Char) => Parser (Instruction Text) parseRun = do @@ -83,46 +85,44 @@ runFlagMount :: (?esc :: Char) => Parser RunMount runFlagMount = do void $ string "--mount=" - maybeType <- - choice - [ string "type=" - *> choice - [ Just Bind <$ string "bind", - Just Cache <$ string "cache", - Just Tmpfs <$ string "tmpfs", - Just Secret <$ string "secret", - Just Ssh <$ string "ssh" - ], - pure Nothing - ] - (mountType, args) <- return $ - case maybeType of - Nothing -> (Bind, argsParser Bind) - Just Ssh -> (Ssh, choice [string "," *> argsParser Ssh, pure []]) - Just t -> (t, string "," *> argsParser t) - case mountType of - Bind -> BindMount <$> (bindMount =<< args) - Cache -> CacheMount <$> (cacheMount =<< args) - Tmpfs -> TmpfsMount <$> (tmpfsMount =<< args) - Secret -> SecretMount <$> (secretMount =<< args) - Ssh -> SshMount <$> (secretMount =<< args) + args <- mountArgs `sepBy1` string "," + mt <- parseTypeFromArgs args + case mt of + Bind -> BindMount <$> bindMount (filter (not . isMountArgType) args) + Cache -> CacheMount <$> cacheMount (filter (not . isMountArgType) args) + Tmpfs -> TmpfsMount <$> tmpfsMount (filter (not . isMountArgType) args) + Secret -> SecretMount <$> secretMount (filter (not . isMountArgType) args) + Ssh -> SshMount <$> secretMount (filter (not . isMountArgType) args) -argsParser :: (?esc :: Char) => MountType -> Parser [RunMountArg] -argsParser mountType = mountChoices mountType `sepBy1` string "," +parseTypeFromArgs :: [RunMountArg] -> Parser MountType +parseTypeFromArgs args = + -- `notFollowedBy eof` is a trivially succeeding parser that isn't supposed to + -- consume any input here. It's a hack that converts a simple type into a + -- parser. This allows this function to emit parse errors after analyzing its + -- input arguments and not consume any input. + case filter isMountArgType args of + [] -> Bind <$ notFollowedBy eof + [MountArgType t] -> t <$ notFollowedBy eof + _:_ -> fail "--mount with multiple `type` arguments" +isMountArgType :: RunMountArg -> Bool +isMountArgType (MountArgType _) = True +isMountArgType _ = False + bindMount :: [RunMountArg] -> Parser BindOpts bindMount args = case validArgs "bind" allowed required args of Left e -> customError e Right as -> return $ foldr bindOpts def as where - allowed = Set.fromList ["target", "source", "from", "ro"] + allowed = Set.fromList ["target", "source", "from", "ro", "relabel"] required = Set.singleton "target" bindOpts :: RunMountArg -> BindOpts -> BindOpts bindOpts (MountArgTarget path) bo = bo {bTarget = path} bindOpts (MountArgSource path) bo = bo {bSource = Just path} bindOpts (MountArgFromImage img) bo = bo {bFromImage = Just img} bindOpts (MountArgReadOnly ro) bo = bo {bReadOnly = Just ro} + bindOpts (MountArgRelabel re) bo = bo {bRelabel = Just re} bindOpts invalid _ = error $ "unhandled " <> show invalid <> " please report this bug" cacheMount :: [RunMountArg] -> Parser CacheOpts @@ -188,6 +188,7 @@ [] -> result missing -> Left $ MissingArgument missing where + checkValidArg :: RunMountArg -> (Either DockerfileError [RunMountArg], Set.Set Text) -> (Either DockerfileError [RunMountArg], Set.Set Text) checkValidArg _ x@(Left _, _) = x checkValidArg a (Right as, seen) = let name = toArgName a @@ -196,38 +197,23 @@ (_, True) -> (Left (DuplicateArgument name), seen) (True, False) -> (Right (a : as), Set.insert name seen) -mountChoices :: (?esc :: Char) => MountType -> Parser RunMountArg -mountChoices mountType = - choice $ - case mountType of - Bind -> - [ mountArgTarget, - mountArgSource, - mountArgFromImage, - mountArgReadOnly - ] - Cache -> - [ mountArgTarget, - mountArgSource, - mountArgFromImage, - mountArgReadOnly, - mountArgId, - mountArgSharing, - mountArgMode, - mountArgUid, - mountArgGid - ] - Tmpfs -> [mountArgTarget] - _ -> -- Secret and Ssh - [ mountArgTarget, - mountArgId, - mountArgRequired, - mountArgSource, - mountArgMode, - mountArgUid, - mountArgGid, - mountArgEnv - ] +mountArgs :: (?esc :: Char) => Parser RunMountArg +mountArgs = + choice + [ mountArgEnv, + mountArgFromImage, + mountArgGid, + mountArgId, + mountArgMode, + mountArgReadOnly, + mountArgRelabel, + mountArgRequired, + mountArgSharing, + mountArgSource, + mountArgTarget, + mountArgType, + mountArgUid + ] stringArg :: (?esc :: Char) => Parser Text stringArg = choice [doubleQuotedString, someUnless "a string" (== ',')] @@ -319,9 +305,28 @@ label "target=" $ choice [string "target=", string "dst=", string "destination="] MountArgTarget . TargetPath <$> stringArg +mountArgType :: Parser RunMountArg +mountArgType = MountArgType <$> key "type" mountType + +mountType :: Parser MountType +mountType = + choice + [ Bind <$ string "bind", + Cache <$ string "cache", + Tmpfs <$ string "tmpfs", + Secret <$ string "secret", + Ssh <$ string "ssh" + ] + mountArgUid :: (?esc :: Char) => Parser RunMountArg mountArgUid = MountArgUid <$> key "uid" stringArg +mountArgRelabel :: Parser RunMountArg +mountArgRelabel = MountArgRelabel <$> key "relabel" relabel + +relabel :: Parser Relabel +relabel = choice [RelabelShared <$ string "shared", RelabelPrivate <$ string "private"] + toArgName :: RunMountArg -> Text toArgName (MountArgEnv _) = "env" toArgName (MountArgFromImage _) = "from" @@ -335,3 +340,4 @@ toArgName (MountArgTarget _) = "target" toArgName (MountArgType _) = "type" toArgName (MountArgUid _) = "uid" +toArgName (MountArgRelabel _) = "relabel" diff --git a/src/Language/Docker/PrettyPrint.hs b/src/Language/Docker/PrettyPrint.hs --- a/src/Language/Docker/PrettyPrint.hs +++ b/src/Language/Docker/PrettyPrint.hs @@ -188,6 +188,7 @@ <> maybe mempty printSource bSource <> maybe mempty printFromImage bFromImage <> maybe mempty printReadOnly bReadOnly + <> maybe mempty printRelabel bRelabel CacheMount CacheOpts {..} -> "type=cache" <> printTarget cTarget @@ -237,6 +238,10 @@ printReadOnly False = ",rw" printRequired True = ",required" printRequired False = mempty + printRelabel r = ",relabel=" + <> case r of + RelabelShared -> printQuotable "shared" + RelabelPrivate -> printQuotable "private" prettyPrintRunNetwork :: Maybe RunNetwork -> Doc ann prettyPrintRunNetwork Nothing = mempty diff --git a/src/Language/Docker/Syntax.hs b/src/Language/Docker/Syntax.hs --- a/src/Language/Docker/Syntax.hs +++ b/src/Language/Docker/Syntax.hs @@ -119,6 +119,11 @@ } deriving (Show, Eq, Ord, IsString) +data Relabel + = RelabelShared + | RelabelPrivate + deriving (Show, Eq, Ord) + data Checksum = Checksum !Text | NoChecksum @@ -271,12 +276,13 @@ { bTarget :: !TargetPath, bSource :: !(Maybe SourcePath), bFromImage :: !(Maybe Text), - bReadOnly :: !(Maybe Bool) + bReadOnly :: !(Maybe Bool), + bRelabel :: !(Maybe Relabel) } deriving (Show, Eq, Ord) instance Default BindOpts where - def = BindOpts "" Nothing Nothing Nothing + def = BindOpts "" Nothing Nothing Nothing Nothing data CacheOpts = CacheOpts diff --git a/test/Language/Docker/ParseExposeSpec.hs b/test/Language/Docker/ParseExposeSpec.hs --- a/test/Language/Docker/ParseExposeSpec.hs +++ b/test/Language/Docker/ParseExposeSpec.hs @@ -1,7 +1,5 @@ module Language.Docker.ParseExposeSpec where -import Data.Default.Class (def) -import qualified Data.Text as Text import Language.Docker.Syntax import TestHelper import Test.Hspec diff --git a/test/Language/Docker/ParseHealthcheckSpec.hs b/test/Language/Docker/ParseHealthcheckSpec.hs --- a/test/Language/Docker/ParseHealthcheckSpec.hs +++ b/test/Language/Docker/ParseHealthcheckSpec.hs @@ -1,10 +1,8 @@ module Language.Docker.ParseHealthcheckSpec where -import Data.Default.Class (def) import Language.Docker.Syntax import Test.Hspec import TestHelper -import qualified Data.Set as Set import qualified Data.Text as Text diff --git a/test/Language/Docker/ParseRunSpec.hs b/test/Language/Docker/ParseRunSpec.hs --- a/test/Language/Docker/ParseRunSpec.hs +++ b/test/Language/Docker/ParseRunSpec.hs @@ -50,8 +50,8 @@ [ Run $ RunArgs (ArgumentsText "echo foo") flags ] it "--mount=type=bind all modifiers" $ - let file = Text.unlines ["RUN --mount=type=bind,target=/foo,source=/bar,from=ubuntu,ro echo foo"] - flags = def {mount = Set.singleton $ BindMount (BindOpts {bTarget = "/foo", bSource = Just "/bar", bFromImage = Just "ubuntu", bReadOnly = Just True})} + let file = Text.unlines ["RUN --mount=type=bind,target=/foo,source=/bar,from=ubuntu,ro,relabel=shared echo foo"] + flags = def {mount = Set.singleton $ BindMount (BindOpts {bTarget = "/foo", bSource = Just "/bar", bFromImage = Just "ubuntu", bReadOnly = Just True, bRelabel = Just RelabelShared})} in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags @@ -72,6 +72,41 @@ Run $ RunArgs (ArgumentsText "echo foo") flags2, Run $ RunArgs (ArgumentsText "echo foo") flags3 ] + + it "--mount=type=cache with id from variable/arg" $ + let file = + Text.unlines + [ "ARG debian_version=12", + "FROM debian:bookworm-slim", + "RUN --mount=id=debian:${debian_version},type=cache,target=/foo foo bar" + ] + flags = def {mount = Set.singleton $ CacheMount (def {cTarget = "/foo", cCacheId = Just "debian:${debian_version}"})} + in assertAst + file + [ Arg "debian_version" (Just "12"), + From $ BaseImage + { image = Image + { registryName = Nothing, + imageName="debian" + }, + tag = Just Tag { unTag="bookworm-slim" }, + digest = Nothing, + alias = Nothing, + platform = Nothing + }, + Run $ RunArgs (ArgumentsText "foo bar") flags + ] + + it "--mount=type=cache,dst=/foo" $ + let file = Text.unlines [ "RUN --mount=type=cache,dst=/foo echo foo" ] + flags = def {mount = Set.singleton $ CacheMount (def {cTarget = "/foo"})} + in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] + + it "--mount=dst=/foo,type=cache" $ + let file = Text.unlines [ "RUN --mount=dst=/foo,type=cache echo foo" ] + flags = def {mount = Set.singleton $ CacheMount (def {cTarget = "/foo"})} + in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] + it "--mount=type=cache with all modifiers" $ let file = Text.unlines @@ -99,6 +134,33 @@ file [ Run $ RunArgs (ArgumentsText "echo foo") flags ] + it "--mount=type=cache with all modifiers, different order" $ + let file = + Text.unlines + [ "RUN --mount=readonly,sharing=private,id=a,type=cache,from=ubuntu,source=/bar,destination=/foo,mode=0700,uid=0,gid=0 echo foo" + ] + flags = + def + { mount = + Set.singleton $ + CacheMount + ( def + { cTarget = "/foo", + cSharing = Just Private, + cCacheId = Just "a", + cReadOnly = Just True, + cFromImage = Just "ubuntu", + cSource = Just "/bar", + cMode = Just "0700", + cUid = Just "0", + cGid = Just "0" + } + ) + } + in assertAst + file + [ Run $ RunArgs (ArgumentsText "echo foo") flags + ] it "--mount=type=tmpfs" $ let file = Text.unlines ["RUN --mount=type=tmpfs,target=/foo echo foo"] flags = def {mount = Set.singleton $ TmpfsMount (def {tTarget = "/foo"})} @@ -639,3 +701,36 @@ file [ Run $ RunArgs ( ArgumentsText "ls && cat" ) flags ] + + describe "Parse RUN instructions - invalid cases" $ do + it "fail because of multiple types in --mount" $ + let line = "RUN --mount=type=cache,type=tmpfs,target=/foo foo bar" + in expectFail line + + describe "Parse RUN instructions - SELinux relabeling" $ do + let flagsRelabelShared = + def { mount = Set.singleton $ + BindMount + ( def + { bTarget = "/bar", + bRelabel = Just RelabelShared + } + ) + } + flagsRelabelPrivate = + def { mount = Set.singleton $ + BindMount + ( def + { bTarget = "/bar", + bRelabel = Just RelabelPrivate + } + ) + } + it "RUN with --relabel=shared" $ + let file = Text.unlines + ["RUN --mount=type=bind,target=/bar,relabel=shared echo foo"] + in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelShared ] + it "RUN with --relabel=private" $ + let file = Text.unlines + ["RUN --mount=type=bind,target=/bar,relabel=private echo foo"] + in assertAst file [ Run $ RunArgs (ArgumentsText "echo foo") flagsRelabelPrivate ]