module Hadolint.Rule.DL4006 (rule) where

import qualified Data.Text as Text
import Hadolint.Rule
import Hadolint.Shell (ParsedShell)
import qualified Hadolint.Shell as Shell
import Language.Docker.Syntax

rule :: Rule ParsedShell
rule :: Rule ParsedShell
rule = forall a args.
(Linenumber -> State a -> Instruction args -> State a)
-> State a -> Rule args
customRule Linenumber -> State Bool -> Instruction ParsedShell -> State Bool
check (forall a. a -> State a
emptyState Bool
False)
  where
    code :: RuleCode
code = RuleCode
"DL4006"
    severity :: DLSeverity
severity = DLSeverity
DLWarningC
    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 :: Linenumber -> State Bool -> Instruction ParsedShell -> State Bool
check Linenumber
_ State Bool
st From {} = State Bool
st forall a b. a -> (a -> b) -> b
|> forall a. a -> State a -> State a
replaceWith Bool
False -- Reset the state each time we find a new FROM
    check Linenumber
_ State Bool
st (Shell Arguments ParsedShell
args)
      | forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> Bool
isNonPosixShell Arguments ParsedShell
args = State Bool
st forall a b. a -> (a -> b) -> b
|> forall a. a -> State a -> State a
replaceWith Bool
True
      | Bool
otherwise = State Bool
st forall a b. a -> (a -> b) -> b
|> forall a. a -> State a -> State a
replaceWith (forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> Bool
hasPipefailOption Arguments ParsedShell
args)
    check Linenumber
line st :: State Bool
st@(State Failures
_ Bool
False) (Run (RunArgs Arguments ParsedShell
args RunFlags
_))
      | forall a b. (a -> b) -> Arguments a -> b
foldArguments ParsedShell -> Bool
hasPipes Arguments ParsedShell
args = State Bool
st forall a b. a -> (a -> b) -> b
|> forall a. CheckFailure -> State a -> State a
addFail CheckFailure {Linenumber
Text
RuleCode
DLSeverity
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
..}
      | Bool
otherwise = State Bool
st
    check Linenumber
_ State Bool
st Instruction ParsedShell
_ = State Bool
st

    isNonPosixShell :: ParsedShell -> Bool
isNonPosixShell (Shell.ParsedShell Text
orig ParseResult
_ [Command]
_) =
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isPrefixOf` Text
orig) [Text]
Shell.nonPosixShells
    hasPipes :: ParsedShell -> Bool
hasPipes ParsedShell
script = ParsedShell -> Bool
Shell.hasPipes ParsedShell
script
    hasPipefailOption :: ParsedShell -> Bool
hasPipefailOption ParsedShell
script =
      Bool -> Bool
not forall a b. (a -> b) -> a -> b
$
        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 forall a. Eq a => a -> a -> Bool
== Text
validShell,
              Text -> Command -> Bool
Shell.hasFlag Text
"o" Command
cmd,
              Text
arg <- CmdPart -> Text
Shell.arg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CmdPart]
arguments,
              Text
arg forall a. Eq a => a -> a -> Bool
== Text
"pipefail"
          ]
{-# INLINEABLE rule #-}