From 5d753212fb8385ff80d10f8f8ad96a90e74cfd54 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 25 Jul 2020 13:45:05 -0700 Subject: [PATCH] Improve handling of command prefixes like exec/command (fixes #2008) --- src/ShellCheck/ASTLib.hs | 73 ++++++++++++++++++++++----- src/ShellCheck/Analytics.hs | 32 +++++++----- src/ShellCheck/AnalyzerLib.hs | 27 ---------- src/ShellCheck/Checks/ShellSupport.hs | 2 +- 4 files changed, 81 insertions(+), 53 deletions(-) diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 29ce27f..09c7537 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -28,6 +28,7 @@ import Data.Functor import Data.Functor.Identity import Data.List import Data.Maybe +import qualified Data.Map as Map -- Is this a type of loop? isLoop t = case t of @@ -134,6 +135,33 @@ isUnquotedFlag token = fromMaybe False $ do str <- getLeadingUnquotedString token return $ "-" `isPrefixOf` str +-- getGnuOpts "erd:u:" will parse a SimpleCommand like +-- read -re -d : -u 3 bar +-- into +-- Just [("r", -re), ("e", -re), ("d", :), ("u", 3), ("", bar)] +-- where flags with arguments map to arguments, while others map to themselves. +-- Any unrecognized flag will result in Nothing. +getGnuOpts str t = getOpts str $ getAllFlags t +getBsdOpts str t = getOpts str $ getLeadingFlags t +getOpts :: String -> [(Token, String)] -> Maybe [(String, Token)] +getOpts string flags = process flags + where + flagList (c:':':rest) = ([c], True) : flagList rest + flagList (c:rest) = ([c], False) : flagList rest + flagList [] = [] + flagMap = Map.fromList $ ("", False) : flagList string + + process [] = return [] + process ((token1, flag):rest1) = do + takesArg <- Map.lookup flag flagMap + (token, rest) <- if takesArg + then case rest1 of + (token2, ""):rest2 -> return (token2, rest2) + _ -> fail "takesArg without valid arg" + else return (token1, rest1) + more <- process rest + return $ (flag, token) : more + -- Is this an expansion of multiple items of an array? isArrayExpansion (T_DollarBraced _ _ l) = let string = concat $ oversimplify l in @@ -297,7 +325,7 @@ getCommand t = -- Maybe get the command name string of a token representing a command getCommandName :: Token -> Maybe String -getCommandName = fst . getCommandNameAndToken +getCommandName = fst . getCommandNameAndToken False -- Maybe get the name+arguments of a command. getCommandArgv t = do @@ -307,18 +335,37 @@ getCommandArgv t = do -- Get the command name token from a command, i.e. -- the token representing 'ls' in 'ls -la 2> foo'. -- If it can't be determined, return the original token. -getCommandTokenOrThis = snd . getCommandNameAndToken +getCommandTokenOrThis = snd . getCommandNameAndToken False -getCommandNameAndToken :: Token -> (Maybe String, Token) -getCommandNameAndToken t = fromMaybe (Nothing, t) $ do - (T_SimpleCommand _ _ (w:rest)) <- getCommand t +-- Given a command, get the string and token that represents the command name. +-- If direct, return the actual command (e.g. exec in 'exec ls') +-- If not, return the logical command (e.g. 'ls' in 'exec ls') + +getCommandNameAndToken :: Bool -> Token -> (Maybe String, Token) +getCommandNameAndToken direct t = fromMaybe (Nothing, t) $ do + cmd@(T_SimpleCommand _ _ (w:rest)) <- getCommand t s <- getLiteralString w - return $ case rest of - (applet:_) | "busybox" `isSuffixOf` s || "builtin" == s -> - (getLiteralString applet, applet) - _ -> - (Just s, w) - + return $ fromMaybe (Just s, w) $ do + guard $ not direct + actual <- getEffectiveCommandToken s cmd rest + return (getLiteralString actual, actual) + where + getEffectiveCommandToken str cmd args = + let + firstArg = do + arg <- listToMaybe args + guard . not $ isFlag arg + return arg + in + case str of + "busybox" -> firstArg + "builtin" -> firstArg + "command" -> firstArg + "exec" -> do + opts <- getBsdOpts "cla:" cmd + (_, t) <- listToMaybe $ filter (null . fst) opts + return t + _ -> fail "" -- If a command substitution is a single command, get its name. -- $(date +%s) = Just "date" @@ -335,8 +382,8 @@ getCommandNameFromExpansion t = -- Get the basename of a token representing a command getCommandBasename = fmap basename . getCommandName - where - basename = reverse . takeWhile (/= '/') . reverse + +basename = reverse . takeWhile (/= '/') . reverse isAssignment t = case t of diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 977d415..4071764 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -942,8 +942,10 @@ prop_checkSingleQuotedVariables18= verifyNot checkSingleQuotedVariables "echo '` prop_checkSingleQuotedVariables19= verifyNot checkSingleQuotedVariables "echo '```'" prop_checkSingleQuotedVariables20= verifyNot checkSingleQuotedVariables "mumps -run %XCMD 'W $O(^GLOBAL(5))'" prop_checkSingleQuotedVariables21= verifyNot checkSingleQuotedVariables "mumps -run LOOP%XCMD --xec 'W $O(^GLOBAL(6))'" - - +prop_checkSingleQuotedVariables22= verifyNot checkSingleQuotedVariables "jq '$__loc__'" +prop_checkSingleQuotedVariables23= verifyNot checkSingleQuotedVariables "command jq '$__loc__'" +prop_checkSingleQuotedVariables24= verifyNot checkSingleQuotedVariables "exec jq '$__loc__'" +prop_checkSingleQuotedVariables25= verifyNot checkSingleQuotedVariables "exec -c -a foo jq '$__loc__'" checkSingleQuotedVariables params t@(T_SingleQuoted id s) = @@ -1677,13 +1679,10 @@ checkSpuriousExec _ = doLists doList tail True doList' _ _ = return () - commentIfExec (T_Pipeline id _ list) = - mapM_ commentIfExec $ take 1 list - commentIfExec (T_Redirecting _ _ f@( - T_SimpleCommand id _ (cmd:arg:_))) - | f `isUnqualifiedCommand` "exec" = - warn id 2093 - "Remove \"exec \" if script should continue after this command." + commentIfExec (T_Pipeline id _ [c]) = commentIfExec c + commentIfExec (T_Redirecting _ _ (T_SimpleCommand id _ (cmd:additionalArg:_))) | + getLiteralString cmd == Just "exec" = + warn id 2093 "Remove \"exec \" if script should continue after this command." commentIfExec _ = return () @@ -2056,18 +2055,27 @@ prop_checkFunctionsUsedExternally6 = verifyNotTree checkFunctionsUsedExternally "foo() { :; }; ssh host echo foo" prop_checkFunctionsUsedExternally7 = verifyNotTree checkFunctionsUsedExternally "install() { :; }; sudo apt-get install foo" +prop_checkFunctionsUsedExternally8 = + verifyTree checkFunctionsUsedExternally "foo() { :; }; command sudo foo" +prop_checkFunctionsUsedExternally9 = + verifyTree checkFunctionsUsedExternally "foo() { :; }; exec -c sudo foo" checkFunctionsUsedExternally params t = runNodeAnalysis checkCommand params t where - checkCommand _ t@(T_SimpleCommand _ _ (cmd:args)) = - case getCommandBasename t of - Just name -> do + checkCommand _ t@(T_SimpleCommand _ _ argv) = + case getCommandNameAndToken False t of + (Just str, t) -> do + let name = basename str + let args = skipOver t argv let argStrings = map (\x -> (fromMaybe "" $ getLiteralString x, x)) args let candidates = getPotentialCommands name argStrings mapM_ (checkArg name) candidates _ -> return () checkCommand _ _ = return () + skipOver t list = drop 1 $ dropWhile (\c -> getId c /= id) $ list + where id = getId t + -- Try to pick out the argument[s] that may be commands getPotentialCommands name argAndString = case name of diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 69ebfe6..ab1c415 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -901,33 +901,6 @@ isQuotedAlternativeReference t = where re = mkRegex "(^|\\]):?\\+" --- getGnuOpts "erd:u:" will parse a SimpleCommand like --- read -re -d : -u 3 bar --- into --- Just [("r", -re), ("e", -re), ("d", :), ("u", 3), ("", bar)] --- where flags with arguments map to arguments, while others map to themselves. --- Any unrecognized flag will result in Nothing. -getGnuOpts str t = getOpts str $ getAllFlags t -getBsdOpts str t = getOpts str $ getLeadingFlags t -getOpts :: String -> [(Token, String)] -> Maybe [(String, Token)] -getOpts string flags = process flags - where - flagList (c:':':rest) = ([c], True) : flagList rest - flagList (c:rest) = ([c], False) : flagList rest - flagList [] = [] - flagMap = Map.fromList $ ("", False) : flagList string - - process [] = return [] - process ((token1, flag):rest1) = do - takesArg <- Map.lookup flag flagMap - (token, rest) <- if takesArg - then case rest1 of - (token2, ""):rest2 -> return (token2, rest2) - _ -> fail "takesArg without valid arg" - else return (token1, rest1) - more <- process rest - return $ (flag, token) : more - supportsArrays Bash = True supportsArrays Ksh = True supportsArrays _ = False diff --git a/src/ShellCheck/Checks/ShellSupport.hs b/src/ShellCheck/Checks/ShellSupport.hs index 1f87868..2482207 100644 --- a/src/ShellCheck/Checks/ShellSupport.hs +++ b/src/ShellCheck/Checks/ShellSupport.hs @@ -280,7 +280,7 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do flagRegex = mkRegex "^-[eEsn]+$" bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) - | t `isCommand` "exec" && "-" `isPrefixOf` concat (oversimplify arg) = + | getLiteralString cmd == Just "exec" && "-" `isPrefixOf` concat (oversimplify arg) = warnMsg (getId arg) "exec flags are" bashism t@(T_SimpleCommand id _ _) | t `isCommand` "let" = warnMsg id "'let' is"