module Hadolint.Rule.DL3010 (rule) where

import Data.Foldable (toList)
import Data.Function ((&))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import Hadolint.Rule
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax


data Acc
  = Acc
      { Acc -> Set (Linenumber, Text)
archives :: Set.Set (Linenumber, Text.Text),
        Acc -> Set (Linenumber, Text)
extracted :: Set.Set (Linenumber, Text.Text)
      }
  | Empty

rule :: Rule Shell.ParsedShell
rule :: Rule ParsedShell
rule = (Linenumber -> State Acc -> Instruction ParsedShell -> State Acc)
-> State Acc -> (State Acc -> Failures) -> Rule ParsedShell
forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> (State a -> Failures) -> Rule args
veryCustomRule Linenumber -> State Acc -> Instruction ParsedShell -> State Acc
check (Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty) State Acc -> Failures
markFailures
  where
    code :: RuleCode
code = RuleCode
"DL3010"
    severity :: DLSeverity
severity = DLSeverity
DLInfoC
    message :: Text
message = Text
"Use `ADD` for extracting archives into an image"

    check :: Linenumber -> State Acc -> Instruction ParsedShell -> State Acc
check Linenumber
_ State Acc
_ (From BaseImage
_) = Acc -> State Acc
forall a. a -> State a
emptyState Acc
Empty
    check Linenumber
line State Acc
st (Copy (CopyArgs NonEmpty SourcePath
srcs TargetPath
tgt Chown
_ Chmod
_ CopySource
NoSource)) =
      State Acc
st State Acc -> (State Acc -> State Acc) -> State Acc
forall a b. a -> (a -> b) -> b
|> (Acc -> Acc) -> State Acc -> State Acc
forall a. (a -> a) -> State a -> State a
modify (Linenumber -> NonEmpty SourcePath -> TargetPath -> Acc -> Acc
rememberArchives Linenumber
line NonEmpty SourcePath
srcs TargetPath
tgt)
    check Linenumber
_ State Acc
st (Run (RunArgs Arguments ParsedShell
args RunFlags
_))
      | Acc Set (Linenumber, Text)
archives Set (Linenumber, Text)
_ <- State Acc -> Acc
forall a. State a -> a
state State Acc
st,
        Set (Linenumber, Text)
ex <- (ParsedShell -> Set (Linenumber, Text))
-> Arguments ParsedShell -> Set (Linenumber, Text)
forall a b. (a -> b) -> Arguments a -> b
foldArguments (Set (Linenumber, Text) -> ParsedShell -> Set (Linenumber, Text)
getExtractedArchives Set (Linenumber, Text)
archives) Arguments ParsedShell
args =
          State Acc
st State Acc -> (State Acc -> State Acc) -> State Acc
forall a b. a -> (a -> b) -> b
|> (Acc -> Acc) -> State Acc -> State Acc
forall a. (a -> a) -> State a -> State a
modify (Set (Linenumber, Text) -> Acc -> Acc
markExtracted Set (Linenumber, Text)
ex)
      | Bool
otherwise = State Acc
st
    check Linenumber
_ State Acc
st Instruction ParsedShell
_ = State Acc
st

    markFailures :: State Acc -> Failures
    markFailures :: State Acc -> Failures
markFailures (State Failures
fails (Acc Set (Linenumber, Text)
_ Set (Linenumber, Text)
e)) =
      (Failures -> CheckFailure -> Failures)
-> Failures -> Set CheckFailure -> Failures
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Failures -> CheckFailure -> Failures
forall a. Seq a -> a -> Seq a
(Seq.|>) Failures
fails (((Linenumber, Text) -> CheckFailure)
-> Set (Linenumber, Text) -> Set CheckFailure
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Linenumber, Text) -> CheckFailure
makeFail Set (Linenumber, Text)
e)
    markFailures State Acc
st = State Acc -> Failures
forall a. State a -> Failures
failures State Acc
st

    makeFail :: (Linenumber, Text.Text) -> CheckFailure
    makeFail :: (Linenumber, Text) -> CheckFailure
makeFail (Linenumber
line, Text
_) = CheckFailure :: RuleCode -> DLSeverity -> Text -> Linenumber -> CheckFailure
CheckFailure {Linenumber
Text
RuleCode
DLSeverity
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
{-# INLINEABLE rule #-}


extractsThisArchive :: (Linenumber, Text.Text) -> Shell.Command -> Bool
extractsThisArchive :: (Linenumber, Text) -> Command -> Bool
extractsThisArchive (Linenumber
_, Text
archive) Command
cmd =
  (Command -> Bool
isTarExtractCommand Command
cmd Bool -> Bool -> Bool
|| Command -> Bool
isUnzipCommand Command
cmd) Bool -> Bool -> Bool
&& Text
archive Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
arguments
  where
    arguments :: [Text]
arguments = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
basename ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Command -> [Text]
Shell.getArgsNoFlags Command
cmd

getExtractedArchives ::
  Set.Set (Linenumber, Text.Text) ->
  Shell.ParsedShell ->
  Set.Set (Linenumber, Text.Text)
getExtractedArchives :: Set (Linenumber, Text) -> ParsedShell -> Set (Linenumber, Text)
getExtractedArchives Set (Linenumber, Text)
archives ParsedShell
shell =
  ((Linenumber, Text) -> Bool)
-> Set (Linenumber, Text) -> Set (Linenumber, Text)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
    (\(Linenumber, Text)
a -> (Command -> Bool) -> [Command] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Linenumber, Text) -> Command -> Bool
extractsThisArchive (Linenumber, Text)
a) [Command]
cmds)
    Set (Linenumber, Text)
archives
  where
    cmds :: [Command]
cmds = ParsedShell -> [Command]
Shell.presentCommands ParsedShell
shell

isTarExtractCommand :: Shell.Command -> Bool
isTarExtractCommand :: Command -> Bool
isTarExtractCommand cmd :: Command
cmd@(Shell.Command Text
name [CmdPart]
_ [CmdPart]
_) =
  Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"tar" Bool -> Bool -> Bool
&& ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
forall a. (Eq a, IsString a) => a -> Bool
longExtractFlags [Text]
args Bool -> Bool -> Bool
|| (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
shortExtractFlags [Text]
args)
  where
    longExtractFlags :: a -> Bool
longExtractFlags a
f = a
f a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"--extract", a
"--get"]
    shortExtractFlags :: Text -> Bool
shortExtractFlags Text
f = Text
"-" Text -> Text -> Bool
`Text.isPrefixOf` Text
f Bool -> Bool -> Bool
&& Text
"x" Text -> Text -> Bool
`Text.isInfixOf` Text
f
    args :: [Text]
args = Command -> [Text]
Shell.getArgs Command
cmd

isUnzipCommand :: Shell.Command -> Bool
isUnzipCommand :: Command -> Bool
isUnzipCommand (Shell.Command Text
name [CmdPart]
_ [CmdPart]
_) =
  Text
name Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
    [ Text
"unzip",
      Text
"gunzip",
      Text
"bunzip2",
      Text
"unlzma",
      Text
"unxz",
      Text
"zgz",
      Text
"uncompress",
      Text
"zcat",
      Text
"gzcat"
    ]

markExtracted :: Set.Set (Linenumber, Text.Text) -> Acc -> Acc
markExtracted :: Set (Linenumber, Text) -> Acc -> Acc
markExtracted Set (Linenumber, Text)
_ Acc
Empty = Acc
Empty
markExtracted Set (Linenumber, Text)
exarcv Acc {Set (Linenumber, Text)
archives :: Set (Linenumber, Text)
archives :: Acc -> Set (Linenumber, Text)
archives, Set (Linenumber, Text)
extracted :: Set (Linenumber, Text)
extracted :: Acc -> Set (Linenumber, Text)
extracted} =
  Acc :: Set (Linenumber, Text) -> Set (Linenumber, Text) -> Acc
Acc { Set (Linenumber, Text)
archives :: Set (Linenumber, Text)
archives :: Set (Linenumber, Text)
archives, extracted :: Set (Linenumber, Text)
extracted = Set (Linenumber, Text)
-> Set (Linenumber, Text) -> Set (Linenumber, Text)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Linenumber, Text)
exarcv Set (Linenumber, Text)
extracted }

rememberArchives ::
  Linenumber ->
  NonEmpty SourcePath ->
  TargetPath ->
  Acc ->
  Acc
rememberArchives :: Linenumber -> NonEmpty SourcePath -> TargetPath -> Acc -> Acc
rememberArchives Linenumber
line NonEmpty SourcePath
paths TargetPath
target Acc
Empty =
  if Text -> Bool
isArchive (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ TargetPath -> Text
unTargetPath TargetPath
target
    then Acc :: Set (Linenumber, Text) -> Set (Linenumber, Text) -> Acc
Acc
          { archives :: Set (Linenumber, Text)
archives = (Linenumber, Text) -> Set (Linenumber, Text)
forall a. a -> Set a
Set.singleton (Linenumber
line, Text -> Text
basename (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TargetPath -> Text
unTargetPath TargetPath
target),
            extracted :: Set (Linenumber, Text)
extracted = Set (Linenumber, Text)
forall a. Set a
Set.empty
          }
    else Acc :: Set (Linenumber, Text) -> Set (Linenumber, Text) -> Acc
Acc
          { archives :: Set (Linenumber, Text)
archives =
              NonEmpty SourcePath
paths
                NonEmpty SourcePath
-> (NonEmpty SourcePath -> [SourcePath]) -> [SourcePath]
forall a b. a -> (a -> b) -> b
& NonEmpty SourcePath -> [SourcePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
                [SourcePath] -> ([SourcePath] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (SourcePath -> Text) -> [SourcePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
basename (Text -> Text) -> (SourcePath -> Text) -> SourcePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePath -> Text
unSourcePath)
                [Text] -> ([Text] -> Set Text) -> Set Text
forall a b. a -> (a -> b) -> b
& [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
                Set Text -> (Set Text -> Set Text) -> Set Text
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> Set Text -> Set Text
forall a. (a -> Bool) -> Set a -> Set a
Set.filter Text -> Bool
isArchive
                Set Text
-> (Set Text -> Set (Linenumber, Text)) -> Set (Linenumber, Text)
forall a b. a -> (a -> b) -> b
& (Text -> (Linenumber, Text)) -> Set Text -> Set (Linenumber, Text)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Linenumber
line,),
            extracted :: Set (Linenumber, Text)
extracted = Set (Linenumber, Text)
forall a. Set a
Set.empty
          }
rememberArchives Linenumber
line NonEmpty SourcePath
paths TargetPath
target Acc {Set (Linenumber, Text)
archives :: Set (Linenumber, Text)
archives :: Acc -> Set (Linenumber, Text)
archives, Set (Linenumber, Text)
extracted :: Set (Linenumber, Text)
extracted :: Acc -> Set (Linenumber, Text)
extracted} =
  if Text -> Bool
isArchive (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ TargetPath -> Text
unTargetPath TargetPath
target
    then Acc :: Set (Linenumber, Text) -> Set (Linenumber, Text) -> Acc
Acc
          { archives :: Set (Linenumber, Text)
archives =
              (Linenumber, Text)
-> Set (Linenumber, Text) -> Set (Linenumber, Text)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Linenumber
line, Text -> Text
basename (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TargetPath -> Text
unTargetPath TargetPath
target) Set (Linenumber, Text)
archives,
            Set (Linenumber, Text)
extracted :: Set (Linenumber, Text)
extracted :: Set (Linenumber, Text)
extracted
          }
    else Acc :: Set (Linenumber, Text) -> Set (Linenumber, Text) -> Acc
Acc
          { archives :: Set (Linenumber, Text)
archives =
              NonEmpty SourcePath
paths
                NonEmpty SourcePath
-> (NonEmpty SourcePath -> [SourcePath]) -> [SourcePath]
forall a b. a -> (a -> b) -> b
& NonEmpty SourcePath -> [SourcePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
                [SourcePath] -> ([SourcePath] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (SourcePath -> Text) -> [SourcePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
basename (Text -> Text) -> (SourcePath -> Text) -> SourcePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePath -> Text
unSourcePath)
                [Text] -> ([Text] -> Set Text) -> Set Text
forall a b. a -> (a -> b) -> b
& [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
                Set Text -> (Set Text -> Set Text) -> Set Text
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> Set Text -> Set Text
forall a. (a -> Bool) -> Set a -> Set a
Set.filter Text -> Bool
isArchive
                Set Text
-> (Set Text -> Set (Linenumber, Text)) -> Set (Linenumber, Text)
forall a b. a -> (a -> b) -> b
& (Text -> (Linenumber, Text)) -> Set Text -> Set (Linenumber, Text)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Linenumber
line,)
                Set (Linenumber, Text)
-> (Set (Linenumber, Text) -> Set (Linenumber, Text))
-> Set (Linenumber, Text)
forall a b. a -> (a -> b) -> b
& Set (Linenumber, Text)
-> Set (Linenumber, Text) -> Set (Linenumber, Text)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Linenumber, Text)
archives,
            Set (Linenumber, Text)
extracted :: Set (Linenumber, Text)
extracted :: Set (Linenumber, Text)
extracted
          }

basename :: Text.Text -> Text.Text
basename :: Text -> Text
basename = (Char -> Bool) -> Text -> Text
Text.takeWhileEnd (\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
'\\') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropQuotes

isArchive :: Text.Text -> Bool
isArchive :: Text -> Bool
isArchive Text
src =
  (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isSuffixOf` Text -> Text
dropQuotes Text
src) [Text]
archiveFileFormatExtensions