From dc9032fca553d13340087d5094323540c1359d1b Mon Sep 17 00:00:00 2001 From: Christian Nassif-Haynes Date: Mon, 23 Aug 2021 03:27:40 +1000 Subject: [PATCH] Show info about `set -e` suppression during function calls --- src/ShellCheck/Analytics.hs | 98 ++++++++++++++++++++++++++++++----- src/ShellCheck/AnalyzerLib.hs | 22 ++++++-- 2 files changed, 103 insertions(+), 17 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e1e55fd..b524410 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -253,6 +253,13 @@ optionalTreeChecks = [ cdPositive = "[ -e /etc/issue ]", cdNegative = "[[ -e /etc/issue ]]" }, checkRequireDoubleBracket) + + ,(newCheckDescription { + cdName = "check-set-e-suppressed", + cdDescription = "Notify when set -e is suppressed during function invocation", + cdPositive = "set -e; func() { cp *.txt ~/backup; rm *.txt; }; func && echo ok", + cdNegative = "set -e; func() { cp *.txt ~/backup; rm *.txt; }; func; echo ok" + }, checkSetESuppressed) ] optionalCheckMap :: Map.Map String (Parameters -> Token -> [TokenComment]) @@ -393,6 +400,24 @@ replaceToken id params r = surroundWith id params s = fixWith [replaceStart id params 0 s, replaceEnd id params 0 s] fixWith fixes = newFix { fixReplacements = fixes } +analyse f t = execState (doAnalysis f t) [] + +-- Make a map from functions to definition IDs +functions t = Map.fromList $ analyse findFunctions t +findFunctions (T_Function id _ _ name _) + = modify ((name, id):) +findFunctions _ = return () + +-- Make a map from aliases to definition IDs +aliases t = Map.fromList $ analyse findAliases t +findAliases t@(T_SimpleCommand _ _ (_:args)) + | t `isUnqualifiedCommand` "alias" = mapM_ getAlias args +findAliases _ = return () +getAlias arg = + let string = onlyLiteralString arg + in when ('=' `elem` string) $ + modify ((takeWhile (/= '=') string, getId arg):) + prop_checkEchoWc3 = verify checkEchoWc "n=$(echo $foo | wc -c)" checkEchoWc _ (T_Pipeline id _ [a, b]) = when (acmd == ["echo", "${VAR}"]) $ @@ -2239,21 +2264,11 @@ checkFunctionsUsedExternally params t = findExecFlags = ["-exec", "-execdir", "-ok"] dropFlags = dropWhile (\x -> "-" `isPrefixOf` fst x) - -- Make a map from functions/aliases to definition IDs - analyse f t = execState (doAnalysis f t) [] - functions = Map.fromList $ analyse findFunctions t - findFunctions (T_Function id _ _ name _) = modify ((name, id):) - findFunctions t@(T_SimpleCommand id _ (_:args)) - | t `isUnqualifiedCommand` "alias" = mapM_ getAlias args - findFunctions _ = return () - getAlias arg = - let string = onlyLiteralString arg - in when ('=' `elem` string) $ - modify ((takeWhile (/= '=') string, getId arg):) + functionsAndAliases = Map.union (functions t) (aliases t) checkArg cmd (_, arg) = sequence_ $ do literalArg <- getUnquotedLiteral arg -- only consider unquoted literals - definitionId <- Map.lookup literalArg functions + definitionId <- Map.lookup literalArg functionsAndAliases return $ do warn (getId arg) 2033 "Shell functions can't be passed to external commands." @@ -4583,6 +4598,65 @@ checkArrayValueUsedAsIndex params _ = _ -> Nothing +prop_checkSetESuppressed1 = verifyTree checkSetESuppressed "set -e; f(){ :; }; x=$(f)" +prop_checkSetESuppressed2 = verifyNotTree checkSetESuppressed "f(){ :; }; x=$(f)" +prop_checkSetESuppressed3 = verifyNotTree checkSetESuppressed "set -e; f(){ :; }; x=$(set -e; f)" +prop_checkSetESuppressed4 = verifyTree checkSetESuppressed "set -e; f(){ :; }; baz=$(set -e; f) || :" +prop_checkSetESuppressed5 = verifyNotTree checkSetESuppressed "set -e; f(){ :; }; baz=$(echo \"\") || :" +prop_checkSetESuppressed6 = verifyTree checkSetESuppressed "set -e; f(){ :; }; f && echo" +prop_checkSetESuppressed7 = verifyTree checkSetESuppressed "set -e; f(){ :; }; f || echo" +prop_checkSetESuppressed8 = verifyNotTree checkSetESuppressed "set -e; f(){ :; }; echo && f" +prop_checkSetESuppressed9 = verifyNotTree checkSetESuppressed "set -e; f(){ :; }; echo || f" +prop_checkSetESuppressed10 = verifyTree checkSetESuppressed "set -e; f(){ :; }; ! f" +prop_checkSetESuppressed11 = verifyTree checkSetESuppressed "set -e; f(){ :; }; if f; then :; fi" +prop_checkSetESuppressed12 = verifyTree checkSetESuppressed "set -e; f(){ :; }; if set -e; f; then :; fi" +prop_checkSetESuppressed13 = verifyTree checkSetESuppressed "set -e; f(){ :; }; while f; do :; done" +prop_checkSetESuppressed14 = verifyTree checkSetESuppressed "set -e; f(){ :; }; while set -e; f; do :; done" +prop_checkSetESuppressed15 = verifyTree checkSetESuppressed "set -e; f(){ :; }; until f; do :; done" +prop_checkSetESuppressed16 = verifyTree checkSetESuppressed "set -e; f(){ :; }; until set -e; f; do :; done" +prop_checkSetESuppressed17 = verifyNotTree checkSetESuppressed "set -e; f(){ :; }; g(){ :; }; g f" +prop_checkSetESuppressed18 = verifyNotTree checkSetESuppressed "set -e; shopt -s inherit_errexit; f(){ :; }; x=$(f)" +checkSetESuppressed params t = + if hasSetE params then runNodeAnalysis checkNode params t else [] + where + checkNode _ (T_SimpleCommand _ _ (cmd:_)) = when (isFunction cmd) (checkCmd cmd) + checkNode _ _ = return () + + functions_ = functions t + + isFunction cmd = isJust $ do + literalArg <- getUnquotedLiteral cmd + Map.lookup literalArg functions_ + + checkCmd cmd = go $ getPath (parentMap params) cmd + where + go (child:parent:rest) = do + case parent of + T_Banged _ condition | child `isIn` [condition] -> informConditional "a ! condition" cmd + T_AndIf _ condition _ | child `isIn` [condition] -> informConditional "an && condition" cmd + T_OrIf _ condition _ | child `isIn` [condition] -> informConditional "an || condition" cmd + T_IfExpression _ condition _ | child `isIn` concatMap fst condition -> informConditional "an 'if' condition" cmd + T_UntilExpression _ condition _ | child `isIn` condition -> informConditional "an 'until' condition" cmd + T_WhileExpression _ condition _ | child `isIn` condition -> informConditional "a 'while' condition" cmd + T_DollarExpansion {} | not $ errExitEnabled parent -> informUninherited cmd + T_Backticked {} | not $ errExitEnabled parent -> informUninherited cmd + _ -> return () + go (parent:rest) + go _ = return () + + informConditional condType t = + info (getId t) 2310 ( + "This function is invoked in " ++ condType ++ " so set -e " ++ + "will be disabled. Invoke separately if failures should " ++ + "cause the script to exit.") + informUninherited t = + info (getId t) 2311 ( + "Bash implicitly disabled set -e for this function " ++ + "invocation because it's inside a command substitution. " ++ + "Add set -e; before it or enable inherit_errexit.") + errExitEnabled t = hasInheritErrexit params || containsSetE t + isIn t cmds = getId t `elem` map getId cmds + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 633543a..42d6f73 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -79,6 +79,8 @@ composeAnalyzers f g x = f x >> g x data Parameters = Parameters { -- Whether this script has the 'lastpipe' option set/default. hasLastpipe :: Bool, + -- Whether this script has the 'inherit_errexit' option set/default. + hasInheritErrexit :: Bool, -- Whether this script has 'set -e' anywhere. hasSetE :: Bool, -- A linear (bad) analysis of data flow @@ -196,7 +198,12 @@ makeParameters spec = Dash -> False Sh -> False Ksh -> True, - + hasInheritErrexit = + case shellType params of + Bash -> containsInheritErrexit root + Dash -> True + Sh -> True + Ksh -> False, shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec), parentMap = getParentTree root, variableFlow = getVariableFlow params root, @@ -219,18 +226,23 @@ containsSetE root = isNothing $ doAnalysis (guard . not . isSetE) root _ -> False re = mkRegex "[[:space:]]-[^-]*e" --- Does this script mention 'shopt -s lastpipe' anywhere? --- Also used as a hack. -containsLastpipe root = +containsShopt shopt root = isNothing $ doAnalysis (guard . not . isShoptLastPipe) root where isShoptLastPipe t = case t of T_SimpleCommand {} -> t `isUnqualifiedCommand` "shopt" && - ("lastpipe" `elem` oversimplify t) + (shopt `elem` oversimplify t) _ -> False +-- Does this script mention 'shopt -s inherit_errexit' anywhere? +containsInheritErrexit = containsShopt "inherit_errexit" + +-- Does this script mention 'shopt -s lastpipe' anywhere? +-- Also used as a hack. +containsLastpipe = containsShopt "lastpipe" + prop_determineShell0 = determineShellTest "#!/bin/sh" == Sh prop_determineShell1 = determineShellTest "#!/usr/bin/env ksh" == Ksh