{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Hadolint.Rules where

import Control.Arrow ((&&&))
import Data.List (foldl', isInfixOf, isPrefixOf, mapAccumL, nub)
import Data.List.NonEmpty (toList)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Void (Void)
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax
import ShellCheck.Interface (Severity (..))
import qualified ShellCheck.Interface
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as Megaparsec

data Metadata = Metadata
  { Metadata -> Text
code :: Text.Text,
    Metadata -> Severity
severity :: Severity,
    Metadata -> Text
message :: Text.Text
  }
  deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show)

-- a check is the application of a rule on a specific part of code
-- the enforced result and the affected position
-- position only records the linenumber at the moment to keep it easy
-- and simple to develop new rules
-- line numbers in the negative range are meant for the global context
data RuleCheck = RuleCheck
  { RuleCheck -> Metadata
metadata :: Metadata,
    RuleCheck -> Text
filename :: Filename,
    RuleCheck -> Int
linenumber :: Linenumber,
    RuleCheck -> Bool
success :: Bool
  }
  deriving (RuleCheck -> RuleCheck -> Bool
(RuleCheck -> RuleCheck -> Bool)
-> (RuleCheck -> RuleCheck -> Bool) -> Eq RuleCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleCheck -> RuleCheck -> Bool
$c/= :: RuleCheck -> RuleCheck -> Bool
== :: RuleCheck -> RuleCheck -> Bool
$c== :: RuleCheck -> RuleCheck -> Bool
Eq, Int -> RuleCheck -> ShowS
[RuleCheck] -> ShowS
RuleCheck -> String
(Int -> RuleCheck -> ShowS)
-> (RuleCheck -> String)
-> ([RuleCheck] -> ShowS)
-> Show RuleCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleCheck] -> ShowS
$cshowList :: [RuleCheck] -> ShowS
show :: RuleCheck -> String
$cshow :: RuleCheck -> String
showsPrec :: Int -> RuleCheck -> ShowS
$cshowsPrec :: Int -> RuleCheck -> ShowS
Show)

-- | Contains the required parameters for optional rules
newtype RulesConfig = RulesConfig
  { -- | The docker registries that are allowed in FROM
    RulesConfig -> Set Registry
allowedRegistries :: Set.Set Registry
  }
  deriving (Int -> RulesConfig -> ShowS
[RulesConfig] -> ShowS
RulesConfig -> String
(Int -> RulesConfig -> ShowS)
-> (RulesConfig -> String)
-> ([RulesConfig] -> ShowS)
-> Show RulesConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RulesConfig] -> ShowS
$cshowList :: [RulesConfig] -> ShowS
show :: RulesConfig -> String
$cshow :: RulesConfig -> String
showsPrec :: Int -> RulesConfig -> ShowS
$cshowsPrec :: Int -> RulesConfig -> ShowS
Show, RulesConfig -> RulesConfig -> Bool
(RulesConfig -> RulesConfig -> Bool)
-> (RulesConfig -> RulesConfig -> Bool) -> Eq RulesConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RulesConfig -> RulesConfig -> Bool
$c/= :: RulesConfig -> RulesConfig -> Bool
== :: RulesConfig -> RulesConfig -> Bool
$c== :: RulesConfig -> RulesConfig -> Bool
Eq)

instance Ord RuleCheck where
  RuleCheck
a compare :: RuleCheck -> RuleCheck -> Ordering
`compare` RuleCheck
b = RuleCheck -> Int
linenumber RuleCheck
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` RuleCheck -> Int
linenumber RuleCheck
b

instance Semigroup RulesConfig where
  RulesConfig Set Registry
a <> :: RulesConfig -> RulesConfig -> RulesConfig
<> RulesConfig Set Registry
b = Set Registry -> RulesConfig
RulesConfig (Set Registry
a Set Registry -> Set Registry -> Set Registry
forall a. Semigroup a => a -> a -> a
<> Set Registry
b)

instance Monoid RulesConfig where
  mempty :: RulesConfig
mempty = Set Registry -> RulesConfig
RulesConfig Set Registry
forall a. Monoid a => a
mempty
  mappend :: RulesConfig -> RulesConfig -> RulesConfig
mappend = RulesConfig -> RulesConfig -> RulesConfig
forall a. Semigroup a => a -> a -> a
(<>)

type IgnoreRuleParser = Megaparsec.Parsec Void Text.Text

type ParsedFile = [InstructionPos Shell.ParsedShell]

-- | A function to check individual dockerfile instructions.
-- It gets the current state and a line number.
-- It should return the new state and whether or not the check passes for the given instruction.
type SimpleCheckerWithState state =
  state -> Linenumber -> Instruction Shell.ParsedShell -> (state, Bool)

-- | A function to check individual dockerfile instructions.
-- It gets the current line number.
-- It should return True if the check passes for the given instruction.
type SimpleCheckerWithLine = (Linenumber -> Instruction Shell.ParsedShell -> Bool)

-- | A function to check individual dockerfile instructions.
-- It should return the new state and a list of Metadata records.
-- Each Metadata record signifies a failing check for the given instruction.
type CheckerWithState state =
  state -> Linenumber -> Instruction Shell.ParsedShell -> (state, [Metadata])

link :: Metadata -> Text.Text
link :: Metadata -> Text
link (Metadata Text
code Severity
_ Text
_)
  | Text
"SC" Text -> Text -> Bool
`Text.isPrefixOf` Text
code = Text
"https://github.com/koalaman/shellcheck/wiki/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code
  | Text
"DL" Text -> Text -> Bool
`Text.isPrefixOf` Text
code = Text
"https://github.com/hadolint/hadolint/wiki/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code
  | Bool
otherwise = Text
"https://github.com/hadolint/hadolint"

-- a Rule takes a Dockerfile with parsed shell and returns the executed checks
type Rule = ParsedFile -> [RuleCheck]

-- Apply a function on each instruction and create a check
-- for the according line number
mapInstructions :: CheckerWithState state -> state -> Rule
mapInstructions :: CheckerWithState state -> state -> Rule
mapInstructions CheckerWithState state
f state
initialState ParsedFile
dockerfile =
  let (state
_, [[RuleCheck]]
results) = (state -> InstructionPos ParsedShell -> (state, [RuleCheck]))
-> state -> ParsedFile -> (state, [[RuleCheck]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL state -> InstructionPos ParsedShell -> (state, [RuleCheck])
applyRule state
initialState ParsedFile
dockerfile
   in [[RuleCheck]] -> [RuleCheck]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[RuleCheck]]
results
  where
    applyRule :: state -> InstructionPos ParsedShell -> (state, [RuleCheck])
applyRule state
state (InstructionPos onbuild :: Instruction ParsedShell
onbuild@(OnBuild Instruction ParsedShell
i) Text
source Int
linenumber) =
      -- All rules applying to instructions also apply to ONBUILD,
      -- so we unwrap the OnBuild constructor and check directly the inner
      -- instruction. Then we also check the instruction itself and append the
      -- result to avoid losing out on detecting problems with `ONBUILD`
      let (state
innerState, [RuleCheck]
innerResults) = state
-> Text -> Int -> Instruction ParsedShell -> (state, [RuleCheck])
applyWithState state
state Text
source Int
linenumber Instruction ParsedShell
i
          (state
finalState, [RuleCheck]
outerResults) = state
-> Text -> Int -> Instruction ParsedShell -> (state, [RuleCheck])
applyWithState state
innerState Text
source Int
linenumber Instruction ParsedShell
onbuild
       in (state
finalState, [RuleCheck]
innerResults [RuleCheck] -> [RuleCheck] -> [RuleCheck]
forall a. Semigroup a => a -> a -> a
<> [RuleCheck]
outerResults)
    applyRule state
state (InstructionPos Instruction ParsedShell
i Text
source Int
linenumber) =
      state
-> Text -> Int -> Instruction ParsedShell -> (state, [RuleCheck])
applyWithState state
state Text
source Int
linenumber Instruction ParsedShell
i -- Otherwise, normal instructions are not unwrapped
    applyWithState :: state
-> Text -> Int -> Instruction ParsedShell -> (state, [RuleCheck])
applyWithState state
state Text
source Int
linenumber Instruction ParsedShell
instruction =
      let (state
newState, [Metadata]
res) = CheckerWithState state
f state
state Int
linenumber Instruction ParsedShell
instruction
       in (state
newState, [Metadata -> Text -> Int -> Bool -> RuleCheck
RuleCheck Metadata
m Text
source Int
linenumber Bool
False | Metadata
m <- [Metadata]
res])

instructionRule ::
  Text.Text -> Severity -> Text.Text -> (Instruction Shell.ParsedShell -> Bool) -> Rule
instructionRule :: Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check =
  Text -> Severity -> Text -> SimpleCheckerWithLine -> Rule
instructionRuleLine Text
code Severity
severity Text
message ((Instruction ParsedShell -> Bool) -> SimpleCheckerWithLine
forall a b. a -> b -> a
const Instruction ParsedShell -> Bool
check)

instructionRuleLine :: Text.Text -> Severity -> Text.Text -> SimpleCheckerWithLine -> Rule
instructionRuleLine :: Text -> Severity -> Text -> SimpleCheckerWithLine -> Rule
instructionRuleLine Text
code Severity
severity Text
message SimpleCheckerWithLine
check =
  Text -> Severity -> Text -> SimpleCheckerWithState () -> () -> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState ()
forall a. a -> Int -> Instruction ParsedShell -> (a, Bool)
checkAndDropState ()
  where
    checkAndDropState :: a -> Int -> Instruction ParsedShell -> (a, Bool)
checkAndDropState a
state Int
line Instruction ParsedShell
instr = (a
state, SimpleCheckerWithLine
check Int
line Instruction ParsedShell
instr)

instructionRuleState ::
  Text.Text -> Severity -> Text.Text -> SimpleCheckerWithState state -> state -> Rule
instructionRuleState :: Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState state
f = CheckerWithState state -> state -> Rule
forall state. CheckerWithState state -> state -> Rule
mapInstructions CheckerWithState state
constMetadataCheck
  where
    meta :: Metadata
meta = Text -> Severity -> Text -> Metadata
Metadata Text
code Severity
severity Text
message
    constMetadataCheck :: CheckerWithState state
constMetadataCheck state
st Int
ln Instruction ParsedShell
instr =
      let (state
newSt, Bool
success) = SimpleCheckerWithState state
f state
st Int
ln Instruction ParsedShell
instr
       in if Bool -> Bool
not Bool
success
            then (state
newSt, [Metadata
meta])
            else (state
newSt, [])

withState :: a -> b -> (a, b)
withState :: a -> b -> (a, b)
withState a
st b
res = (a
st, b
res)

argumentsRule :: (Shell.ParsedShell -> a) -> Arguments Shell.ParsedShell -> a
argumentsRule :: (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ParsedShell -> a
applyRule Arguments ParsedShell
args =
  case Arguments ParsedShell
args of
    ArgumentsText ParsedShell
as -> ParsedShell -> a
applyRule ParsedShell
as
    ArgumentsList ParsedShell
as -> ParsedShell -> a
applyRule ParsedShell
as

-- Enforce rules on a dockerfile and return failed checks
analyze :: [Rule] -> Dockerfile -> [RuleCheck]
analyze :: [Rule] -> Dockerfile -> [RuleCheck]
analyze [Rule]
list Dockerfile
dockerfile =
  [ RuleCheck
result -- Keep the result
    | Rule
rule <- [Rule]
list, -- for each rule in the list
      RuleCheck
result <- Rule
rule ParsedFile
parsedFile, -- after applying the rule to the file
      RuleCheck -> Bool
notIgnored RuleCheck
result -- and only keep failures that were not ignored
  ]
  where
    notIgnored :: RuleCheck -> Bool
notIgnored RuleCheck {metadata :: RuleCheck -> Metadata
metadata = Metadata {Text
code :: Text
code :: Metadata -> Text
code}, Int
linenumber :: Int
linenumber :: RuleCheck -> Int
linenumber} = Bool -> Bool
not (Text -> Int -> Bool
wasIgnored Text
code Int
linenumber)
    wasIgnored :: Text -> Int -> Bool
wasIgnored Text
c Int
ln = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int
line | (Int
line, [Text]
codes) <- [(Int, [Text])]
allIgnores, Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ln, Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
codes]
    allIgnores :: [(Int, [Text])]
allIgnores = Dockerfile -> [(Int, [Text])]
ignored Dockerfile
dockerfile
    parsedFile :: ParsedFile
parsedFile = (InstructionPos Text -> InstructionPos ParsedShell)
-> Dockerfile -> ParsedFile
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ParsedShell)
-> InstructionPos Text -> InstructionPos ParsedShell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ParsedShell
Shell.parseShell) Dockerfile
dockerfile

ignored :: Dockerfile -> [(Linenumber, [Text.Text])]
ignored :: Dockerfile -> [(Int, [Text])]
ignored Dockerfile
dockerfile =
  [(Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Text]
ignores) | (Int
l, Just [Text]
ignores) <- (InstructionPos Text -> (Int, Maybe [Text]))
-> Dockerfile -> [(Int, Maybe [Text])]
forall a b. (a -> b) -> [a] -> [b]
map (InstructionPos Text -> Int
forall args. InstructionPos args -> Int
lineNumber (InstructionPos Text -> Int)
-> (InstructionPos Text -> Maybe [Text])
-> InstructionPos Text
-> (Int, Maybe [Text])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstructionPos Text -> Maybe [Text]
forall args. InstructionPos args -> Maybe [Text]
extractIgnored) Dockerfile
dockerfile]
  where
    extractIgnored :: InstructionPos args -> Maybe [Text]
extractIgnored = Instruction args -> Maybe [Text]
forall args. Instruction args -> Maybe [Text]
ignoreFromInstruction (Instruction args -> Maybe [Text])
-> (InstructionPos args -> Instruction args)
-> InstructionPos args
-> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstructionPos args -> Instruction args
forall args. InstructionPos args -> Instruction args
instruction
    ignoreFromInstruction :: Instruction args -> Maybe [Text]
ignoreFromInstruction (Comment Text
comment) = Text -> Maybe [Text]
parseComment Text
comment
    ignoreFromInstruction Instruction args
_ = Maybe [Text]
forall a. Maybe a
Nothing
    parseComment :: Text.Text -> Maybe [Text.Text]
    parseComment :: Text -> Maybe [Text]
parseComment = Parsec Void Text [Text] -> Text -> Maybe [Text]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text [Text]
commentParser
    commentParser :: IgnoreRuleParser [Text.Text]
    commentParser :: Parsec Void Text [Text]
commentParser =
      ParsecT Void Text Identity (Tokens Text)
spaces
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"hadolint" -- The parser for the ignored rules
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
spaces1
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"ignore="
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
spaces
        ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text [Text] -> Parsec Void Text [Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Megaparsec.sepBy1 ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
ruleName (ParsecT Void Text Identity (Tokens Text)
spaces ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"," ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
spaces)
    string :: Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string
    spaces :: ParsecT Void Text Identity (Tokens Text)
spaces = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
space
    spaces1 :: ParsecT Void Text Identity (Tokens Text)
spaces1 = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
space
    space :: Char -> Bool
space Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
    ruleName :: ParsecT Void Text Identity (Tokens Text)
ruleName = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"DLSC0123456789" :: String))

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
absoluteWorkdir,
    Rule
shellcheck,
    Rule
invalidCmd,
    Rule
copyInsteadAdd,
    Rule
copyEndingSlash,
    Rule
copyFromExists,
    Rule
copyFromAnother,
    Rule
fromAliasUnique,
    Rule
noRootUser,
    Rule
noCd,
    Rule
noSudo,
    Rule
noAptGetUpgrade,
    Rule
noApkUpgrade,
    Rule
noLatestTag,
    Rule
noUntagged,
    Rule
noPlatformFlag,
    Rule
aptGetVersionPinned,
    Rule
aptGetCleanup,
    Rule
apkAddVersionPinned,
    Rule
apkAddNoCache,
    Rule
useAdd,
    Rule
pipVersionPinned,
    Rule
npmVersionPinned,
    Rule
invalidPort,
    Rule
aptGetNoRecommends,
    Rule
aptGetYes,
    Rule
wgetOrCurl,
    Rule
hasNoMaintainer,
    Rule
multipleCmds,
    Rule
multipleEntrypoints,
    Rule
useShell,
    Rule
useJsonArgs,
    Rule
usePipefail,
    Rule
noApt,
    Rule
gemVersionPinned,
    Rule
yumYes,
    Rule
noYumUpdate,
    Rule
yumCleanup,
    Rule
yumVersionPinned,
    Rule
zypperYes,
    Rule
noZypperUpdate,
    Rule
zypperCleanup,
    Rule
zypperVersionPinned,
    Rule
dnfYes,
    Rule
noDnfUpdate,
    Rule
dnfCleanup,
    Rule
dnfVersionPinned,
    Rule
pipNoCacheDir,
    Rule
noIllegalInstructionInOnbuild
  ]

optionalRules :: RulesConfig -> [Rule]
optionalRules :: RulesConfig -> [Rule]
optionalRules RulesConfig {Set Registry
allowedRegistries :: Set Registry
allowedRegistries :: RulesConfig -> Set Registry
allowedRegistries} = [Set Registry -> Rule
registryIsAllowed Set Registry
allowedRegistries]

allFromImages :: ParsedFile -> [(Linenumber, BaseImage)]
allFromImages :: ParsedFile -> [(Int, BaseImage)]
allFromImages ParsedFile
dockerfile = [(Int
l, BaseImage
f) | (Int
l, From BaseImage
f) <- [(Int, Instruction ParsedShell)]
instr]
  where
    instr :: [(Int, Instruction ParsedShell)]
instr = (InstructionPos ParsedShell -> (Int, Instruction ParsedShell))
-> ParsedFile -> [(Int, Instruction ParsedShell)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InstructionPos ParsedShell -> Int
forall args. InstructionPos args -> Int
lineNumber (InstructionPos ParsedShell -> Int)
-> (InstructionPos ParsedShell -> Instruction ParsedShell)
-> InstructionPos ParsedShell
-> (Int, Instruction ParsedShell)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstructionPos ParsedShell -> Instruction ParsedShell
forall args. InstructionPos args -> Instruction args
instruction) ParsedFile
dockerfile

allAliasedImages :: ParsedFile -> [(Linenumber, ImageAlias)]
allAliasedImages :: ParsedFile -> [(Int, ImageAlias)]
allAliasedImages ParsedFile
dockerfile =
  [(Int
l, ImageAlias
alias) | (Int
l, Just ImageAlias
alias) <- ((Int, BaseImage) -> (Int, Maybe ImageAlias))
-> [(Int, BaseImage)] -> [(Int, Maybe ImageAlias)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, BaseImage) -> (Int, Maybe ImageAlias)
forall a. (a, BaseImage) -> (a, Maybe ImageAlias)
extractAlias (ParsedFile -> [(Int, BaseImage)]
allFromImages ParsedFile
dockerfile)]
  where
    extractAlias :: (a, BaseImage) -> (a, Maybe ImageAlias)
extractAlias (a
l, BaseImage
f) = (a
l, BaseImage -> Maybe ImageAlias
fromAlias BaseImage
f)

allImageNames :: ParsedFile -> [(Linenumber, Text.Text)]
allImageNames :: ParsedFile -> [(Int, Text)]
allImageNames ParsedFile
dockerfile = [(Int
l, BaseImage -> Text
fromName BaseImage
baseImage) | (Int
l, BaseImage
baseImage) <- ParsedFile -> [(Int, BaseImage)]
allFromImages ParsedFile
dockerfile]

-- | Returns a list of all image aliases in FROM instructions that
--  are defined before the given line number.
previouslyDefinedAliases :: Linenumber -> ParsedFile -> [Text.Text]
previouslyDefinedAliases :: Int -> ParsedFile -> [Text]
previouslyDefinedAliases Int
line ParsedFile
dockerfile =
  [Text
i | (Int
l, ImageAlias Text
i) <- ParsedFile -> [(Int, ImageAlias)]
allAliasedImages ParsedFile
dockerfile, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
line]

-- | Returns the result of running the check function on the image alias
--   name, if the passed instruction is a FROM instruction with a stage alias.
--   Otherwise, returns True.
aliasMustBe :: (Text.Text -> Bool) -> Instruction a -> Bool
aliasMustBe :: (Text -> Bool) -> Instruction a -> Bool
aliasMustBe Text -> Bool
predicate Instruction a
fromInstr =
  case Instruction a
fromInstr of
    From BaseImage {$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias = Just (ImageAlias Text
as)} -> Text -> Bool
predicate Text
as
    Instruction a
_ -> Bool
True

fromName :: BaseImage -> Text.Text
fromName :: BaseImage -> Text
fromName BaseImage {$sel:image:BaseImage :: BaseImage -> Image
image = Image {Text
$sel:imageName:Image :: Image -> Text
imageName :: Text
imageName}} = Text
imageName

fromAlias :: BaseImage -> Maybe ImageAlias
fromAlias :: BaseImage -> Maybe ImageAlias
fromAlias BaseImage {Maybe ImageAlias
alias :: Maybe ImageAlias
$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias} = Maybe ImageAlias
alias

-------------
--  RULES  --
-------------
shellcheck :: Rule
shellcheck :: Rule
shellcheck = CheckerWithState ShellOpts -> ShellOpts -> Rule
forall state. CheckerWithState state -> state -> Rule
mapInstructions CheckerWithState ShellOpts
check ShellOpts
Shell.defaultShellOpts
  where
    check :: CheckerWithState Shell.ShellOpts
    check :: CheckerWithState ShellOpts
check ShellOpts
_ Int
_ (From BaseImage
_) = (ShellOpts
Shell.defaultShellOpts, []) -- Reset the state
    check ShellOpts
st Int
_ (Arg Text
name Maybe Text
_) = ([Text] -> ShellOpts -> ShellOpts
Shell.addVars [Text
name] ShellOpts
st, [])
    check ShellOpts
st Int
_ (Env Pairs
pairs) = ([Text] -> ShellOpts -> ShellOpts
Shell.addVars (((Text, Text) -> Text) -> Pairs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst Pairs
pairs) ShellOpts
st, [])
    check ShellOpts
st Int
_ (Shell (ArgumentsList ParsedShell
script)) = (Text -> ShellOpts -> ShellOpts
Shell.setShell (ParsedShell -> Text
Shell.original ParsedShell
script) ShellOpts
st, [])
    check ShellOpts
st Int
_ (Shell (ArgumentsText ParsedShell
script)) = (Text -> ShellOpts -> ShellOpts
Shell.setShell (ParsedShell -> Text
Shell.original ParsedShell
script) ShellOpts
st, [])
    check ShellOpts
st Int
_ (Run (RunArgs (ArgumentsList ParsedShell
script) RunFlags
_)) = (ShellOpts
st, ShellOpts -> ParsedShell -> [Metadata]
doCheck ShellOpts
st ParsedShell
script)
    check ShellOpts
st Int
_ (Run (RunArgs (ArgumentsText ParsedShell
script) RunFlags
_)) = (ShellOpts
st, ShellOpts -> ParsedShell -> [Metadata]
doCheck ShellOpts
st ParsedShell
script)
    check ShellOpts
st Int
_ Instruction ParsedShell
_ = (ShellOpts
st, [])
    doCheck :: ShellOpts -> ParsedShell -> [Metadata]
doCheck ShellOpts
opts ParsedShell
script = [Metadata] -> [Metadata]
forall a. Eq a => [a] -> [a]
nub [PositionedComment -> Metadata
commentMetadata PositionedComment
c | PositionedComment
c <- ShellOpts -> ParsedShell -> [PositionedComment]
Shell.shellcheck ShellOpts
opts ParsedShell
script]

-- | Converts ShellCheck errors into our own errors type
commentMetadata :: ShellCheck.Interface.PositionedComment -> Metadata
commentMetadata :: PositionedComment -> Metadata
commentMetadata PositionedComment
c =
  Text -> Severity -> Text -> Metadata
Metadata (String -> Text
Text.pack (String
"SC" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Code -> String
forall a. Show a => a -> String
show (PositionedComment -> Code
code PositionedComment
c))) (PositionedComment -> Severity
severity PositionedComment
c) (String -> Text
Text.pack (PositionedComment -> String
message PositionedComment
c))
  where
    severity :: PositionedComment -> Severity
severity PositionedComment
pc = Comment -> Severity
ShellCheck.Interface.cSeverity (Comment -> Severity) -> Comment -> Severity
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
ShellCheck.Interface.pcComment PositionedComment
pc
    code :: PositionedComment -> Code
code PositionedComment
pc = Comment -> Code
ShellCheck.Interface.cCode (Comment -> Code) -> Comment -> Code
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
ShellCheck.Interface.pcComment PositionedComment
pc
    message :: PositionedComment -> String
message PositionedComment
pc = Comment -> String
ShellCheck.Interface.cMessage (Comment -> String) -> Comment -> String
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
ShellCheck.Interface.pcComment PositionedComment
pc

absoluteWorkdir :: Rule
absoluteWorkdir :: Rule
absoluteWorkdir = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3000"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Use absolute WORKDIR"
    check :: Instruction args -> Bool
check (Workdir Text
loc)
      | Text
"$" Text -> Text -> Bool
`Text.isPrefixOf` (Char -> Bool) -> Text -> Text
Text.dropAround Char -> Bool
dropQuotes Text
loc = Bool
True
      | Text
"/" Text -> Text -> Bool
`Text.isPrefixOf` (Char -> Bool) -> Text -> Text
Text.dropAround Char -> Bool
dropQuotes Text
loc = Bool
True
      | Bool
otherwise = Bool
False
    check Instruction args
_ = Bool
True
    dropQuotes :: Char -> Bool
dropQuotes Char
chr
      | Char
chr Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"' = Bool
True
      | Char
chr Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = Bool
True
      | Bool
otherwise = Bool
False

hasNoMaintainer :: Rule
hasNoMaintainer :: Rule
hasNoMaintainer = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL4000"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"MAINTAINER is deprecated"
    check :: Instruction args -> Bool
check (Maintainer Text
_) = Bool
False
    check Instruction args
_ = Bool
True

-- Check if a command contains a program call in the Run instruction
usingProgram :: Text.Text -> Shell.ParsedShell -> Bool
usingProgram :: Text -> ParsedShell -> Bool
usingProgram Text
prog ParsedShell
args = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
cmd | Text
cmd <- ParsedShell -> [Text]
Shell.findCommandNames ParsedShell
args, Text
cmd Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
prog]

multipleCmds :: Rule
multipleCmds :: Rule
multipleCmds = Text
-> Severity -> Text -> SimpleCheckerWithState Bool -> Bool -> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState Bool
forall p args. Bool -> p -> Instruction args -> (Bool, Bool)
check Bool
False
  where
    code :: Text
code = Text
"DL4003"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Multiple `CMD` instructions found. If you list more than one `CMD` then only the last \
      \`CMD` will take effect"
    check :: Bool -> p -> Instruction args -> (Bool, Bool)
check Bool
_ p
_ From {} = Bool -> Bool -> (Bool, Bool)
forall a b. a -> b -> (a, b)
withState Bool
False Bool
True -- Reset the state each time we find a FROM
    check Bool
st p
_ Cmd {} = Bool -> Bool -> (Bool, Bool)
forall a b. a -> b -> (a, b)
withState Bool
True (Bool -> Bool
not Bool
st) -- Remember we found a CMD, fail if we found a CMD before
    check Bool
st p
_ Instruction args
_ = Bool -> Bool -> (Bool, Bool)
forall a b. a -> b -> (a, b)
withState Bool
st Bool
True

multipleEntrypoints :: Rule
multipleEntrypoints :: Rule
multipleEntrypoints = Text
-> Severity -> Text -> SimpleCheckerWithState Bool -> Bool -> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState Bool
forall p args. Bool -> p -> Instruction args -> (Bool, Bool)
check Bool
False
  where
    code :: Text
code = Text
"DL4004"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message =
      Text
"Multiple `ENTRYPOINT` instructions found. If you list more than one `ENTRYPOINT` then \
      \only the last `ENTRYPOINT` will take effect"
    check :: Bool -> p -> Instruction args -> (Bool, Bool)
check Bool
_ p
_ From {} = Bool -> Bool -> (Bool, Bool)
forall a b. a -> b -> (a, b)
withState Bool
False Bool
True -- Reset the state each time we find a FROM
    check Bool
st p
_ Entrypoint {} = Bool -> Bool -> (Bool, Bool)
forall a b. a -> b -> (a, b)
withState Bool
True (Bool -> Bool
not Bool
st) -- Remember we found an ENTRYPOINT
    -- and fail if we found another one before
    check Bool
st p
_ Instruction args
_ = Bool -> Bool -> (Bool, Bool)
forall a b. a -> b -> (a, b)
withState Bool
st Bool
True

wgetOrCurl :: Rule
wgetOrCurl :: Rule
wgetOrCurl = Text
-> Severity
-> Text
-> SimpleCheckerWithState (Set Text)
-> Set Text
-> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState (Set Text)
forall p.
Set Text -> p -> Instruction ParsedShell -> (Set Text, Bool)
check Set Text
forall a. Set a
Set.empty
  where
    code :: Text
code = Text
"DL4001"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Either use Wget or Curl but not both"
    check :: Set Text -> p -> Instruction ParsedShell -> (Set Text, Bool)
check Set Text
state p
_ (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> (Set Text, Bool))
-> Arguments ParsedShell -> (Set Text, Bool)
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule (Set Text -> ParsedShell -> (Set Text, Bool)
detectDoubleUsage Set Text
state) Arguments ParsedShell
args
    check Set Text
_ p
_ (From BaseImage
_) = Set Text -> Bool -> (Set Text, Bool)
forall a b. a -> b -> (a, b)
withState Set Text
forall a. Set a
Set.empty Bool
True -- Reset the state for each stage
    check Set Text
state p
_ Instruction ParsedShell
_ = Set Text -> Bool -> (Set Text, Bool)
forall a b. a -> b -> (a, b)
withState Set Text
state Bool
True
    detectDoubleUsage :: Set Text -> ParsedShell -> (Set Text, Bool)
detectDoubleUsage Set Text
state ParsedShell
args =
      let newArgs :: Set Text
newArgs = ParsedShell -> Set Text
extractCommands ParsedShell
args
          newState :: Set Text
newState = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Text
state Set Text
newArgs
       in Set Text -> Bool -> (Set Text, Bool)
forall a b. a -> b -> (a, b)
withState Set Text
newState (Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
newArgs Bool -> Bool -> Bool
|| Set Text -> Int
forall a. Set a -> Int
Set.size Set Text
newState Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2)
    extractCommands :: ParsedShell -> Set Text
extractCommands ParsedShell
args =
      [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
w | Text
w <- ParsedShell -> [Text]
Shell.findCommandNames ParsedShell
args, Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"curl" Bool -> Bool -> Bool
|| Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"wget"]

invalidCmd :: Rule
invalidCmd :: Rule
invalidCmd = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3001"
    severity :: Severity
severity = Severity
InfoC
    message :: Text
message =
      Text
"For some bash commands it makes no sense running them in a Docker container like `ssh`, \
      \`vim`, `shutdown`, `service`, `ps`, `free`, `top`, `kill`, `mount`, `ifconfig`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ParsedShell -> Bool
detectInvalid Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    detectInvalid :: ParsedShell -> Bool
detectInvalid ParsedShell
args = [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text
arg | Text
arg <- ParsedShell -> [Text]
Shell.findCommandNames ParsedShell
args, Text
arg Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
invalidCmds]
    invalidCmds :: [Text]
invalidCmds = [Text
"ssh", Text
"vim", Text
"shutdown", Text
"service", Text
"ps", Text
"free", Text
"top", Text
"kill", Text
"mount"]

noRootUser :: Rule
noRootUser :: Rule
noRootUser ParsedFile
dockerfile = Text
-> Severity
-> Text
-> SimpleCheckerWithState (Maybe BaseImage)
-> Maybe BaseImage
-> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState (Maybe BaseImage)
forall args.
Maybe BaseImage
-> Int -> Instruction args -> (Maybe BaseImage, Bool)
check Maybe BaseImage
forall a. Maybe a
Nothing ParsedFile
dockerfile
  where
    code :: Text
code = Text
"DL3002"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Last USER should not be root"
    check :: Maybe BaseImage
-> Int -> Instruction args -> (Maybe BaseImage, Bool)
check Maybe BaseImage
_ Int
_ (From BaseImage
from) = Maybe BaseImage -> Bool -> (Maybe BaseImage, Bool)
forall a b. a -> b -> (a, b)
withState (BaseImage -> Maybe BaseImage
forall a. a -> Maybe a
Just BaseImage
from) Bool
True -- Remember the last FROM instruction found
    check st :: Maybe BaseImage
st@(Just BaseImage
from) Int
line (User Text
user)
      | Text -> Bool
isRoot Text
user Bool -> Bool -> Bool
&& BaseImage -> Int -> Bool
lastUserIsRoot BaseImage
from Int
line = Maybe BaseImage -> Bool -> (Maybe BaseImage, Bool)
forall a b. a -> b -> (a, b)
withState Maybe BaseImage
st Bool
False
      | Bool
otherwise = Maybe BaseImage -> Bool -> (Maybe BaseImage, Bool)
forall a b. a -> b -> (a, b)
withState Maybe BaseImage
st Bool
True
    check Maybe BaseImage
st Int
_ Instruction args
_ = Maybe BaseImage -> Bool -> (Maybe BaseImage, Bool)
forall a b. a -> b -> (a, b)
withState Maybe BaseImage
st Bool
True
    --
    --
    lastUserIsRoot :: BaseImage -> Int -> Bool
lastUserIsRoot BaseImage
from Int
line = BaseImage -> Map BaseImage Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BaseImage
from Map BaseImage Int
rootStages Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
line
    --
    --
    rootStages :: Map.Map BaseImage Linenumber
    rootStages :: Map BaseImage Int
rootStages =
      let indexedInstructions :: [(Instruction ParsedShell, Int)]
indexedInstructions = (InstructionPos ParsedShell -> (Instruction ParsedShell, Int))
-> ParsedFile -> [(Instruction ParsedShell, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (InstructionPos ParsedShell -> Instruction ParsedShell
forall args. InstructionPos args -> Instruction args
instruction (InstructionPos ParsedShell -> Instruction ParsedShell)
-> (InstructionPos ParsedShell -> Int)
-> InstructionPos ParsedShell
-> (Instruction ParsedShell, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InstructionPos ParsedShell -> Int
forall args. InstructionPos args -> Int
lineNumber) ParsedFile
dockerfile
          (Maybe BaseImage
_, Map BaseImage Int
usersMap) = ((Maybe BaseImage, Map BaseImage Int)
 -> (Instruction ParsedShell, Int)
 -> (Maybe BaseImage, Map BaseImage Int))
-> (Maybe BaseImage, Map BaseImage Int)
-> [(Instruction ParsedShell, Int)]
-> (Maybe BaseImage, Map BaseImage Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Maybe BaseImage, Map BaseImage Int)
-> (Instruction ParsedShell, Int)
-> (Maybe BaseImage, Map BaseImage Int)
forall a args.
(Maybe BaseImage, Map BaseImage a)
-> (Instruction args, a) -> (Maybe BaseImage, Map BaseImage a)
buildMap (Maybe BaseImage
forall a. Maybe a
Nothing, Map BaseImage Int
forall k a. Map k a
Map.empty) [(Instruction ParsedShell, Int)]
indexedInstructions
       in Map BaseImage Int
usersMap
    --
    --
    buildMap :: (Maybe BaseImage, Map BaseImage a)
-> (Instruction args, a) -> (Maybe BaseImage, Map BaseImage a)
buildMap (Maybe BaseImage
_, Map BaseImage a
st) (From BaseImage
from, a
_) = (BaseImage -> Maybe BaseImage
forall a. a -> Maybe a
Just BaseImage
from, Map BaseImage a
st) -- Remember the FROM we are currently inspecting
    buildMap (Just BaseImage
from, Map BaseImage a
st) (User Text
user, a
line)
      | Text -> Bool
isRoot Text
user = (BaseImage -> Maybe BaseImage
forall a. a -> Maybe a
Just BaseImage
from, BaseImage -> a -> Map BaseImage a -> Map BaseImage a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BaseImage
from a
line Map BaseImage a
st) -- Remember the line with a root user
      | Bool
otherwise = (BaseImage -> Maybe BaseImage
forall a. a -> Maybe a
Just BaseImage
from, BaseImage -> Map BaseImage a -> Map BaseImage a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete BaseImage
from Map BaseImage a
st) -- Forget there was a root used for this FROM
    buildMap (Maybe BaseImage, Map BaseImage a)
st (Instruction args, a)
_ = (Maybe BaseImage, Map BaseImage a)
st
    --
    --
    isRoot :: Text -> Bool
isRoot Text
user =
      Text -> Text -> Bool
Text.isPrefixOf Text
"root:" Text
user Bool -> Bool -> Bool
|| Text -> Text -> Bool
Text.isPrefixOf Text
"0:" Text
user Bool -> Bool -> Bool
|| Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"root" Bool -> Bool -> Bool
|| Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0"

noCd :: Rule
noCd :: Rule
noCd = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3003"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Use WORKDIR to switch to a directory"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule (Bool -> Bool
not (Bool -> Bool) -> (ParsedShell -> Bool) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsedShell -> Bool
usingProgram Text
"cd") Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

noSudo :: Rule
noSudo :: Rule
noSudo = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3004"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message =
      Text
"Do not use sudo as it leads to unpredictable behavior. Use a tool like gosu to enforce \
      \root"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule (Bool -> Bool
not (Bool -> Bool) -> (ParsedShell -> Bool) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsedShell -> Bool
usingProgram Text
"sudo") Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

noAptGetUpgrade :: Rule
noAptGetUpgrade :: Rule
noAptGetUpgrade = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3005"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Do not use apt-get upgrade or dist-upgrade"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apt-get" [Text
"upgrade", Text
"dist-upgrade"])) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

noUntagged :: Rule
noUntagged :: Rule
noUntagged ParsedFile
dockerfile = Text -> Severity -> Text -> SimpleCheckerWithLine -> Rule
instructionRuleLine Text
code Severity
severity Text
message SimpleCheckerWithLine
forall args. Int -> Instruction args -> Bool
check ParsedFile
dockerfile
  where
    code :: Text
code = Text
"DL3006"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Always tag the version of an image explicitly"
    check :: Int -> Instruction args -> Bool
check Int
_ (From BaseImage {$sel:image:BaseImage :: BaseImage -> Image
image = (Image Maybe Registry
_ Text
"scratch")}) = Bool
True
    check Int
_ (From BaseImage {$sel:digest:BaseImage :: BaseImage -> Maybe Digest
digest = Just Digest
_}) = Bool
True
    check Int
line (From BaseImage {$sel:image:BaseImage :: BaseImage -> Image
image = (Image Maybe Registry
_ Text
i), $sel:tag:BaseImage :: BaseImage -> Maybe Tag
tag = Maybe Tag
Nothing}) =
      Text
i Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Int -> ParsedFile -> [Text]
previouslyDefinedAliases Int
line ParsedFile
dockerfile
    check Int
_ Instruction args
_ = Bool
True

noLatestTag :: Rule
noLatestTag :: Rule
noLatestTag = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3007"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Using latest is prone to errors if the image will ever update. Pin the version explicitly \
      \to a release tag"
    check :: Instruction args -> Bool
check (From BaseImage {$sel:tag:BaseImage :: BaseImage -> Maybe Tag
tag = Just Tag
t}) = Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
"latest"
    check Instruction args
_ = Bool
True

aptGetVersionPinned :: Rule
aptGetVersionPinned :: Rule
aptGetVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3008"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Pin versions in apt get install. Instead of `apt-get install <package>` use `apt-get \
      \install <package>=<version>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
aptGetPackages) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    versionFixed :: Text -> Bool
versionFixed Text
package = Text
"=" Text -> Text -> Bool
`Text.isInfixOf` Text
package Bool -> Bool -> Bool
|| (Text
"/" Text -> Text -> Bool
`Text.isInfixOf` Text
package Bool -> Bool -> Bool
|| Text
".deb" Text -> Text -> Bool
`Text.isSuffixOf` Text
package)

aptGetPackages :: Shell.ParsedShell -> [Text.Text]
aptGetPackages :: ParsedShell -> [Text]
aptGetPackages ParsedShell
args =
  [ Text
arg
    | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args,
      Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apt-get" [Text
"install"] Command
cmd,
      Text
arg <- Command -> [Text]
Shell.getArgsNoFlags (Command -> Command
dropTarget Command
cmd),
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install"
  ]
  where
    dropTarget :: Command -> Command
dropTarget = [Text] -> Command -> Command
Shell.dropFlagArg [Text
"t", Text
"target-release"]

aptGetCleanup :: Rule
aptGetCleanup :: Rule
aptGetCleanup ParsedFile
dockerfile = Text
-> Severity
-> Text
-> SimpleCheckerWithState (Maybe (Int, Instruction ParsedShell))
-> Maybe (Int, Instruction ParsedShell)
-> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState (Maybe (Int, Instruction ParsedShell))
check Maybe (Int, Instruction ParsedShell)
forall a. Maybe a
Nothing ParsedFile
dockerfile
  where
    code :: Text
code = Text
"DL3009"
    severity :: Severity
severity = Severity
InfoC
    message :: Text
message = Text
"Delete the apt-get lists after installing something"

    check :: SimpleCheckerWithState (Maybe (Int, Instruction ParsedShell))
check Maybe (Int, Instruction ParsedShell)
_ Int
line f :: Instruction ParsedShell
f@(From BaseImage
_) = Maybe (Int, Instruction ParsedShell)
-> Bool -> (Maybe (Int, Instruction ParsedShell), Bool)
forall a b. a -> b -> (a, b)
withState ((Int, Instruction ParsedShell)
-> Maybe (Int, Instruction ParsedShell)
forall a. a -> Maybe a
Just (Int
line, Instruction ParsedShell
f)) Bool
True -- Remember the last FROM instruction found
    check st :: Maybe (Int, Instruction ParsedShell)
st@(Just (Int
line, From BaseImage
baseimage)) Int
_ (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      Maybe (Int, Instruction ParsedShell)
-> Bool -> (Maybe (Int, Instruction ParsedShell), Bool)
forall a b. a -> b -> (a, b)
withState Maybe (Int, Instruction ParsedShell)
st ((ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule (Int -> BaseImage -> ParsedShell -> Bool
didNotForgetToCleanup Int
line BaseImage
baseimage) Arguments ParsedShell
args)
    check Maybe (Int, Instruction ParsedShell)
st Int
_ Instruction ParsedShell
_ = Maybe (Int, Instruction ParsedShell)
-> Bool -> (Maybe (Int, Instruction ParsedShell), Bool)
forall a b. a -> b -> (a, b)
withState Maybe (Int, Instruction ParsedShell)
st Bool
True
    -- Check all commands in the script for the presence of apt-get update
    -- If the command is there, then we need to verify that the user is also removing the lists folder
    didNotForgetToCleanup :: Int -> BaseImage -> ParsedShell -> Bool
didNotForgetToCleanup Int
line BaseImage
baseimage ParsedShell
args
      | Bool -> Bool
not (ParsedShell -> Bool
hasUpdate ParsedShell
args) Bool -> Bool -> Bool
|| Bool -> Bool
not (Int -> BaseImage -> Bool
imageIsUsed Int
line BaseImage
baseimage) = Bool
True
      | Bool
otherwise = ParsedShell -> Bool
hasCleanup ParsedShell
args
    hasCleanup :: ParsedShell -> Bool
hasCleanup ParsedShell
args =
      (Command -> Bool) -> [Command] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"rm" [Text
"-rf", Text
"/var/lib/apt/lists/*"]) (ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args)
    hasUpdate :: ParsedShell -> Bool
hasUpdate ParsedShell
args = (Command -> Bool) -> [Command] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apt-get" [Text
"update"]) (ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args)
    imageIsUsed :: Int -> BaseImage -> Bool
imageIsUsed Int
line BaseImage
baseimage = Int -> BaseImage -> Bool
isLastImage Int
line BaseImage
baseimage Bool -> Bool -> Bool
|| Int -> BaseImage -> Bool
imageIsUsedLater Int
line BaseImage
baseimage
    isLastImage :: Int -> BaseImage -> Bool
isLastImage Int
line BaseImage
baseimage =
      case [(Int, BaseImage)] -> [(Int, BaseImage)]
forall a. [a] -> [a]
reverse (ParsedFile -> [(Int, BaseImage)]
allFromImages ParsedFile
dockerfile) of
        (Int, BaseImage)
lst : [(Int, BaseImage)]
_ -> (Int
line, BaseImage
baseimage) (Int, BaseImage) -> (Int, BaseImage) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, BaseImage)
lst
        [(Int, BaseImage)]
_ -> Bool
True
    imageIsUsedLater :: Int -> BaseImage -> Bool
imageIsUsedLater Int
line BaseImage
baseimage =
      case BaseImage -> Maybe ImageAlias
fromAlias BaseImage
baseimage of
        Maybe ImageAlias
Nothing -> Bool
True
        Just (ImageAlias Text
alias) ->
          Text
alias Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
i | (Int
l, Text
i) <- ParsedFile -> [(Int, Text)]
allImageNames ParsedFile
dockerfile, Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
line]

noApkUpgrade :: Rule
noApkUpgrade :: Rule
noApkUpgrade = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3017"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Do not use apk upgrade"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apk" [Text
"upgrade"])) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

apkAddVersionPinned :: Rule
apkAddVersionPinned :: Rule
apkAddVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3018"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Pin versions in apk add. Instead of `apk add <package>` use `apk add <package>=<version>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule (\ParsedShell
as -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Text -> Bool
versionFixed Text
p | Text
p <- ParsedShell -> [Text]
apkAddPackages ParsedShell
as]) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    versionFixed :: Text -> Bool
versionFixed Text
package = Text
"=" Text -> Text -> Bool
`Text.isInfixOf` Text
package

apkAddPackages :: Shell.ParsedShell -> [Text.Text]
apkAddPackages :: ParsedShell -> [Text]
apkAddPackages ParsedShell
args =
  [ Text
arg
    | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args,
      Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apk" [Text
"add"] Command
cmd,
      Text
arg <- Command -> [Text]
Shell.getArgsNoFlags (Command -> Command
dropTarget Command
cmd),
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"add"
  ]
  where
    dropTarget :: Command -> Command
dropTarget = [Text] -> Command -> Command
Shell.dropFlagArg [Text
"t", Text
"virtual", Text
"repository", Text
"X"]

apkAddNoCache :: Rule
apkAddNoCache :: Rule
apkAddNoCache = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3019"
    severity :: Severity
severity = Severity
InfoC
    message :: Text
message =
      Text
"Use the `--no-cache` switch to avoid the need to use `--update` and remove \
      \`/var/cache/apk/*` when done installing packages"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotCacheOption) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotCacheOption :: Command -> Bool
forgotCacheOption Command
cmd = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apk" [Text
"add"] Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Command -> Bool
Shell.hasFlag Text
"no-cache" Command
cmd)

useAdd :: Rule
useAdd :: Rule
useAdd = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3010"
    severity :: Severity
severity = Severity
InfoC
    message :: Text
message = Text
"Use ADD for extracting archives into an image"
    check :: Instruction args -> Bool
check (Copy (CopyArgs NonEmpty SourcePath
srcs TargetPath
_ Chown
_ CopySource
_)) =
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ Bool -> Bool
not (Text
format Text -> Text -> Bool
`Text.isSuffixOf` Text
src)
          | SourcePath Text
src <- NonEmpty SourcePath -> [SourcePath]
forall a. NonEmpty a -> [a]
toList NonEmpty SourcePath
srcs,
            Text
format <- [Text]
archiveFormats
        ]
    check Instruction args
_ = Bool
True
    archiveFormats :: [Text]
archiveFormats =
      [ Text
".tar",
        Text
".tar.bz2",
        Text
".tb2",
        Text
".tbz",
        Text
".tbz2",
        Text
".tar.gz",
        Text
".tgz",
        Text
".tpz",
        Text
".tar.lz",
        Text
".tar.lzma",
        Text
".tlz",
        Text
".tar.xz",
        Text
".txz",
        Text
".tar.Z",
        Text
".tZ"
      ]

invalidPort :: Rule
invalidPort :: Rule
invalidPort = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3011"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Valid UNIX ports range from 0 to 65535"
    check :: Instruction args -> Bool
check (Expose (Ports [Port]
ports)) =
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
65535 | Port Int
p Protocol
_ <- [Port]
ports]
        Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
65535 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
65535 | PortRange Int
l Int
m Protocol
_ <- [Port]
ports]
    check Instruction args
_ = Bool
True

pipVersionPinned :: Rule
pipVersionPinned :: Rule
pipVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3013"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Pin versions in pip. Instead of `pip install <package>` use `pip install \
      \<package>==<version>` or `pip install --requirement <requirements file>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotToPinVersion) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotToPinVersion :: Command -> Bool
forgotToPinVersion Command
cmd =
      Command -> Bool
isPipInstall' Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
hasBuildConstraint Command
cmd) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed (Command -> [Text]
packages Command
cmd))
    -- Check if the command is a pip* install command, and that specific packages are being listed
    isPipInstall' :: Command -> Bool
isPipInstall' Command
cmd =
      (Command -> Bool
isPipInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
hasBuildConstraint Command
cmd) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed (Command -> [Text]
packages Command
cmd))) Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
requirementInstall Command
cmd)
    -- If the user is installing requirements from a file or just the local module, then we are not interested
    -- in running this rule
    requirementInstall :: Command -> Bool
requirementInstall Command
cmd =
      [Text
"--requirement"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd
        Bool -> Bool -> Bool
|| [Text
"-r"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd
        Bool -> Bool -> Bool
|| [Text
"."] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd
    hasBuildConstraint :: Command -> Bool
hasBuildConstraint Command
cmd = Text -> Command -> Bool
Shell.hasFlag Text
"constraint" Command
cmd Bool -> Bool -> Bool
|| Text -> Command -> Bool
Shell.hasFlag Text
"c" Command
cmd
    packages :: Command -> [Text]
packages Command
cmd =
      [Text] -> [Text]
stripInstallPrefix ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        Command -> [Text]
Shell.getArgsNoFlags (Command -> [Text]) -> Command -> [Text]
forall a b. (a -> b) -> a -> b
$
          [Text] -> Command -> Command
Shell.dropFlagArg
            [ Text
"abi",
              Text
"b",
              Text
"build",
              Text
"e",
              Text
"editable",
              Text
"extra-index-url",
              Text
"f",
              Text
"find-links",
              Text
"i",
              Text
"index-url",
              Text
"implementation",
              Text
"no-binary",
              Text
"only-binary",
              Text
"platform",
              Text
"prefix",
              Text
"progress-bar",
              Text
"proxy",
              Text
"python-version",
              Text
"root",
              Text
"src",
              Text
"t",
              Text
"target",
              Text
"trusted-host",
              Text
"upgrade-strategy"
            ]
            Command
cmd
    versionFixed :: Text -> Bool
versionFixed Text
package = Text -> Bool
hasVersionSymbol Text
package Bool -> Bool -> Bool
|| Text -> Bool
isVersionedGit Text
package Bool -> Bool -> Bool
|| Text -> Bool
isLocalPackage Text
package
    isVersionedGit :: Text -> Bool
isVersionedGit Text
package = Text
"git+http" Text -> Text -> Bool
`Text.isInfixOf` Text
package Bool -> Bool -> Bool
&& Text
"@" Text -> Text -> Bool
`Text.isInfixOf` Text
package
    versionSymbols :: [Text]
versionSymbols = [Text
"==", Text
">=", Text
"<=", Text
">", Text
"<", Text
"!=", Text
"~=", Text
"==="]
    hasVersionSymbol :: Text -> Bool
hasVersionSymbol Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
s Text -> Text -> Bool
`Text.isInfixOf` Text
package | Text
s <- [Text]
versionSymbols]
    localPackageFileExtensions :: [Text]
localPackageFileExtensions = [Text
".whl", Text
".tar.gz"]
    isLocalPackage :: Text -> Bool
isLocalPackage Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
s Text -> Text -> Bool
`Text.isSuffixOf` Text
package | Text
s <- [Text]
localPackageFileExtensions]

stripInstallPrefix :: [Text.Text] -> [Text.Text]
stripInstallPrefix :: [Text] -> [Text]
stripInstallPrefix [Text]
cmd = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"install") ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install") [Text]
cmd)

-- |
--  Rule for pinning NPM packages to version, tag, or commit
--  supported formats by Hadolint
--    npm install (with no args, in package dir)
--    npm install [<@scope>/]<name>
--    npm install [<@scope>/]<name>@<tag>
--    npm install [<@scope>/]<name>@<version>
--    npm install git[+http|+https]://<git-host>/<git-user>/<repo-name>[#<commit>|#semver:<semver>]
--    npm install git+ssh://<git-host>:<git-user>/<repo-name>[#<commit>|#semver:<semver>]
npmVersionPinned :: Rule
npmVersionPinned :: Rule
npmVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3016"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Pin versions in npm. Instead of `npm install <package>` use `npm install \
      \<package>@<version>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotToPinVersion) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotToPinVersion :: Command -> Bool
forgotToPinVersion Command
cmd =
      Command -> Bool
isNpmInstall Command
cmd Bool -> Bool -> Bool
&& Command -> Bool
installIsFirst Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed (Command -> [Text]
packages Command
cmd))
    isNpmInstall :: Command -> Bool
isNpmInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"npm" [Text
"install"]
    installIsFirst :: Command -> Bool
installIsFirst Command
cmd = [Text
"install"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Command -> [Text]
Shell.getArgsNoFlags Command
cmd
    packages :: Command -> [Text]
packages Command
cmd = [Text] -> [Text]
stripInstallPrefix (Command -> [Text]
Shell.getArgsNoFlags Command
cmd)
    versionFixed :: Text -> Bool
versionFixed Text
package
      | Text -> Bool
hasGitPrefix Text
package = Text -> Bool
isVersionedGit Text
package
      | Text -> Bool
hasTarballSuffix Text
package = Bool
True
      | Text -> Bool
isFolder Text
package = Bool
True
      | Bool
otherwise = Text -> Bool
hasVersionSymbol Text
package
    gitPrefixes :: [Text]
gitPrefixes = [Text
"git://", Text
"git+ssh://", Text
"git+http://", Text
"git+https://"]
    hasGitPrefix :: Text -> Bool
hasGitPrefix Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
p Text -> Text -> Bool
`Text.isPrefixOf` Text
package | Text
p <- [Text]
gitPrefixes]
    tarballSuffixes :: [Text]
tarballSuffixes = [Text
".tar", Text
".tar.gz", Text
".tgz"]
    hasTarballSuffix :: Text -> Bool
hasTarballSuffix Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
p Text -> Text -> Bool
`Text.isSuffixOf` Text
package | Text
p <- [Text]
tarballSuffixes]
    pathPrefixes :: [Text]
pathPrefixes = [Text
"/", Text
"./", Text
"../", Text
"~/"]
    isFolder :: Text -> Bool
isFolder Text
package = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Text
p Text -> Text -> Bool
`Text.isPrefixOf` Text
package | Text
p <- [Text]
pathPrefixes]
    isVersionedGit :: Text -> Bool
isVersionedGit Text
package = Text
"#" Text -> Text -> Bool
`Text.isInfixOf` Text
package
    hasVersionSymbol :: Text -> Bool
hasVersionSymbol Text
package = Text
"@" Text -> Text -> Bool
`Text.isInfixOf` Text -> Text
dropScope Text
package
      where
        dropScope :: Text -> Text
dropScope Text
pkg =
          if Text
"@" Text -> Text -> Bool
`Text.isPrefixOf` Text
pkg
            then (Char -> Bool) -> Text -> Text
Text.dropWhile (Char
'/' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<) Text
pkg
            else Text
pkg

aptGetYes :: Rule
aptGetYes :: Rule
aptGetYes = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3014"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Use the `-y` switch to avoid manual input `apt-get -y install <package>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotAptYesOption) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotAptYesOption :: Command -> Bool
forgotAptYesOption Command
cmd = Command -> Bool
isAptGetInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
hasYesOption Command
cmd)
    isAptGetInstall :: Command -> Bool
isAptGetInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apt-get" [Text
"install"]
    hasYesOption :: Command -> Bool
hasYesOption = [Text] -> Command -> Bool
Shell.hasAnyFlag [Text
"y", Text
"yes", Text
"q", Text
"assume-yes"]

aptGetNoRecommends :: Rule
aptGetNoRecommends :: Rule
aptGetNoRecommends = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3015"
    severity :: Severity
severity = Severity
InfoC
    message :: Text
message = Text
"Avoid additional packages by specifying `--no-install-recommends`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotNoInstallRecommends) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotNoInstallRecommends :: Command -> Bool
forgotNoInstallRecommends Command
cmd = Command -> Bool
isAptGetInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
disablesRecommendOption Command
cmd)
    isAptGetInstall :: Command -> Bool
isAptGetInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"apt-get" [Text
"install"]
    disablesRecommendOption :: Command -> Bool
disablesRecommendOption Command
cmd =
      Text -> Command -> Bool
Shell.hasFlag Text
"no-install-recommends" Command
cmd
        Bool -> Bool -> Bool
|| Text -> Command -> Bool
Shell.hasArg Text
"APT::Install-Recommends=false" Command
cmd

isArchive :: Text.Text -> Bool
isArchive :: Text -> Bool
isArchive Text
path =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    ( [ Text
ftype Text -> Text -> Bool
`Text.isSuffixOf` Text
path
        | Text
ftype <-
            [ Text
".tar",
              Text
".gz",
              Text
".bz2",
              Text
".xz",
              Text
".zip",
              Text
".tgz",
              Text
".tb2",
              Text
".tbz",
              Text
".tbz2",
              Text
".lz",
              Text
".lzma",
              Text
".tlz",
              Text
".txz",
              Text
".Z",
              Text
".tZ"
            ]
      ]
    )

isUrl :: Text.Text -> Bool
isUrl :: Text -> Bool
isUrl Text
path = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Text
proto Text -> Text -> Bool
`Text.isPrefixOf` Text
path | Text
proto <- [Text
"https://", Text
"http://"]])

copyInsteadAdd :: Rule
copyInsteadAdd :: Rule
copyInsteadAdd = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3020"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Use COPY instead of ADD for files and folders"
    check :: Instruction args -> Bool
check (Add (AddArgs NonEmpty SourcePath
srcs TargetPath
_ Chown
_)) =
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Text -> Bool
isArchive Text
src Bool -> Bool -> Bool
|| Text -> Bool
isUrl Text
src | SourcePath Text
src <- NonEmpty SourcePath -> [SourcePath]
forall a. NonEmpty a -> [a]
toList NonEmpty SourcePath
srcs]
    check Instruction args
_ = Bool
True

copyEndingSlash :: Rule
copyEndingSlash :: Rule
copyEndingSlash = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3021"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"COPY with more than 2 arguments requires the last argument to end with /"
    check :: Instruction args -> Bool
check (Copy (CopyArgs NonEmpty SourcePath
sources TargetPath
t Chown
_ CopySource
_))
      | NonEmpty SourcePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty SourcePath
sources Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = TargetPath -> Bool
endsWithSlash TargetPath
t
      | Bool
otherwise = Bool
True
    check Instruction args
_ = Bool
True
    endsWithSlash :: TargetPath -> Bool
endsWithSlash (TargetPath Text
t) = Bool -> Bool
not (Text -> Bool
Text.null Text
t) Bool -> Bool -> Bool
&& Text -> Char
Text.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'

copyFromExists :: Rule
copyFromExists :: Rule
copyFromExists ParsedFile
dockerfile = Text -> Severity -> Text -> SimpleCheckerWithLine -> Rule
instructionRuleLine Text
code Severity
severity Text
message SimpleCheckerWithLine
forall args. Int -> Instruction args -> Bool
check ParsedFile
dockerfile
  where
    code :: Text
code = Text
"DL3022"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"COPY --from should reference a previously defined FROM alias"
    check :: Int -> Instruction args -> Bool
check Int
l (Copy (CopyArgs NonEmpty SourcePath
_ TargetPath
_ Chown
_ (CopySource Text
s))) = Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Int -> ParsedFile -> [Text]
previouslyDefinedAliases Int
l ParsedFile
dockerfile
    check Int
_ Instruction args
_ = Bool
True

copyFromAnother :: Rule
copyFromAnother :: Rule
copyFromAnother = Text
-> Severity
-> Text
-> SimpleCheckerWithState (Maybe (Instruction ParsedShell))
-> Maybe (Instruction ParsedShell)
-> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState (Maybe (Instruction ParsedShell))
forall args p.
Maybe (Instruction args)
-> p -> Instruction args -> (Maybe (Instruction args), Bool)
check Maybe (Instruction ParsedShell)
forall a. Maybe a
Nothing
  where
    code :: Text
code = Text
"DL3023"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"COPY --from should reference a previously defined FROM alias"

    check :: Maybe (Instruction args)
-> p -> Instruction args -> (Maybe (Instruction args), Bool)
check Maybe (Instruction args)
_ p
_ f :: Instruction args
f@(From BaseImage
_) = Maybe (Instruction args)
-> Bool -> (Maybe (Instruction args), Bool)
forall a b. a -> b -> (a, b)
withState (Instruction args -> Maybe (Instruction args)
forall a. a -> Maybe a
Just Instruction args
f) Bool
True -- Remember the last FROM instruction found
    check st :: Maybe (Instruction args)
st@(Just Instruction args
fromInstr) p
_ (Copy (CopyArgs NonEmpty SourcePath
_ TargetPath
_ Chown
_ (CopySource Text
stageName))) =
      Maybe (Instruction args)
-> Bool -> (Maybe (Instruction args), Bool)
forall a b. a -> b -> (a, b)
withState Maybe (Instruction args)
st ((Text -> Bool) -> Instruction args -> Bool
forall a. (Text -> Bool) -> Instruction a -> Bool
aliasMustBe (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
stageName) Instruction args
fromInstr) -- Cannot copy from itself!
    check Maybe (Instruction args)
state p
_ Instruction args
_ = Maybe (Instruction args)
-> Bool -> (Maybe (Instruction args), Bool)
forall a b. a -> b -> (a, b)
withState Maybe (Instruction args)
state Bool
True

fromAliasUnique :: Rule
fromAliasUnique :: Rule
fromAliasUnique ParsedFile
dockerfile = Text -> Severity -> Text -> SimpleCheckerWithLine -> Rule
instructionRuleLine Text
code Severity
severity Text
message SimpleCheckerWithLine
forall args. Int -> Instruction args -> Bool
check ParsedFile
dockerfile
  where
    code :: Text
code = Text
"DL3024"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"FROM aliases (stage names) must be unique"
    check :: Int -> Instruction a -> Bool
check Int
line = (Text -> Bool) -> Instruction a -> Bool
forall a. (Text -> Bool) -> Instruction a -> Bool
aliasMustBe (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Bool
alreadyTaken Int
line)
    alreadyTaken :: Int -> Text -> Bool
alreadyTaken Int
line Text
alias = Text
alias Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Int -> ParsedFile -> [Text]
previouslyDefinedAliases Int
line ParsedFile
dockerfile

useShell :: Rule
useShell :: Rule
useShell = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL4005"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Use SHELL to change the default shell"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"ln" [Text
"/bin/sh"])) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

useJsonArgs :: Rule
useJsonArgs :: Rule
useJsonArgs = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3025"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Use arguments JSON notation for CMD and ENTRYPOINT arguments"
    check :: Instruction args -> Bool
check (Cmd (ArgumentsText args
_)) = Bool
False
    check (Entrypoint (ArgumentsText args
_)) = Bool
False
    check Instruction args
_ = Bool
True

noApt :: Rule
noApt :: Rule
noApt = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3027"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Do not use apt as it is meant to be a end-user tool, use apt-get or apt-cache instead"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule (Bool -> Bool
not (Bool -> Bool) -> (ParsedShell -> Bool) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsedShell -> Bool
usingProgram Text
"apt") Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

usePipefail :: Rule
usePipefail :: Rule
usePipefail = Text
-> Severity -> Text -> SimpleCheckerWithState Bool -> Bool -> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState Bool
forall p. Bool -> p -> Instruction ParsedShell -> (Bool, Bool)
check Bool
False
  where
    code :: Text
code = Text
"DL4006"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Set the SHELL option -o pipefail before RUN with a pipe in it. If you are using \
      \/bin/sh in an alpine image or if your shell is symlinked to busybox then consider \
      \explicitly setting your SHELL to /bin/ash, or disable this check"
    check :: Bool -> p -> Instruction ParsedShell -> (Bool, Bool)
check Bool
_ p
_ From {} = (Bool
False, Bool
True) -- Reset the state each time we find a new FROM
    check Bool
_ p
_ (Shell Arguments ParsedShell
args)
      | (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ParsedShell -> Bool
isPowerShell Arguments ParsedShell
args = (Bool
True, Bool
True)
      | Bool
otherwise = ((ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ParsedShell -> Bool
hasPipefailOption Arguments ParsedShell
args, Bool
True)
    check Bool
False p
_ (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (Bool
False, (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ParsedShell -> Bool
notHasPipes Arguments ParsedShell
args)
    check Bool
st p
_ Instruction ParsedShell
_ = (Bool
st, Bool
True)
    isPowerShell :: ParsedShell -> Bool
isPowerShell (Shell.ParsedShell Text
orig ParseResult
_ [Command]
_) = Text
"pwsh" Text -> Text -> Bool
`Text.isPrefixOf` Text
orig
    notHasPipes :: ParsedShell -> Bool
notHasPipes ParsedShell
script = Bool -> Bool
not (ParsedShell -> Bool
Shell.hasPipes ParsedShell
script)
    hasPipefailOption :: ParsedShell -> Bool
hasPipefailOption ParsedShell
script =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
          [ Bool
True
            | cmd :: Command
cmd@(Shell.Command Text
name [CmdPart]
arguments [CmdPart]
_) <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
script,
              Text
validShell <- [Text
"/bin/bash", Text
"/bin/zsh", Text
"/bin/ash", Text
"bash", Text
"zsh", Text
"ash"],
              Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
validShell,
              Text -> Command -> Bool
Shell.hasFlag Text
"o" Command
cmd,
              Text
arg <- CmdPart -> Text
Shell.arg (CmdPart -> Text) -> [CmdPart] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CmdPart]
arguments,
              Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"pipefail"
          ]

registryIsAllowed :: Set.Set Registry -> Rule
registryIsAllowed :: Set Registry -> Rule
registryIsAllowed Set Registry
allowed = Text
-> Severity
-> Text
-> SimpleCheckerWithState (Set (Maybe ImageAlias))
-> Set (Maybe ImageAlias)
-> Rule
forall state.
Text
-> Severity
-> Text
-> SimpleCheckerWithState state
-> state
-> Rule
instructionRuleState Text
code Severity
severity Text
message SimpleCheckerWithState (Set (Maybe ImageAlias))
forall p args.
Set (Maybe ImageAlias)
-> p -> Instruction args -> (Set (Maybe ImageAlias), Bool)
check Set (Maybe ImageAlias)
forall a. Set a
Set.empty
  where
    code :: Text
code = Text
"DL3026"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Use only an allowed registry in the FROM image"
    check :: Set (Maybe ImageAlias)
-> p -> Instruction args -> (Set (Maybe ImageAlias), Bool)
check Set (Maybe ImageAlias)
st p
_ (From BaseImage {Image
image :: Image
$sel:image:BaseImage :: BaseImage -> Image
image, Maybe ImageAlias
alias :: Maybe ImageAlias
$sel:alias:BaseImage :: BaseImage -> Maybe ImageAlias
alias}) = Set (Maybe ImageAlias) -> Bool -> (Set (Maybe ImageAlias), Bool)
forall a b. a -> b -> (a, b)
withState (Maybe ImageAlias
-> Set (Maybe ImageAlias) -> Set (Maybe ImageAlias)
forall a. Ord a => a -> Set a -> Set a
Set.insert Maybe ImageAlias
alias Set (Maybe ImageAlias)
st) (Set (Maybe ImageAlias) -> Image -> Bool
doCheck Set (Maybe ImageAlias)
st Image
image)
    check Set (Maybe ImageAlias)
st p
_ Instruction args
_ = (Set (Maybe ImageAlias)
st, Bool
True)
    toImageAlias :: Image -> Maybe ImageAlias
toImageAlias = ImageAlias -> Maybe ImageAlias
forall a. a -> Maybe a
Just (ImageAlias -> Maybe ImageAlias)
-> (Image -> ImageAlias) -> Image -> Maybe ImageAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImageAlias
ImageAlias (Text -> ImageAlias) -> (Image -> Text) -> Image -> ImageAlias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> Text
imageName

    doCheck :: Set (Maybe ImageAlias) -> Image -> Bool
doCheck Set (Maybe ImageAlias)
st Image
img = Maybe ImageAlias -> Set (Maybe ImageAlias) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Image -> Maybe ImageAlias
toImageAlias Image
img) Set (Maybe ImageAlias)
st Bool -> Bool -> Bool
|| Set Registry -> Bool
forall a. Set a -> Bool
Set.null Set Registry
allowed Bool -> Bool -> Bool
|| Image -> Bool
isAllowed Image
img
    isAllowed :: Image -> Bool
isAllowed Image {$sel:registryName:Image :: Image -> Maybe Registry
registryName = Just Registry
registry} = Registry -> Set Registry -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Registry
registry Set Registry
allowed
    isAllowed Image {$sel:registryName:Image :: Image -> Maybe Registry
registryName = Maybe Registry
Nothing, Text
imageName :: Text
$sel:imageName:Image :: Image -> Text
imageName} =
      Text
imageName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"scratch"
        Bool -> Bool -> Bool
|| Registry -> Set Registry -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Registry
"docker.io" Set Registry
allowed
        Bool -> Bool -> Bool
|| Registry -> Set Registry -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Registry
"hub.docker.com" Set Registry
allowed

gemVersionPinned :: Rule
gemVersionPinned :: Rule
gemVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3028"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Pin versions in gem install. Instead of `gem install <gem>` use `gem \
      \install <gem>:<version>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
gems) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    versionFixed :: Text -> Bool
versionFixed Text
package = Text
":" Text -> Text -> Bool
`Text.isInfixOf` Text
package

noPlatformFlag :: Rule
noPlatformFlag :: Rule
noPlatformFlag = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3029"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Do not use --platform flag with FROM"
    check :: Instruction args -> Bool
check (From BaseImage {$sel:platform:BaseImage :: BaseImage -> Maybe Text
platform = Just Text
p}) = Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
""
    check Instruction args
_ = Bool
True

yumYes :: Rule
yumYes :: Rule
yumYes = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3030"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Use the -y switch to avoid manual input `yum install -y <package`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotYumYesOption) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotYumYesOption :: Command -> Bool
forgotYumYesOption Command
cmd = Command -> Bool
isYumInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
hasYesOption Command
cmd)
    isYumInstall :: Command -> Bool
isYumInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"yum" [Text
"install", Text
"groupinstall", Text
"localinstall"]
    hasYesOption :: Command -> Bool
hasYesOption = [Text] -> Command -> Bool
Shell.hasAnyFlag [Text
"y", Text
"assumeyes"]

noYumUpdate :: Rule
noYumUpdate :: Rule
noYumUpdate = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3031"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Do not use yum update."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule
        ( (Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands
            ( Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs
                Text
"yum"
                [ Text
"update",
                  Text
"update-to",
                  Text
"upgrade",
                  Text
"upgrade-to"
                ]
            )
        )
        Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

yumCleanup :: Rule
yumCleanup :: Rule
yumCleanup = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3032"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"`yum clean all` missing after yum command."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
yumInstall) Arguments ParsedShell
args
        Bool -> Bool -> Bool
|| ( (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
yumInstall) Arguments ParsedShell
args
               Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
yumClean) Arguments ParsedShell
args
           )
    check Instruction ParsedShell
_ = Bool
True
    yumInstall :: Command -> Bool
yumInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"yum" [Text
"install"]
    yumClean :: Command -> Bool
yumClean = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"yum" [Text
"clean", Text
"all"]

yumVersionPinned :: Rule
yumVersionPinned :: Rule
yumVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3033"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Specify version with `yum install -y <package>-<version>`."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
yumPackages) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    versionFixed :: Text -> Bool
versionFixed Text
package =
      Text
"-" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
".rpm" Text -> Text -> Bool
`Text.isSuffixOf` Text
package

yumPackages :: Shell.ParsedShell -> [Text.Text]
yumPackages :: ParsedShell -> [Text]
yumPackages ParsedShell
args =
  [ Text
arg | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args, Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"yum" [Text
"install"] Command
cmd, Text
arg <- Command -> [Text]
Shell.getArgsNoFlags Command
cmd, Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install"
  ]

zypperYes :: Rule
zypperYes :: Rule
zypperYes = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3034"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Non-interactive switch missing from `zypper` command: `zypper install -y`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotZypperYesOption) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotZypperYesOption :: Command -> Bool
forgotZypperYesOption Command
cmd = Command -> Bool
isZypperInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
hasYesOption Command
cmd)
    isZypperInstall :: Command -> Bool
isZypperInstall =
      Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs
        Text
"zypper"
        [ Text
"install",
          Text
"in",
          Text
"remove",
          Text
"rm",
          Text
"source-install",
          Text
"si",
          Text
"patch"
        ]
    hasYesOption :: Command -> Bool
hasYesOption = [Text] -> Command -> Bool
Shell.hasAnyFlag [Text
"no-confirm", Text
"y"]

noZypperUpdate :: Rule
noZypperUpdate :: Rule
noZypperUpdate = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3035"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Do not use `zypper update`."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule
        ( (Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands
            ( Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs
                Text
"zypper"
                [ Text
"update",
                  Text
"up",
                  Text
"dist-upgrade",
                  Text
"dup"
                ]
            )
        )
        Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

zypperCleanup :: Rule
zypperCleanup :: Rule
zypperCleanup = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3036"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"`zypper clean` missing after zypper use."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
zypperInstall) Arguments ParsedShell
args
        Bool -> Bool -> Bool
|| ( (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
zypperInstall) Arguments ParsedShell
args
               Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
zypperClean) Arguments ParsedShell
args
           )
    check Instruction ParsedShell
_ = Bool
True
    zypperInstall :: Command -> Bool
zypperInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"zypper" [Text
"install", Text
"in"]
    zypperClean :: Command -> Bool
zypperClean = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"zypper" [Text
"clean", Text
"cc"]

zypperVersionPinned :: Rule
zypperVersionPinned :: Rule
zypperVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3037"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Specify version with `zypper install -y <package>=<version>`."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
zypperPackages) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    versionFixed :: Text -> Bool
versionFixed Text
package =
      Text
"=" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
">=" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
">" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
"<=" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
"<" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
".rpm" Text -> Text -> Bool
`Text.isSuffixOf` Text
package


zypperPackages :: Shell.ParsedShell -> [Text.Text]
zypperPackages :: ParsedShell -> [Text]
zypperPackages ParsedShell
args =
  [ Text
arg | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args, Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"zypper" [Text
"install", Text
"in"] Command
cmd, Text
arg <- Command -> [Text]
Shell.getArgsNoFlags Command
cmd, Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install", Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"in"
  ]

dnfYes :: Rule
dnfYes :: Rule
dnfYes = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3038"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Use the -y switch to avoid manual input `dnf install -y <package`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotDnfYesOption) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotDnfYesOption :: Command -> Bool
forgotDnfYesOption Command
cmd = Command -> Bool
isDnfInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
hasYesOption Command
cmd)
    isDnfInstall :: Command -> Bool
isDnfInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"dnf" [Text
"install", Text
"groupinstall", Text
"localinstall"]
    hasYesOption :: Command -> Bool
hasYesOption = [Text] -> Command -> Bool
Shell.hasAnyFlag [Text
"y", Text
"assumeyes"]

noDnfUpdate :: Rule
noDnfUpdate :: Rule
noDnfUpdate = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3039"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"Do not use dnf update."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule
        ( (Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands
            ( Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs
                Text
"dnf"
                [ Text
"upgrade",
                  Text
"upgrade-minimal"
                ]
            )
        )
        Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True

dnfCleanup :: Rule
dnfCleanup :: Rule
dnfCleanup = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3040"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"`dnf clean all` missing after dnf command."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) =
      (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
dnfInstall) Arguments ParsedShell
args
        Bool -> Bool -> Bool
|| ( (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
dnfInstall) Arguments ParsedShell
args
              Bool -> Bool -> Bool
&& (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.anyCommands Command -> Bool
dnfClean) Arguments ParsedShell
args
           )
    check Instruction ParsedShell
_ = Bool
True
    dnfInstall :: Command -> Bool
dnfInstall = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"dnf" [Text
"install"]
    dnfClean :: Command -> Bool
dnfClean = Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"dnf" [Text
"clean", Text
"all"]

dnfVersionPinned :: Rule
dnfVersionPinned :: Rule
dnfVersionPinned = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3041"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message = Text
"Specify version with `dnf install -y <package>-<version>`."
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
versionFixed ([Text] -> Bool) -> (ParsedShell -> [Text]) -> ParsedShell -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedShell -> [Text]
dnfPackages) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    versionFixed :: Text -> Bool
versionFixed Text
package =
      Text
"-" Text -> Text -> Bool
`Text.isInfixOf` Text
package
        Bool -> Bool -> Bool
|| Text
".rpm" Text -> Text -> Bool
`Text.isSuffixOf` Text
package

dnfPackages :: Shell.ParsedShell -> [Text.Text]
dnfPackages :: ParsedShell -> [Text]
dnfPackages ParsedShell
args =
  [ Text
arg | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
args, Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"dnf" [Text
"install"] Command
cmd, Text
arg <- Command -> [Text]
Shell.getArgsNoFlags Command
cmd, Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install"
  ]

pipNoCacheDir :: Rule
pipNoCacheDir :: Rule
pipNoCacheDir = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
check
  where
    code :: Text
code = Text
"DL3042"
    severity :: Severity
severity = Severity
WarningC
    message :: Text
message =
      Text
"Avoid use of cache directory with pip. Use `pip install --no-cache-dir <package>`"
    check :: Instruction ParsedShell -> Bool
check (Run (RunArgs Arguments ParsedShell
args RunFlags
_)) = (ParsedShell -> Bool) -> Arguments ParsedShell -> Bool
forall a. (ParsedShell -> a) -> Arguments ParsedShell -> a
argumentsRule ((Command -> Bool) -> ParsedShell -> Bool
Shell.noCommands Command -> Bool
forgotNoCacheDir) Arguments ParsedShell
args
    check Instruction ParsedShell
_ = Bool
True
    forgotNoCacheDir :: Command -> Bool
forgotNoCacheDir Command
cmd =
      Command -> Bool
isPipInstall Command
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not(Command -> Bool
usesNoCacheDir Command
cmd) Bool -> Bool -> Bool
&& Bool -> Bool
not (Command -> Bool
isPipWrapper Command
cmd)
    usesNoCacheDir :: Command -> Bool
usesNoCacheDir Command
cmd   = Text
"--no-cache-dir" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Command -> [Text]
Shell.getArgs Command
cmd

isPipInstall :: Shell.Command -> Bool
isPipInstall :: Command -> Bool
isPipInstall cmd :: Command
cmd@(Shell.Command Text
name [CmdPart]
_ [CmdPart]
_) = Bool
isStdPipInstall Bool -> Bool -> Bool
|| Bool
isPythonPipInstall
  where
    isStdPipInstall :: Bool
isStdPipInstall = Text
"pip" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
      Bool -> Bool -> Bool
&& [Text
"install"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd
    isPythonPipInstall :: Bool
isPythonPipInstall = Text
"python" Text -> Text -> Bool
`Text.isPrefixOf` Text
name
        Bool -> Bool -> Bool
&& [Text
"-m", Text
"pip", Text
"install"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd

isPipWrapper :: Shell.Command -> Bool
isPipWrapper :: Command -> Bool
isPipWrapper cmd :: Command
cmd@(Shell.Command Text
name [CmdPart]
_ [CmdPart]
_) = Text -> Bool
isWrapper Text
"pipx" Bool -> Bool -> Bool
|| Text -> Bool
isWrapper Text
"pipenv"
  where
    isWrapper :: Text.Text -> Bool
    isWrapper :: Text -> Bool
isWrapper Text
w = Text
w Text -> Text -> Bool
`Text.isInfixOf` Text
name
      Bool -> Bool -> Bool
|| ( Text
"python" Text -> Text -> Bool
`Text.isPrefixOf` Text
name Bool -> Bool -> Bool
&& [Text
"-m", Text
w] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Command -> [Text]
Shell.getArgs Command
cmd )

gems :: Shell.ParsedShell -> [Text.Text]
gems :: ParsedShell -> [Text]
gems ParsedShell
shell =
  [ Text
arg
    | Command
cmd <- ParsedShell -> [Command]
Shell.presentCommands ParsedShell
shell,
      Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"gem" [Text
"install", Text
"i"] Command
cmd,
      Bool -> Bool
not (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"gem" [Text
"-v"] Command
cmd),
      Bool -> Bool
not (Text -> [Text] -> Command -> Bool
Shell.cmdHasArgs Text
"gem" [Text
"--version"] Command
cmd),
      Bool -> Bool
not (Text -> Text -> Command -> Bool
Shell.cmdHasPrefixArg Text
"gem" Text
"--version=" Command
cmd),
      Text
arg <- Command -> [Text]
Shell.getArgsNoFlags Command
cmd,
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"install",
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"i",
      Text
arg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"--"
  ]


noIllegalInstructionInOnbuild :: Rule
noIllegalInstructionInOnbuild :: Rule
noIllegalInstructionInOnbuild = Text
-> Severity -> Text -> (Instruction ParsedShell -> Bool) -> Rule
instructionRule Text
code Severity
severity Text
message Instruction ParsedShell -> Bool
forall args. Instruction args -> Bool
check
  where
    code :: Text
code = Text
"DL3043"
    severity :: Severity
severity = Severity
ErrorC
    message :: Text
message = Text
"`ONBUILD`, `FROM` or `MAINTAINER` triggered from within `ONBUILD` instruction."
    check :: Instruction args -> Bool
check (OnBuild (OnBuild Instruction args
_)) = Bool
False
    check (OnBuild (From BaseImage
_)) = Bool
False
    check (OnBuild (Maintainer Text
_)) = Bool
False
    check Instruction args
_ = Bool
True